[AMG]: This script simulates pulling (or pushing!) a chain or string.  The chain is attached to the mouse pointer.  Just move the mouse to move the chain.  The important property of the chain is that its length never changes (unless perhaps you add the '''-smooth true''' option to the line creation, in which case it might change a small amount).

The length of the chain and the number of vertices are configurable.  For a "string" (smooth chain), set '''$vertices''' to one plus '''$length'''; this makes each segment (link) of the chain one pixel in length.  Or make the number of vertices very small (at least two) to see the jointed chain-like behavior.
======
 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. (And can the TCT ''please'' release 8.5 already? There are already too many 8.5 specific code floating around here and c.l.c for me to ignore.).
======
  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}
======
----
See also [TclSpringies : A simple mass and spring simulator].

<<categories>> Simulator | Mathematics | Whizzlet