######################################################################
# cbspline.tcl :: TEST CODE
# Mar. 2013 by zhuo
######################################################################
package require cbspline
########################################
# MODEL
########################################
set ::m(idcnt) 0
proc mId {} {
set id $::m(idcnt)
incr ::m(idcnt)
return $id
}
proc mCreateSpline {xs ys div canv splEdgeColor splNodeColor refEdgeColor refNodeColor} {
set tag "spl[mId]"
if { [catch {set bases $::m(bases,$div)} msg] } {
set bases [cbspline::makeBases $div]
set ::m(bases,$div) $bases
}
set ::m($tag,xs) $xs
set ::m($tag,ys) $ys
set ::m($tag,div) $div
set ::v($tag,canv) $canv
vNewLine $tag crv [cbspline::interpolate $xs $bases] [cbspline::interpolate $ys $bases] $splEdgeColor $splNodeColor 0
vNewLine $tag ref $xs $ys $refEdgeColor $refNodeColor 1
return $tag
}
proc mSetNthNode {tag idx x y} {
lset ::m($tag,xs) $idx $x
lset ::m($tag,ys) $idx $y
set bases $::m(bases,$::m($tag,div))
vUpdateLine $tag crv [cbspline::interpolate $::m($tag,xs) $bases] [cbspline::interpolate $::m($tag,ys) $bases]
vUpdateLine $tag ref $::m($tag,xs) $::m($tag,ys)
}
########################################
# VIEW
########################################
#isActive : when set to 1, nodes get mouse-draggable.
proc vNewLine {tag label xs ys edgeColor nodeColor isActive} {
foreach x $xs y $ys { lappend coord $x $y }
set canv $::v($tag,canv)
$canv delete $tag,$label
$canv create line $coord -width 1 -fill $edgeColor -tags "$tag,$label $tag,$label,edge"
set idx 0
foreach {x y} $coord {
$canv move [$canv create rectangle -2 -2 2 2 -fill $nodeColor -outline "" \
-tags "$tag,$label $tag,$label,node,$idx"] $x $y
if $isActive {
$canv bind $tag,$label,node,$idx "mSetNthNode $tag $idx %x %y"
}
incr idx
}
}
proc vUpdateLine {tag label xs ys} {
foreach x $xs y $ys { lappend coord $x $y }
set canv $::v($tag,canv)
$canv coords $tag,$label,edge $coord
set idx 0
foreach {x y} $coord {
$canv coord $tag,$label,node,$idx -2 -2 2 2
$canv move $tag,$label,node,$idx $x $y
incr idx
}
}
########################################
# GUI
########################################
canvas .c -width 960 -height 640 -bg black
pack .c
# In this code, data of each spline are stored in array ::attr.
set XS0 { 100 200 150 350 500 600 600 500 }
set YS0 { 100 150 200 300 300 200 100 50 }
set XS1 { 100 200 150 350 500 600 600 500 }
set YS1 { 400 450 500 600 600 500 400 350 }
set spl0 [mCreateSpline $XS0 $YS0 8 .c yellow green red blue]
set spl1 [mCreateSpline $XS1 $YS1 4 .c yellow green red blue]
|