# Listing of doc/example-scripts/tk-locomotive.tcl

Example by <Richard Suchenwirth> http://wiki.tcl.tk/1329

- translated from Tcl to XOTcl by gustaf neumann in 2001

- translated from XOTcl to NX by gustaf neumann in 2010

Left mousebutton starts, middle slows down, right stops

    package require Tk
    package require nx
    package require nx::trait

    nx::Class create Wheel {
      :property x
      :property y
      :property r
      :property {spokes 24}
      :property {pivot 0}
      :property {color red}
      :property {tag ""}

      :public method drawSpokes {} {
        ::nx::var import [:info parent] c alpha
        set delta [expr {360.0 / ${:spokes}}]
        set deg2arc [expr {atan(1.0)*8/360.}]
        for {set i 0} {$i < ${:spokes}} {incr i} {
          set x1 [expr {${:x} + cos($deg2arc*$alpha) * ${:r}}]
          set y1 [expr {${:y} + sin($deg2arc*$alpha) * ${:r}}]
          $c create line ${:x} ${:y} $x1 $y1 -fill ${:color} -tag spoke
          set alpha [expr {$alpha + $delta}]
        }
        if {[info exists :act_pivot]} {
          lassign [set :act_pivot] item perc
          set rp [expr {${:r} * $perc}]
          set xp [expr {${:x} - $rp * cos($deg2arc * $alpha)}]
          set yp [expr {${:y} - $rp * sin($deg2arc * $alpha)}]
          $c coords $item $xp $yp [expr {$xp + 1}] [expr {$yp + 1}]
        }
      }

      :method init {} {
        ::nx::var import [:info parent] c alpha
        set alpha 0.

        set :y [expr {${:y} - ${:r}}]
        $c create oval \
            [expr {${:x} - ${:r}}] [expr {${:y} - ${:r}}] \
            [expr {${:x} + ${:r}}] [expr {${:y} + ${:r}}] \
            -outline white
        set r1 [expr {${:r}-2}]
        set W [$c create oval \
                   [expr {${:x} - $r1}] [expr {${:y} - $r1}] \
                   [expr {${:x} + $r1}] [expr {${:y} + $r1}] \
                   -outline ${:color} -width 2]
        :drawSpokes

        if {${:pivot}} {
          set deg2arc [expr {atan(1.0) * 8 / 360.0}]
          set rp [expr {$r1*${:pivot}}]
          set xp [expr {${:x} - $rp * cos($deg2arc * $alpha)}]
          set yp [expr {${:y} - $rp * sin($deg2arc * $alpha)}]
          set new_pivot [$c create rect $xp $yp [expr {$xp + 1}] [expr {$yp + 1}] \
                             -fill ${:color} -tag [list ${:tag} pivot]]
          set :act_pivot [list $new_pivot ${:pivot}]

          $c create arc [expr {${:x} - $r1}] [expr {${:y} - $r1}]\
              [expr {${:x} + $r1}] [expr {${:y} + $r1}] \
              -style chord -fill ${:color} -start 310 \
              -extent 80 -tag counterweight
          set :pivot $new_pivot
        }
        set rh [expr {${:r} / 12.0}]
        $c create oval \
            [expr {${:x} - $rh}] [expr {${:y} - $rh}] \
            [expr {${:x} + $rh}] [expr {${:y} + $rh}] \
            -fill white -tag hub
        set :r $r1
      }
    }

    nx::Class create Locomotive {
      :property {speed 4}

      :require trait nx::trait::callback

      :method turn {} {
        set :alpha [expr {round(${:alpha} + 360 - ${:speed}) % 360}]
        foreach i [${:c} find withtag counterweight] {
          ${:c} itemconfig $i -start [expr {310 - ${:alpha}}]
        }
        ${:c} delete spoke
        foreach wheel [:info children] { $wheel drawSpokes }
        ${:c} raise hub
        set xp0 [expr {105 + 15 * sin((${:alpha} - 90) * atan(1.0) * 8 / 360)}]
        ${:c} delete piston
        ${:c} coords p0 $xp0 120 [expr {$xp0+2}] 122 ;#CW
        ${:c} create line 90 121 $xp0 121 -width 2 -fill white -tag piston ;#CW
        :drawRod p0 p1 p2 p3
        ${:c} raise p0
        foreach i [${:c} find withtag smoke] {
          if {[lindex [${:c} bbox $i] 3]<0} {
            ${:c} delete $i
          } else {
            ${:c} move $i [expr {rand() * ${:speed} / 3.0}] [expr {rand() * 2 - 2}]
          }
        }
        set t [${:c} create oval [${:c} bbox chimney] -fill white -outline white -tag smoke]
        ${:c} move $t 0 -10
        ${:c} lower smoke
      }

      :method drawRod {p0 p1 p2 p3} {
        ${:c} delete rod
        ${:c} create rect [${:c} bbox $p1 $p3] -fill white -tag rod
        ${:c} create line {*}[lrange [${:c} bbox $p0] 0 1] \
            {*}[lrange [${:c} bbox $p2] 0 1] -width 3 -fill white -tag rod
        ${:c} raise rod
        ${:c} raise pivot
      }

      :public method tick {} {
        :turn
        foreach i [after info] {after cancel $i}
        after 10 [self] tick
      }

      :public method throttle {} {
        incr :speed 2
        :tick
      }

      :public method break {} {
        incr :speed -2
        if {${:speed}<0} {set :speed 0}
        :tick
      }

      :public method emergencyBreak {} {
        set :speed 0
        :tick
      }

      :method init {} {
        set :c [canvas .c -width 600 -height 160 -background lightblue]
        pack ${:c}

        bind ${:c} <1> [:callback throttle]
        bind ${:c} <2> [:callback break]
        bind ${:c} <3> [:callback emergencyBreak]

        ${:c} delete all
        ${:c} create rect 32 115 360 125 -fill black ;# frame
        ${:c} create rect 22 118 32 122 -fill grey30 ;# buffer
        ${:c} create line 22 115 22 125
        ${:c} create poly 60 95 40 115 50 115 70 95 -fill black
        ${:c} create rect 60 45 310 95 -fill grey25 ;# boiler
        ${:c} create oval 55 50 65 90 -fill black ;# smokebox
        ${:c} create rect 70 32 85 50 -fill black -tag chimney
        ${:c} create rect 40 52 90 75 -fill black ;# wind diverter
        ${:c} create oval 130 36 150 52 -fill black ;# dome
        ${:c} create rect 195 35 215 50 -fill black ;# sandbox
        ${:c} create oval 260 36 280 52 -fill black ;# dome
        ${:c} create rect 65 100 90 135 -fill black ;# cylinder
        ${:c} create rect 90 120 92 122 -fill red -tag p0 ;# crossbar
        ${:c} create rect 72 87 82 100 -fill black ;# steam tube
        ${:c} create rect 310 40 370 115 -fill black ;# cab
        ${:c} create rect 310 32 390 42 -fill grey30 ;# cab roof
        ${:c} create text 338 82 -text "01 234" -fill gold -font {Times 7}
        ${:c} create rect 318 48 333 66 -fill white ;# cab window #1
        ${:c} create rect 338 48 355 66 -fill white ;# cab window #2
        Wheel new -childof [self] -x 50 -y 150 -r 13 -spokes 12
        Wheel new -childof [self] -x 105 -y 150 -r 13 -spokes 12
        Wheel new -childof [self] -x 150 -y 150 -r 30 -pivot 0.5 -tag p1
        Wheel new -childof [self] -x 215 -y 150 -r 30 -pivot 0.5 -tag p2
        Wheel new -childof [self] -x 280 -y 150 -r 30 -pivot 0.5 -tag p3
        :drawRod p0 p1 p2 p3
        Wheel new -childof [self] -x 340 -y 150 -r 16 -spokes 12
        ${:c} create rect 360 110 380 118 -fill black
        ${:c} create rect 380 65 560 125 -fill black -tag tender
        ${:c} create rect 560 118 570 122 -fill grey30 ;# buffer
        ${:c} create line 571 116 571 125
        ${:c} create rect 390 45 525 65 -fill black -tag tender
        Wheel new -childof [self] -x 395 -y 150 -r 13 -spokes 12
        Wheel new -childof [self] -x 440 -y 150 -r 13 -spokes 12
        ${:c} create rect 380 132 456 142 -fill red
        Wheel new -childof [self] -x 495 -y 150 -r 13 -spokes 12
        Wheel new -childof [self] -x 540 -y 150 -r 13 -spokes 12
        ${:c} create rect 480 132 556 142 -fill red -outline red
        ${:c} create rect 0 150 600 160 -fill brown ;# earth
        ${:c} create line 0 150 600 150 -fill grey -width 2 ;# rail
        :tick
      }
    }

    Locomotive new