[Ulrich Schoebel]: A weekend fun and my son's java class competition project.

Have fun.
----
[RS] explains: This page's title is German for "Man needs something warm", especially warm drinks. The following script by simulates a hot drink vending machine offering coffee/cappucino/tea/broth. Select your choice, insert Euro coins from right into the oblong slot. To drink (and be able to order more), click on the cup.

[US]: Thanks, Richard. I forgot to deliver the necessary documentation. ;-)

''[jcw] - Great fun!  Could I get you folks to add a "package require Tk", please?'' [RS]: Done ;-)
----

 #! /usr/local/bin/wish8.3
 package require Tk

 set guthaben 0
 set auswahl ""
 set preis 0
 set filled 0
 array set drink_color {kaffee SaddleBrown bruehe OliveDrab tee goldenrod capuccino sienna}
 array set preise {{} 0 kaffee 0.7 bruehe 0.9 tee 1.1 capuccino 1.3}
 array set wert {10c 0.1 20c 0.2 50c 0.5 1e 1 2e 2}
 
 #
 # Procs
 #
 
 # Glas mit Drink drink f�llen
 proc fill_glass {drink} {
 	global drink_color
 	.c create rectangle 150 410 160 500 -fill $drink_color($drink) -width 0 -tags jet
 	.c itemconfigure drink -fill $drink_color($drink)
 	filling
 }
 
 # Animation
 proc filling {} {
 	global filled
 	foreach {x y xb yb} [.c coords drink] {
 		set y [expr {int($y)}]
 		incr y -1
 		if {$y < 450} {
 			.c delete jet
 			set filled 1
 			return
 		}
 		.c coords drink $x $y $xb $yb
 		update idletasks
 	}
 	after 100 [info level 0]
 }
 
 # Glas leeren
 proc drink_drink {} {
 	global filled
 	.c itemconfigure drink -fill grey
 	.c coords drink 135 500 175 500
 	set filled 0
 	update idletasks
 }
 
 # Geld
 # 10 cent
 proc creat_10c {tag} {
 	.c create oval 330 20 360 50 -fill gold -tags $tag
 	.c create text 345 35 -text 10 -font 10cent -fill DarkOrange -tags $tag
 }
 # 20 cent
 proc creat_20c {tag} {
 	.c create oval 327 60 363 96 -fill gold -tags $tag
 	.c create text 345 78 -text 20 -font 20cent -fill DarkOrange -tags $tag
 }
 # 50 cent
 proc creat_50c {tag} {
 	.c create oval 324 106 366 148 -fill gold -tags $tag
 	.c create text 345 127 -text 50 -font 50cent -fill DarkOrange -tags $tag
 }
 # 1 euro
 proc creat_1e {tag} {
 	.c create oval 321 158 369 206 -fill gold -tags $tag
 	.c create oval 328 165 362 199 -fill gray90 -tags $tag
 	.c create text 345 182 -text 1 -font euro -fill gray70 -tags $tag
 }
 # 2 euro
 proc creat_2e {tag} {
 	.c create oval 318 216 372 270 -fill gray90 -tags $tag
 	.c create oval 326 224 364 262 -fill gold -tags $tag
 	.c create text 345 243 -text 2 -font euro -fill DarkOrange -tags $tag
 }
 
 proc take_coin {tag x y} {
 	global coinx coiny
 	set coinx $x
 	set coiny $y
 	creat_$tag coin
 	.c raise coin
 	.c bind $tag <B1-Motion> {drag_coin %x %y}
 	.c bind $tag <ButtonRelease-1> "drop_coin $tag %x %y"
 }
 
 proc drag_coin {x y} {
 	global coinx coiny
 	.c move coin [expr {$x - $coinx}] [expr {$y - $coiny}]
 	set coinx $x
 	set coiny $y
 }
 
 proc drop_coin {tag x y} {
 	global guthaben wert
 	.c delete coin
 	if {[lsearch -exact [.c find withtag einwurf] [.c find closest $x $y 15]] != -1} {
 		# Einwurf
 		set guthaben [expr {$guthaben + $wert($tag)}]
 	}
 }
 
 proc upd_preis {args} {
 	global preis
 	.c itemconfigure preis -text [format "%.2f" $preis]
 }
 
 proc upd_guthaben {args} {
 	global guthaben preis auswahl
 	set auswahl $auswahl
 	.c itemconfigure guthaben -text [format "%.2f" $guthaben]
 }
 
 proc choose {args} {
 	global guthaben preise preis auswahl filled
 	if {$filled} return
 	set preis $preise($auswahl)
 	if {[string length $auswahl] && ($guthaben + 0.001 >= $preis)} {
 		set guthaben [expr {$guthaben > $preis ? ($guthaben - $preis) : 0}]
 		fill_glass $auswahl
 		set auswahl ""
 	}
 }
 
 proc is_filled {args} {
 	global preis
 	set preis 0
 }
 
 #
 # GUI
 #
 
 wm withdraw .
 wm geometry . 400x600
 wm resizable . 0 0
 
 pack [canvas .c -width 400 -height 600]
 
 # Fonts
 font create mini -size 8 -weight bold
 font create deco -size 46 -weight bold -family "Brush Script"
 font create 10cent -size 11 -weight bold -family "Engravers MT"
 font create 20cent -size 14 -weight bold -family "Engravers MT"
 font create 50cent -size 18 -weight bold -family "Engravers MT"
 font create euro -size 22 -weight bold -family "Engravers MT"
 
 # Auswahlkn�pfe
 button .c.k -text Kaffee -bg SandyBrown -width 9 -font mini -command {set auswahl kaffee}
 button .c.c -text Capuccino -bg SandyBrown -width 9 -font mini -command {set auswahl capuccino}
 button .c.t -text Tee -bg SandyBrown -width 9 -font mini -command {set auswahl tee}
 button .c.b -text Br�he -bg SandyBrown -width 9 -font mini -command {set auswahl bruehe}
 
 # Automat
 .c create rectangle 20 20 290 580 -fill red -outline black
 .c create rectangle 20 580 30 600 -fill black
 .c create rectangle 280 580 290 600 -fill black
 # Display
 .c create text 40 52 -text Preis: -font mini -anchor nw
 .c create text 40 77 -text Guthaben: -font mini -anchor nw
 .c create rectangle 100 48 150 67 -fill black
 .c create rectangle 100 72 150 91 -fill black
 .c create text 142 52 -text 0.00 -font mini -fill green -anchor ne -tags preis
 .c create text 142 77 -text 0.00 -font mini -fill green -anchor ne -tags guthaben
 # Geldeinwurf
 .c create oval 250 45 263 95 -fill darkred -width 0 -tags einwurf
 .c create rectangle 255 50 258 90 -fill black -tags einwurf
 # Ausgabe
 .c create rectangle 120 410 190 500 -fill black -tags ausgabe
 .c bind ausgabe <1> drink_drink
 # Glas
 .c create rectangle 135 440 175 500 -fill grey -tags ausgabe
 .c create rectangle 135 500 175 500 -fill grey -width 0 -tags {drink ausgabe}
 .c create polygon 135 438 142 501 135 501 -fill black -width 0 -tags ausgabe
 .c create polygon 176 438 168 501 175 501 -fill black -width 0 -tags ausgabe
 # Getr�nkewahl
 .c create window 200 140 -window .c.k -anchor nw
 .c create window 200 170 -window .c.c -anchor nw
 .c create window 200 200 -window .c.t -anchor nw
 .c create window 200 230 -window .c.b -anchor nw
 # Deco
 .c create text 40 190 -text Hei�e -fill wheat -font deco -anchor nw
 .c create text 40 260 -text Getr�nke -fill wheat -font deco -anchor nw
 # Geld
 creat_10c 10c
 .c bind 10c <ButtonPress-1> {take_coin 10c %x %y}
 creat_20c 20c
 .c bind 20c <ButtonPress-1> {take_coin 20c %x %y}
 creat_50c 50c
 .c bind 50c <ButtonPress-1> {take_coin 50c %x %y}
 creat_1e 1e
 .c bind 1e <ButtonPress-1> {take_coin 1e %x %y}
 creat_2e 2e
 .c bind 2e <ButtonPress-1> {take_coin 2e %x %y}
 # Preis
 trace variable preis w upd_preis
 trace variable guthaben w upd_guthaben
 trace variable auswahl w choose
 trace variable filled w is_filled
 
 
 after idle wm deiconify .