#!/bin/sh
# examples: clock, turmite, bomb, tkman, pacman, billiard, FLIPPER etc.
#  how to make a trace picture??? like painting
#
# tcl ignores the next line, but sh not \
/usr/X11R6/bin/wish $0 $@; exit

# old for every object asyncron bounce (error to large!)
# better one bounce-routine for all objects (syncron)

set idle 5
set num_ball 0
set collision 0
set gravity 0.1
set radius 20
set time 0
set dtime 1
set button1 0
set fric 0.995
set score 0
set hscore 0

canvas .c -height 480 -width 320
pack .c 

proc addWall { x0 y0 x1 y1 p } {
  global num_walls wall
  set n [expr [array size wall]/5]
  array set wall [list x0$n $x0 y0$n $y0 x1$n $x1 y1$n $y1 p$n $p]
  incr n
  set num_walls $n
}

# if px is set some action takes place on reflection
#  1 = add impuls
#  2 = remove impulse
#  4 = add 1 point to score and add 8 for 10sec
#  8 = add 2 points
# set minimumarray two buttons
array set wall {
 x00  80 y00 420 x10 140 y10 440 p0 0
 x01 220 y01 420 x11 160 y11 440 p1 0
}
# left and right bottom
addWall    0  380   80  420  0
addWall  290  380  220  420  0
# hat
addWall  150  140  190  160  0
addWall  150  140  110  160  0
addWall  135  150  165  150  4
# hat
addWall  150  240  180  260  0
addWall  150  240  120  260  0
addWall  135  250  165  250  4
# upper walls
addWall   20  180   50  190  0
addWall  270  180  240  190  0
# right wall
addWall  290   80  290  480  0
addWall  260    0  320   40  0
# lamps
addWall    10   20    10   35  4
addWall    10   40    10   55  4
addWall    10   60    10   75  4
addWall    10   80    10   95  4
puts "num_walls $num_walls"

for {set idx 0} {$idx<$num_walls} {incr idx} {
  set nr [.c create line $wall(x0$idx) $wall(y0$idx) $wall(x1$idx) $wall(y1$idx) -tag b$idx]
  if { $wall(p$idx) & 4 } { .c itemconfigure $nr -fill red }
}

array set colors { 0 black 1 red 2 green 3 yellow 4 blue 5 cyan 6 brown 7 white }

menu .menu -tearoff 0
menu .menu.m1 -tearoff 0
menu .menu.opt -tearoff 0
menu .menu.help -tearoff 0

.menu add cascade -label "Menu" -menu .menu.m1 -underline 0

 .menu.m1 add command -label "Add Ball" -command {new_ball [expr int(320*rand())] [expr int(480*rand())] [expr rand()-0.5] [expr rand()-0.5] $colors([expr $num_ball % 8])}
 .menu.m1 add command -label "Remove Ball" -command {set num_ball [expr $num_ball - 1]}
 .menu.m1 add command -label "Remove all" -command {set num_ball 0}
 .menu.m1 add command -label "Clear Image" -command {name1 blank}
 .menu.m1 add separator
 .menu.m1 add command -label "Lock" -command {exec xlock -mode blank}
 .menu.m1 add command -label "Exit" -command exit
 
.menu add cascade -label "Options" -menu .menu.opt -underline 0

 .menu.opt add checkbutton -label "show Collision" -onvalue 1 -offvalue 0 -variable collision

.menu add cascade -label "Help" -menu .menu.help -underline 0

 .menu.help add command -label "Version" -command { procVersion .menu.help }
 .menu.help add command -label "Author" -command { procAuthor .menu.help }
 .menu.help add command -label "TkVars" -command { procVars .menu.help }
 .menu.help add command -label "Keys" -command { procKeys .menu.help }

. configure -menu .menu

#bind Menu <<MenuSelect>> {}

proc procVersion { w } {
  tk_messageBox -icon info -message "tkflipper version 0.2" -type ok -parent $w
}

proc procAuthor { w } {
  tk_messageBox -icon info -message "jschulen/at/gmx/dot/de" -type ok -parent $w
}

