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.