LJ Archive

Listing 2: Stage 1 in Tcl/Tk, an alternative, duffing.tcl

canvas .duffing -width 210 -height 210
.duffing create oval     50 190  60 200 \
                -fill blue -tag movable
.duffing create line      5 205 205 205
.duffing create line      5   5   5 205
.duffing create text     20  10         -text "k"
.duffing create text    190 190         -text "B"
.duffing bind   movable <Button-1>    {
  CanvasMark %x %y %W
}
.duffing bind   movable <B1-Motion>   {
  CanvasDrag %x %y %W
}
proc CanvasMark { x y w } {
  global canvas
  set canvas($w,obj) [$w find closest $x $y]
  set canvas($w,x) $x
  set canvas($w,y) $y
}
proc CanvasDrag { x y w } {
  global canvas
  if {$x <   5}  { set x [expr   5] }
  if {$x > 205}  { set x [expr 205] }
  if {$y <   5}  { set y [expr   5] }
  if {$y > 205}  { set y [expr 205] }
  $w move $canvas($w,obj) [expr $x-$canvas($w,x)]\
                          [expr $y-$canvas($w,y)]
  set canvas($w,x) $x
  set canvas($w,y) $y
  puts stdout "B [expr  0.150 * $x - 0.750]"
  puts stdout "k [expr -0.005 * $y + 1.025]"
  flush stdout
}
pack .duffing
LJ Archive