proc procKeys { w } {
  tk_messageBox -icon info -message " left/right mouse button\n middle button for start" -type ok -parent $w
}

proc procVars { w } {
  global tcl_version tcl_platform
  tk_messageBox -icon info -message "tcl_version: $tcl_version\n\
  tcl_platform:\n [array get tcl_platform]\n"\
  -type ok -parent $w
}

# create a empty background picture for trace painting
# image create photo name1 -file TkGame1.ppm
image create photo name1 -height 480 -width 320
name1 blank
.c create image 160 240 -image name1

# .c create line 0 0  320 480 -arrow last
.c create line 1 1  320 1  320 480  1 480  1 1
.c create text 160 10 -tags score -text "$score"

#bind .c <ButtonPress-1> { puts "click1 %W %x %y" }
#bind .c <B1-Motion> { puts "drag %W %x %y" }
#bind .c <ButtonRelease-1> { puts "drop1 %W %x %y" }
#bind . <Key-y> { puts "%K pressed" }
# bind .c <Key> { puts "%K pressed in %W " }
#focus .c

proc procSetP0 { n } {
  global wall
  set wall(p$n) [expr $wall(p$n) & 4]
  if { $wall(p$n) == 0 } {
    .c itemconfigure b$n -fill black
  } else {
    .c itemconfigure b$n -fill red
  }
}

# same as walls?
# state of the buttons 
#  can even have impuls for ball
bind .c <ButtonPress-1>   {
 global wall
 set wall(p0) 1
# after 500 [list procSetP0 0]
}
bind .c <ButtonRelease-1> {
 global wall
 set wall(p0) 2
# after 500 [list procSetP0 0]
}

bind .c <ButtonPress-3>   {
 global wall
 set wall(p1) 1
# after 500 [list procSetP0 1]
}
bind .c <ButtonRelease-3> {
 global wall
 set wall(p1) 2
# after 500 [list procSetP0 1]
}
bind .c <ButtonPress-2>   {
 global aBall wall num_ball
 for {set idx 0} {$idx<$num_ball} {incr idx} {
  if { $aBall(rx$idx) > 290 } {
    set aBall(vy$idx) [expr $aBall(vy$idx)-10]
    set aBall(vx$idx) [expr 2*(rand()-0.5)]
  }
 }
 set wall(p0) 1
 set wall(p1) 1
}
bind .c <ButtonRelease-2>   {
 global wall
 set wall(p0) 2
 set wall(p1) 2
}

array set aBall { }

proc new_ball {xpos ypos vx vy color} {
 global num_ball aBall
 set x0 [expr $xpos-10]
 set x1 [expr $xpos+10]
 set y0 [expr $ypos-10]
 set y1 [expr $ypos+10]
 set num $num_ball
 set num_ball [expr $num_ball+1]
 .c create oval $x0 $y0 $x1 $y1 -fill $color -tag "ball-$num"
 # expand array
 array set aBall [list rx$num $xpos ry$num $ypos vx$num $vx vy$num $vy color$num $color]
# parray aBall
# puts " - "
}

