#! /bin/env tclsh

package require Tk

#-- either create, or clear canvas (and events)
if [catch {pack [canvas .c]}] {
    .c delete all
    foreach id [after info] {after cancel $id}
}
.c create poly 176 115  187 115  187 129  156 129  156 123 -fill brown -tag {shoe right}
.c create line 176 115  160 80  225 68 -fill blue3 -width 20 -tag leg0 -cap round
  .c create line 175 150 175 130 -fill white -width 3 -cap round -tag crank
#.c create line 170 127 180 127 -width 5 -tag pedal
.c create line 100 100 100 200 -fill white -tag spoke1
.c create line 50 150 150 150 -fill white -tag spoke1
.c create line 250 100 250 200 -fill white -tag spoke2
.c create line 200 150 300 150 -fill white -tag spoke2
.c create oval 50 100 150 200 -width 3
.c create oval 200 100 300 200 -width 3
.c create oval 160 135 190 165 -fill darkgrey
.c create oval 245 145 255 155 -fill darkgrey
.c create line 178 135 252 146
.c create line 178 165 252 154
.c create line 100 150 140 85 220 85 250 150 175 150 140 85 -fill yellow -width 3
.c create line 175 150 225 72 -fill yellow -width 4
.c create line 210 75 235 75 -fill brown -width 8 -cap round
.c create line 140 83 148 68 165 68 -fill white -width 3
.c create line 155 68 170 68 -fill black -width 6
.c create line 175 150 175 170 -fill white -width 3 -cap round -tag crank
.c create poly 178 165  187 165  187 176  156 176  156 169 -fill brown -tag {shoe left}
.c create line 178 165 170 100 225 68 -fill blue2 -width 20 -tag leg1 -cap round
#.c create line 170 173 180 173 -width 5 -tag pedal
.c create line 190 44  162 68 -fill pink -width 12 -cap round
.c create poly 210 60 240 65  230 0  205 0  185 35  195 45  205 40 -fill white
.c create oval 200 -30 230 0 -fill pink -outline {}
.c create line 210 -17 210 -20
.c create line 220 -17 220 -20
.c create arc  205 -8 225 -28 -start 210 -extent 120 -style arc

  option add *Scale.highlightThickness 0
  option add *Scale.orient vertical
  option add *Scale.relief ridge
  scale .c.s1 -from  1 -to 50 -variable delay -length 200
  .c create text   345  0 -text "Delay"
  .c create window 330 10 -window .c.s1 -anchor nw

.c config -scrollregion [.c bbox all]
 
proc rotate {w tag xm ym deg} {
    set da [expr {$deg/180.*acos(-1)}]
    foreach item [$w find withtag $tag] {
        set coords {}
        foreach {x y} [$w coords $item] {
            set r [expr {hypot($y-$ym,$x-$xm)}]
            set a [expr {atan2($y-$ym,$x-$xm)-$da}]
            lappend coords [expr {$xm+$r*cos($a)}] [expr {$ym+$r*sin($a)}]
        }
        $w coords $item $coords
    }
}
#-- Cyclical movement is not the same as rotation, though it shares some code
proc cmove {w tag xm ym deg} {
    set da [expr {$deg/180.*acos(-1)}]
    foreach item [$w find withtag $tag] {
        foreach {x0 y0 x1 y1} [$w bbox $item] break
        set x  [expr {($x0+$x1)/2.}]
        set y  [expr {($y0+$y1)/2.}]
        set r  [expr {hypot($y-$ym,$x-$xm)}]
        set a  [expr {atan2($y-$ym,$x-$xm)-$da}]
        set dx [expr {$xm+$r*cos($a)-$x}]
        set dy [expr {$ym+$r*sin($a)-$y}]
        $w move $item $dx $dy
    }
}
if 0 {The tricky bit is "jointed motion" - the parts of the legs from
foot to knee and from knee to hip have to be of constant length, so the
angle from and to the knee has to be recomputed. The following is just
a first approximation - feel free to make it better!}
proc jmove {w tag x0 y0} {
    foreach {xa ya xb yb xc yc} [$w coords $tag] break
    set dx [expr {($xa-$x0)*0.2}]
    set dy [expr {($ya-$y0)*0.7}]
    $w coords $tag $x0 $y0 [expr {$xb-$dx}] [expr {$yb-$dy}] $xc $yc
}
#-- Let the show begin!
proc every {ms body} {eval $body; after $ms [info level 0]}
if 0 {every 10 {
    rotate .c crank  175 150 5
    rotate .c spoke1 100 150 10
    rotate .c spoke2 250 150 10
    #cmove .c pedal  175 150 5
    cmove .c  shoe  175 150 5
    jmove .c leg0 [lindex [.c coords right] 0] [lindex [.c coords right] 1]
    jmove .c leg1 [lindex [.c coords left] 0]  [lindex [.c coords left] 1]
}}

  proc every1 {body} {eval $body; after $::delay [info level 0]}
  proc step1 {} {
    rotate .c crank  175 150  5
    rotate .c spoke1 100 150 10
    rotate .c spoke2 250 150 10
    cmove  .c shoe   175 150  5
    jmove  .c leg0 [lindex [.c coords right] 0] [lindex [.c coords right] 1]
    jmove  .c leg1 [lindex [.c coords left ] 0] [lindex [.c coords left ] 1]
  }

  set delay 10
  every1 step1

#-- Some development helpers:
bind . <Motion> {wm title . %x,%y}
bind . <Escape> {source $argv0}
bind . <F1> {console show}
bind . <F2> {
    package require Img
    [image create photo -data .c] write cyclist.gif
}