#!/usr/bin/wish


canvas .c -width 800 -height 600 -bg white
pack .c -side top

frame .l
pack .l -side bottom -fill both
button .l.ba -text "A" -command "A" -height 2 -width 2 -background red -border 5
button .l.bb -text "B" -command "B" -height 2 -width 2 -background blue -border 5 
entry .l.e -textvariable path -width 90 -background beige
pack .l.ba .l.bb  .l.e -side left


frame .f
pack .f -side bottom -fill both

button .f.br -text Reset -command "Reset" -background gray 
button .f.bc -text Clear -command "Clear" -background gray
button .f.bd -text Quit -command "destroy ." -background gray

pack .f.br .f.bc .f.bd  -side left

frame .g
pack .g -side bottom -fill both
button .g.r -text "Run:" -command Run -background gray
entry .g.rr -textvariable run -width 80 -background beige
button .g.i -text "Iterate:" -command Iterate -background gray
set num 12
entry .g.in -textvariable num -width 4 -background beige

pack .g.r  .g.rr .g.i .g.in  -side left

set posi [list 1 0]
set mom [list 0 1]
set w 2
set w0 3

.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last -width 2

.c create line [expr 400]  [expr 300]  [expr 100*[lindex $posi 0]+ 400] [expr -100*[lindex $posi 1] + 300] -fill red -tag vecp -arrow last -width 2

for {set i 1} {$i < 8} {incr i} {
for {set j 1} {$j < 6} {incr j} {
.c create oval [expr 100*$i - $w] [expr 100*$j - $w] [expr 100*$i + $w] [expr 100*$j + $w] -fill black
}
.c create oval [expr 400 -$w0] [expr 300 -$w0] [expr 400 +$w0] [expr 300 + $w0] -fill green
}


proc A {} {
global posi mom path 

set newp [list [expr [lindex $posi 0] + [lindex $mom 0]] [expr [lindex $posi 1] + [lindex $mom 1]]]

.c create line [expr 100*[lindex $posi 0] + 400] [expr -100*[lindex $posi 1] + 300] [expr 100*[lindex $newp 0] + 400] [expr -100*[lindex $newp 1] + 300]  -fill magenta -width 2

set posi $newp
.c delete vecm 
.c delete vecp

.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last  -width 2

.c create line [expr 400]  [expr 300]  [expr 100*[lindex $posi 0]+ 400] [expr -100*[lindex $posi 1] + 300] -fill red -tag vecp -arrow last  -width 2
append path "A"
}


proc B {} {
global posi mom path
set mom [list [expr {[lindex $mom 0] - [lindex $posi 0]}] [expr {[lindex $mom 1] - [lindex $posi 1]}] ]
.c delete vecm 
.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last  -width 2
append path "B"
}

proc Reset {} {
global posi mom path run w w0
set path ""
set run ""
if {[winfo exists .c]} {
destroy .c
canvas .c -width 800 -height 600 -bg white
pack .c -side top
set posi [list 1 0]
set mom [list 0 1]
for {set i 1} {$i < 8} {incr i} {
for {set j 1} {$j < 6} {incr j} {
.c create oval [expr 100*$i - $w] [expr 100*$j - $w] [expr 100*$i + $w] [expr 100*$j + $w] -fill black
}}
.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last -width 2

.c create line [expr 400]  [expr 300]  [expr 100*[lindex $posi 0]+ 400] [expr -100*[lindex $posi 1] + 300] -fill red -tag vecp -arrow last -width 2
}
.c create oval [expr 400 -$w0] [expr 300 -$w0] [expr 400 +$w0] [expr 300 + $w0] -fill green
}


proc Clear {} {
global posi mom path run w w0
set path ""
if {[winfo exists .c]} {
destroy .c
canvas .c -width 800 -height 600 -bg white
pack .c -side top
set posi [list 1 0]
set mom [list 0 1]
for {set i 1} {$i < 8} {incr i} {
for {set j 1} {$j < 6} {incr j} {
.c create oval [expr 100*$i - $w] [expr 100*$j - $w] [expr 100*$i + $w] [expr 100*$j + $w] -fill black
}}
.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last -width 2

.c create line [expr 400]  [expr 300]  [expr 100*[lindex $posi 0]+ 400] [expr -100*[lindex $posi 1] + 300] -fill red -tag vecp -arrow last -width 2
}
.c create oval [expr 400 -$w0] [expr 300 -$w0] [expr 400 +$w0] [expr 300 + $w0] -fill green
}

proc Run {} {
global posi mom path run
for {set i 0} {$i < [string length $run]} {incr i} {
set C [string index $run $i]
if {$C == "A"} {
A
} elseif {$C == "B"} {
B
}
update idletasks
after 100
}
}


proc Iterate {} {
global posi mom path run num
for {set j 0} {$j < $num} {incr j} {
for {set i 0} {$i < [string length $run]} {incr i} {
after 100
set C [string index $run $i]
if {$C == "A"} {
A1
} elseif {$C == "B"} {
B1
}
update idletasks
after 100
}
}
}


proc A1 {} {
global posi mom path 
set newp [list [expr [lindex $posi 0] + [lindex $mom 0]] [expr [lindex $posi 1] + [lindex $mom 1]]]

.c create line [expr 100*[lindex $posi 0] + 400] [expr -100*[lindex $posi 1] + 300] [expr 100*[lindex $newp 0] + 400] [expr -100*[lindex $newp 1] + 300] -fill magenta -width 2

set posi $newp
.c delete vecm 
.c delete vecp

.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last -width 2

.c create line [expr 400]  [expr 300]  [expr 100*[lindex $posi 0]+ 400] [expr -100*[lindex $posi 1] + 300] -fill red -tag vecp -arrow last -width 2
}


proc B1 {} {

global posi mom path

set mom [list [expr {[lindex $mom 0] - [lindex $posi 0]}] [expr {[lindex $mom 1] - [lindex $posi 1]}] ]
.c delete vecm 

.c create line [expr 100*[lindex $posi 0] + 400]  [expr -100*[lindex $posi 1] + 300]  [expr 100*([lindex $mom 0] + [lindex $posi 0]) + 400] [expr -100*([lindex $mom 1] + [lindex $posi 1]) + 300] -fill blue -tag vecm -arrow last -width 2
}