source pkgsNeeded.tcl

ui_init "t_video.tcl"
SetFileTypes

PH "Image commands for video applications"

set sw [poImgUtil NewSwatch]

set xfrm 720
set yfrm 576
set xfld $xfrm
set yfld [expr ($yfrm / 2)]
set asp 1.25

set fld1 [poImage NewImage $xfld $yfld $asp]
set fld2 [poImage NewImage $xfld $yfld $asp]
set frm  [poImage NewImage $xfrm $yfrm $asp]

$fld1 Blank
$fld2 Blank
poImgUtil SetDrawColorRGB 1 0 0
$fld1 DrawText 50 50 "Field 1"
poImgUtil SetDrawColorRGB 0 1 0
$fld2 DrawText 50 50 "Field 2"

set fname "testOut/videoInterlace$fInfo(suf)"
set msg   "$fname: Interlacing 2 fields into 1 frame"
P $msg
$frm Interlace $fld1 $fld2 OFF
$frm WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $frm $msg

set fname "testOut/videoOddField$fInfo(suf)"
set msg   "$fname: De-Interlacing odd field from frame"
P $msg
$fld1 Blank
$fld1 Unlace $frm ON
$fld1 WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $fld1 $msg

set fname "testOut/videoEvenField$fInfo(suf)"
set msg   "$fname: De-Interlacing even field from frame"
P $msg
$fld2 Blank
$fld2 Unlace $frm off
$fld2 WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $fld2 $msg

set fname "testOut/videoCross$fInfo(suf)"
set msg "$fname: Cross dissolving two images"
P $msg
$fld1 CrossDissolve $fld1 $fld2 0.2
$fld1 WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $fld1 $msg

set fname "testOut/videoFlicker$fInfo(suf)"
set msg   "$fname: Flicker filter"
P $msg
$frm Flicker
$frm WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $frm $msg

set w 300
set h 300
set fname "testOut/videoComposite$fInfo(suf)"
set msg   "$fname: Compositing with grayscale matte"
P $msg
poImgUtil SetFormatRGBA $UBYTE $UBYTE $UBYTE $UBYTE
poImgUtil SetDrawMaskRGBA $ON $ON $ON $ON
set fgimg [poImage NewImage $w $h]
set bgimg [poImage NewImage $w $h]
set mtimg [poImage NewImage $w $h]

poImgUtil SetDrawColorRGB 1 1 0
$fgimg DrawRect 0 0 $w $h

poImgUtil SetDrawColorChan $MATTE 0.2
$mtimg DrawRect 0 0 $w $h

$bgimg ReadImage "testIn/keksi$fInfo(suf)" true

$fgimg CompositeAlpha $fgimg $bgimg 1 1 1  1 1 1  $ON $mtimg
$fgimg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $fgimg $msg

set fname "testOut/videoMatte$fInfo(suf)"
set msg   "$fname: Adding matte to make upper half of image transparent"
P $msg
poImgUtil SetDrawMaskRGBA $OFF $OFF $OFF $ON
poImgUtil SetDrawColorChan $MATTE 0
$bgimg DrawRect 0 0 $w $h
poImgUtil SetDrawColorChan $MATTE 1
$bgimg DrawRect 0 0 $w [expr $h / 2]
$bgimg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
ui_addimg $bgimg $msg [poImgUtil GetRGBA]

PSec "Required time" [$sw lookup]

poImgUtil DeleteSwatch $sw
poImgUtil DeleteImg $mtimg
poImgUtil DeleteImg $bgimg

PS
P "End of test"

ui_show

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