# Optical illusions
 # i) are these the same length?- adjust the arrow angle and the length to identify maximum illusion

 proc drawarrowline { frm  len y angle mid} {
        set r 30
        set dx [expr $r*cos($angle*.017345)]
        set dy [expr $r*sin($angle*.017345)]
        $frm create line [expr $mid-$len] $y [expr $len+$mid] $y -fill black -width 3
        lappend line [expr $mid-$len - $dx] [expr $y + $dy]  [expr $mid-$len] $y [expr $mid-$len - $dx] [expr $y - $dy]

        $frm create line $line -fill black -width 3
        lset line []
        lappend line [expr $mid +$len + $dx] [expr $y + $dy] [expr $mid +$len] $y [expr $mid +$len + $dx] [expr $y - $dy]

        $frm create line $line -fill black -width 3
 }

 proc redraw { va} { ;# l2 is length of the second line; angle the angle of the arrows
         global len angle reflen
             catch [destroy .frm] {} ;# delete drawing area. Same as clear.
        set wid 125
        set frm [canvas .frm -width [expr $wid*2] -height 140]
                # draw 2 lines of length xx with 'arrows' at opposite angles
        drawarrowline $frm $reflen 50 $angle $wid
        drawarrowline $frm [expr int(35+$len*0.3)]  100 [expr int(180-$angle)] $wid
        pack .frm
 }

 proc checkok {} {
          global len angle reflen suml ntries
        lappend suml [expr 100*(35+$len*0.3)/($reflen)]
        incr ntries
 # set a new random test length and jumble up the uer set to remove hints
        set reflen [expr 42 + 15*rand()]
        set len [expr 90*rand()]
        if {$ntries>10} { Scores
        } else { redraw 0 ;# draw the new lines
        }
 }
 proc Scores {} {
          global len angle reflen  suml ntries
        if {$ntries>0} {
                set sum 0
                foreach score $suml {
                        puts "Score $score"
                        set sum [expr $sum+$score]
                }
                puts "After $ntries, average [format %.1f [expr $sum/$ntries]]% of desired length with angle $angle degrees."
                set reflen [expr 42 + 15*rand()]
                set len [expr 90*rand()]
                redraw 0
                set ntries 0
                set suml {}
        }
 }
 proc createArrowIllusion {} {
          global len angle reflen ;# arrow length, angle and compare with length
        global suml ntries
        set ntries 0
        set suml {}
        set reflen [expr 42 + 15*rand()]
        set len 60
        set angle 20
            catch [destroy .btns] {} ;# delete controls
        set btn [frame .btns]
        pack $btn -side top
        label $btn.inst -text "Adjust Length until the two lines are equal length.\nThen press 'OK' and repeat."
        menubutton $btn.angl -menu $btn.angl.opts  -text "Set Angle"
        set mn [menu $btn.angl.opts ]
        for {set i 20} {$i<165} {incr i 20} {
                $mn add command -label "$i" -command "set angle $i;redraw 0"
        }

        scale $btn.len -variable len -orient horizontal -showvalue false -label "Length" -command "redraw"
        button $btn.ok -text "OK" -command "checkok"
        button $btn.scr -text "Score" -command "Scores"
        set btnfrm [frame $btn.frm]
        pack $btn.inst $btn.angl $btn.len $btnfrm -side top
        pack $btn.ok $btn.scr -side left

        wm title . "Arrow Illusion"
 }

 createArrowIllusion