package require Tcl 8.5
package require Tk
namespace path {::tcl::mathop ::tcl::mathfunc}
proc chain {w x1 y1} {
set length 400
set vertices 401
if {[llength [$w find withtag chain]] == 0} {
$w create line {*}[lrepeat $vertices $x1 $y1] -tags chain
} else {
set coords [list $x1 $y1]
set seglen [/ $length [- $vertices 1]]
foreach {x0 y0} [lrange [$w coords chain] 2 end] {
set xd [- $x1 $x0]
set yd [- $y1 $y0]
if {$xd == 0 && $yd == 0} {
return
}
set nd [/ $seglen [hypot $xd $yd]]
set x1 [- $x1 [* $xd $nd]]
set y1 [- $y1 [* $yd $nd]]
lappend coords $x1 $y1
}
$w coords chain {*}$coords
}
}
canvas .c -width 500 -height 500 -highlightthickness 0
pack .c -fill both -expand true
bind .c <Motion> {chain %W %x %y}AMG: You are invited to add more realistic physics properties and constraints to this simulation, for instance a minimum bend radius.
slebetman Here's one in Tcl 8.4 in case, like me, you don't have 8.5.
package require Tk
proc chain {w x1 y1} {
set length 400
set vertices 401
if {[llength [$w find withtag chain]] == 0} {
$w create line [string repeat "$x1 $y1 " $vertices] -tags chain
} else {
set coords [list $x1 $y1]
set seglen [expr {$length/($vertices-1)}]
foreach {x0 y0} [lrange [$w coords chain] 2 end] {
set xd [expr {$x1-$x0}]
set yd [expr {$y1-$y0}]
if {$xd == 0 && $yd == 0} {
return
}
set nd [expr {$seglen/hypot($xd,$yd)}]
set x1 [expr {$x1-($xd*$nd)}]
set y1 [expr {$y1-($yd*$nd)}]
lappend coords $x1 $y1
}
$w coords chain $coords
}
}
canvas .c -width 500 -height 500 -highlightthickness 0
pack .c -fill both -expand true
bind .c <Motion> {chain %W %x %y}TR Oh, this is great to play around with! And it shows how powerful Tcl is within just a few lines of code.
See also TclSpringies : A simple mass and spring simulator.