proc bounce { num } {
 global idle num_ball num_walls wall gravity aBall time dtime fric score collision hscore
 if     { $num < $num_ball } {
   set num $num_ball;
 }
 if { $num == $num_ball } {
  for {set idx 0} {$idx<$num_ball} {incr idx} {
   set gy $gravity
   set gx 0
   set xpos $aBall(rx$idx)
   set ypos $aBall(ry$idx)
   set vx $aBall(vx$idx)
   set vy $aBall(vy$idx)
   if { $xpos>0 && $xpos<=320 && $ypos>0 && $ypos<=480 } {
     .c coords "ball-$idx" [expr round($xpos)-10] [expr round($ypos)-10] [expr round($xpos)+10] [expr round($ypos)+10]
   }
   update idletask
   set tvy [expr $fric*$vy + $gy]
   set tvx [expr $fric*$vx + $gx]
   for {set n 0} {$n<$num_walls} {incr n} {
     set x0 $wall(x0$n)
     set x1 $wall(x1$n)
     set y0 $wall(y0$n)
     set y1 $wall(y1$n)
     set t -1; set s -1
     # r+t*v=r0+s*(r1-r0)  => 0<r<1 && 0<s<1
     set det [expr ($y1-$y0)*$vx-($x1-$x0)*$vy]
     if { $det != 0 } {
       set t [expr (($x0-$xpos)*($y1-$y0)-($y0-$ypos)*($x1-$x0))/$det]
       set s [expr (($x0-$xpos)*$vy      -($y0-$ypos)*$vx      )/$det]
     }
     if { $t >= 0 && $t <= 1.5 && $s >= 0 && $s <= 1 } { 
       if { $collision } {
         puts "collision between $idx and $n mode $wall(p$n)"
       }
       # v - 2 v_\perp
       set r [expr  1./sqrt(($y1-$y0)*($y1-$y0)+($x1-$x0)*($x1-$x0))]
       set px [expr  ($y1-$y0)*$r]
       set py [expr -($x1-$x0)*$r]
       set vpx [expr  ($vx*$px+$vy*$py)*$px]
       set vpy [expr  ($vx*$px+$vy*$py)*$py]
       set vx [expr   $vx-2*$vpx]
       set vy [expr   $vy-2*$vpy]
       if { $wall(p$n) & 1 } { set vy [expr $vy - 5] }
       if { $wall(p$n) & 2 } { set vx [expr $vx * 0.5]; set vy [expr $vy * 0.5] }
       if { ($wall(p$n) & 12) == 12 } {
          .c itemconfigure b$n -fill blue
          incr score 4; .c itemconfigure score -text "$score/$hscore"
       }
       if { ($wall(p$n) & 12) == 4 } {
          incr wall(p$n) 8
          .c itemconfigure b$n -fill green
          incr score; .c itemconfigure score -text "$score/$hscore"
          after 10000 [list procSetP0 $n] 
       }
       if { $x1-$x0 != 0 } {
         set gx [expr ($y1-$y0)*1.0/($x1-$x0)*$gravity]
       }
       set gy -0.001
     }
     if { ($wall(p$n) & 1)==1 && $wall(y1$n)>[expr $wall(y0$n)-10] } {
       incr wall(y1$n) -1
       .c coords b$n  $wall(x0$n) $wall(y0$n) $wall(x1$n) $wall(y1$n)
       if { $wall(y1$n) <= [expr $wall(y0$n)-10] } { procSetP0 $n }
     }
     if { ($wall(p$n) & 2)==2 && $wall(y1$n)<[expr $wall(y0$n)+20] } {
       incr wall(y1$n) 1
       .c coords b$n  $wall(x0$n) $wall(y0$n) $wall(x1$n) $wall(y1$n)
       if { $wall(y1$n) >= [expr $wall(y0$n)+20] } { procSetP0 $n }
     }
   }
   if { $ypos >= 470 && $xpos <= 290 } {
     if { $score > $hscore } { set hscore $score }
     puts "game finished, score=$score highscore=$hscore"
     .c itemconfigure hscore -text "$score/$hscore"
     set vx 0; set vy 0; set xpos 305; set score 0
   }
   set vy [expr $fric*$vy + $gy]
   set vx [expr $fric*$vx + $gx]
   set xpos [expr $xpos+$vx]
   set ypos [expr $ypos+$vy]
   if     { $vx > 0 && $xpos >= 310 } { set vx [expr -$vx] }\
   elseif { $vx < 0 && $xpos <=  10 } { set vx [expr -$vx] }
   if     { $vy > 0 && $ypos >= 470 } { set vy [expr -$vy] }\
   elseif { $vy < 0 && $ypos <=  10 } { set vy [expr -$vy] }
   set aBall(rx$idx) $xpos
   set aBall(ry$idx) $ypos
   set aBall(vx$idx) $vx
   set aBall(vy$idx) $vy
  }
 } else { # delete Ball
   set num [expr $num - 1]
   .c delete "ball-$num"
 }
 set time [expr $time + $dtime]
 after $idle [list bounce $num]
}

new_ball 305 470   0 0 black
#new_ball 160 50  -0.7  0.2 red
# start task
bounce 0