source pkgsNeeded.tcl

ui_init "t_warptree.tcl"
SetFileTypes

PH "Image warping with Tcl functions"

proc warpfunct { x y } {
    global xdistort ydistort
    set nx [expr $x - $xdistort*$y*$y]
    set ny [expr $y - $ydistort*$x*$x]
    return [list $nx $ny]
}

proc warpderiv { x y } {
    set ux 1
    set uy 1
    set vx 1
    set vy 1
    return [list $ux $uy $vx $vy]
}

foreach fileName { warpTree warpTreeAlpha } {
    set srcimg [poImage NewImageFromFile "testIn/$fileName$fInfo(suf)"]
    $srcimg GetImageInfo w h a g
    set dstimg [poImage NewImage $w $h $a $g]
    set msg "Original image"
    ui_addimg $srcimg $msg

    for { set i 1 } { $i <= 20 } { incr i } {
        set fname "testOut/$fileName.[format "%03d" $i]$fInfo(suf)"
	set istep 10
	set xdistort [expr ($i -1) / 200.0]
	set ydistort [expr ($i -1) / 600.0]
	set msg   "$fname: Warpanimation (Image $i)"
	P $msg
	$dstimg WarpFunct $srcimg warpfunct warpderiv $istep $IMGCLIP
	$dstimg WriteSimple $fname $fInfo(fmt) $fInfo(vsn)
	ui_addimg $dstimg $msg
    }
}
PS
P "End of test"

ui_show

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