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 ;-)
Vince FWIW on my Win2000 machine the large 'Heisse Getranke' is a bit too wide it overlaps by a good 10 pixels onto the grey area to the right (and heisse under the buttons). Otherwise this is great!
#! /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 .