source pkgsNeeded.tcl

ui_init "t_reticle.tcl"
SetFileTypes

PH "Drawing reticles with alpha"

set sw [poSwatch new]
$sw reset
$sw run

# Drawing reticles into square image.
set w 512
set h 512
poImgUtil SetFormatRGBA $UBYTE $UBYTE $UBYTE $UBYTE
set sqrImg [poImage NewImage $w $h]

set fname "testOut/reticle.001$fInfo(suf)"
set msg   "$fname: Drawing reticle (no circle) in white"
P $msg
poImgUtil SetDrawColorRGBA 1 1 1  1
$sqrImg Blank
poImgUtil DrawReticle $sqrImg 8 0 200 60
$sqrImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $sqrImg $msg

set fname "testOut/reticle.002$fInfo(suf)"
set msg   "$fname: Drawing reticle (1 circle) in white"
P $msg
poImgUtil SetDrawColorRGBA 1 1 1  1
$sqrImg Blank
::poImgUtil::DrawReticle $sqrImg 20 1 200 60
$sqrImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $sqrImg $msg

set fname "testOut/reticle.003$fInfo(suf)"
set msg   "$fname: Drawing reticle (2 circles) in green"
P $msg
poImgUtil SetDrawColorRGBA 0 1 0  1
$sqrImg Blank
::poImgUtil::DrawReticle $sqrImg 0 2 50 40
$sqrImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $sqrImg $msg

set fname "testOut/reticle.004$fInfo(suf)"
set msg   "$fname: Drawing reticle (8 circles) out of window"
P $msg
poImgUtil SetDrawColorRGBA 1 1 1  1
$sqrImg Blank
::poImgUtil::DrawReticle $sqrImg 0 8 50 40
$sqrImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $sqrImg $msg

# Drawing reticle into landscape format image.
set w 600
set h 400
poImgUtil SetFormatRGBA $UBYTE $UBYTE $UBYTE $UBYTE
set landImg [poImage NewImage $w $h]

set fname "testOut/reticle.005$fInfo(suf)"
set msg   "$fname: Drawing reticle (4 circles) in cyan"
P $msg
poImgUtil SetDrawColorRGBA 0 1 1  1
$landImg Blank
::poImgUtil::DrawReticle $landImg 26 4 60 20
$landImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $landImg $msg

# Drawing reticle into portrait format image.
set w 400
set h 600
poImgUtil SetFormatRGBA $UBYTE $UBYTE $UBYTE $UBYTE
set portImg [poImage NewImage $w $h]

set fname "testOut/reticle.006$fInfo(suf)"
set msg   "$fname: Drawing reticle (2 circles) in yellow"
P $msg
poImgUtil SetDrawColorRGBA 1 1 0  1
$portImg Blank
::poImgUtil::DrawReticle $portImg 40 2 100 30
$portImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $portImg $msg

# Generate a circle image and composite it on top of another.
set w 400
set h 400
# The background image.
set lay [poImage NewImageFromFile "testIn/keksi$fInfo(suf)"]
$lay GetImageInfo wl hl
set bgImg [poImage NewImage $w $h]
$bgImg Blank
$bgImg ScaleRect $lay 0 0 $wl $hl 0 0 $w $h
poImgUtil DeleteImg $lay
set fname "testOut/reticle.007$fInfo(suf)"
set msg   "$fname: Drawing circle matte"
P $msg
# The circle image.
poImgUtil SetFormatRGBA $UBYTE $UBYTE $UBYTE $UBYTE
set fgImg [poImage NewImage $w $h]
$fgImg Blank
poImgUtil SetDrawColorRGBA 1 0 0  1
$fgImg DrawRect 0 0 $w $h
poImgUtil SetDrawColorRGBA 1 1 1  0
$fgImg DrawCircle [expr $w/2] [expr $h/2] [expr $w/2]

# Composite the two images.
$fgImg CompositeAlpha $fgImg $bgImg 1 1 1  1 1 1  ON $fgImg

$fgImg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $fgImg $msg

PSec "Required time" [$sw lookup]

poImgUtil DeleteSwatch $sw
poImgUtil DeleteImg $sqrImg
poImgUtil DeleteImg $landImg
poImgUtil DeleteImg $portImg
poImgUtil DeleteImg $fgImg
poImgUtil DeleteImg $bgImg

PS
P "End of test"

ui_show

if { [lindex $argv 0] eq "auto" } {
    ui_exit
    exit 0
}
