#!/bin/sh
# \
exec wish $0 $@

package require Tk
package require opt

# Zeitauflösung
set res 50

# Äquivalenztabelle für Zahlen und Zahlenfeld
array set zahl2kp {
   0  KP_Insert
   1  KP_End
   2  KP_Down
   3  KP_Next
   4  KP_Left
   5  KP_Begin
   6  KP_Right
   7  KP_Home
   8  KP_Up
   9  KP_Prior
}

# Anzahl Perlen
set perlen 0

# Bilder:
image create photo fisch  -data "..."
image create photo hintergrund -data "..."
image create photo perle -data "..."

proc gui {} {
   global canvas x y

   # Canvas erzeugen und mit Bildern füllen
   set canvas [canvas .canvas -width 500 -height 500 -bg grey20]
   grid $canvas -row 0 -column 0 -sticky nesw
   $canvas create image 0 500 -image hintergrund -anchor sw
   $canvas create image 140 390 -image fisch -anchor sw -tag fisch

   # Blasenstartpunkt festlegen
   set x 167
   set y 365

   # Fisch-Animation starten
   fischBewegen

   wm sizefrom . program
   wm geometry . 500x500
   bind . <q> "exit 0"
   bind . <Control-q> "exit 0"
}

proc fischBewegen {} {
   global canvas x y res

   set dx [expr {round(rand() * 1 * ((rand()<0.5)*2 -1))}]
   set dy [expr {round(rand() * 1 * ((rand()<0.5)*2 -1))}]
   $canvas move fisch $dx $dy

   incr x $dx
   incr y $dy

   after [expr {round(rand()*2*$res)}] fischBewegen
}

proc blaseNeu {} {
   global canvas x y zahl2kp res

   # Tag generieren
   set id [clock clicks -milliseconds]

   # Blase
   $canvas create oval \
      [expr {$x -3}] [expr {$y -3}] \
      [expr {$x +3}] [expr {$y +3}] \
      -tags [list "t$id" "blase$id"] \
      -fill skyblue

   # Text
   set zahl [expr {round( floor( rand() * 9.0 ) )}]
   $canvas create text $x $y \
      -font "Helvetica 5 bold" \
      -text $zahl \
      -anchor center \
      -tags [list "t$id" "text$id" ]

   # Auf richtigen Tastendruck hören
   bind . <KeyPress-$zahl> "blaseWeg $id"
   bind . <KeyPress-$zahl2kp($zahl)> "blaseWeg $id"

   # Start
   after $res blaseAktualisieren $id
}

proc blaseAktualisieren {id} {
   global canvas x y res

   # Blase noch da?
   if {[string eq [$canvas type "blase$id"] ""]} {
      return;
   }

   # Blase schon aus dem Canvas raus?
   if {[lindex [$canvas bbox "blase$id"] 1] < 0} {
      blaseLöschen $id
      blaseNeu
      return;
   }

   # wie alt?
   set alter [expr {[clock clicks -millisec] - $id}]
   if { $alter < 1200 } {
      # Blase vergrößern
      $canvas delete "blase$id"
      set radius [expr {$alter / $res * 0.75}]
      $canvas create oval \
         [expr {$x -$radius}] [expr {$y -$radius}] \
         [expr {$x +$radius}] [expr {$y +$radius}] \
         -tags [list "t$id" "blase$id"] \
         -fill skyblue -outline ""

      # Schrift größer und nach vorn setzen
      set punkte [expr {round($alter / $res * 0.5)}]
      $canvas itemconfigure "text$id" -font "Helvetica $punkte bold"
      $canvas raise text$id blase$id
   } else {
       # Blase aufsteigen lassen
       set dx [expr {cos( rand() * 20 )*1.2}]
       set vy [expr {$::tempo * ($alter - 700) / double(3e5)}]
       set dy [expr {-$vy * $res}]

       $canvas move "t$id" $dx $dy
   }
   after $res blaseAktualisieren $id
}

proc blaseLöschen {id} {
   # Welche Zahl steht in der Blase?
   set zahl [$::canvas itemcget "text$id" -text]
   # Blase im Canvas löschen
   $::canvas delete "t$id"
   # Bindings löschen
   bind . <KeyPress-$zahl> ""
   bind . <KeyPress-$::zahl2kp($zahl)> ""
}

proc blaseWeg {id} {
   blaseLöschen $id
   perleNeu
   blaseNeu
}

proc perleNeu {} {
   global canvas perlen

   # ID generieren
   set id [clock clicks -milliseconds]

   set einer [expr {int(fmod($perlen, 10))}]
   if { $einer == 0 && $perlen != 0 } {
      perleZähler
   }
   $canvas create image 140 480 -image perle \
      -tags p$id
   incr perlen
   perleBewegen $id
}

proc perleBewegen {id} {
   global canvas res

   # Position der anderen Perlen
   set xSoll [lindex [$canvas bbox perlen] 0]
   if {[string match $xSoll ""]} {
      set xSoll 420
   }

   # Eigene Position
   set xIst [lindex [$canvas bbox p$id] 0]

   if { $xIst >= $xSoll - 30 } {
      $canvas addtag perlen withtag p$id
   } else {
      $canvas move p$id 5 0
      after $res "perleBewegen $id"
   }
}

proc perleZähler {} {
   global canvas perlen

   $canvas delete perlen
   $canvas delete zähler

   $canvas create text 480 480 -text $perlen \
      -font {Palatino 25 bold } \
      -fill #b0c5db \
      -tags zähler
}

tcl::OptProc main {
   {-tempo -int 10 "Tempo, normal ist 10"}
} {

   if { $tempo < 1 || $tempo > 100} {
      error "tempo muss zwischen 1 und 100 liegen"
   }
   set ::tempo $tempo
   gui
   blaseNeu
}

eval main $argv