[Ulrich Schoebel]: A weekend fun and my son's java class competition project.
Have fun.
[WikiDbImage warmes.jpg]
----
[RS] explains: This page's title is German for "Man needs something warm", especially warm drinks.
The following script 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!
[US] This was developed on a WinME laptop, so I expected font and geometry problems on Linux/Unix machines. Why doesn't it render correct on Win2000? -
[RS]: Font scaling differs occasionally between platforms. One possibility would be to specify negative font size, i.e. in pixels.. also, "Brush Script" and "Engravers MT" are not available on all boxes, so others like Helvetica are substituted, which may again influence the layout. [US] Ok, sounds reasonable.
BTW, it's very simple to change the '''font create ...''' lines to supported fonts and fitting sizes.
----
[Jeff Smith] 2020-11-22 : Below is an online demo using [CloudTk]. This demo runs "Etwas Warmes braucht der Mensch" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Etwas-Warmes-braucht-der-Mensch.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
<<inlinehtml>>
<iframe height="630" width="410" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=Etwas-Warmes-braucht-der-Mensch" allowfullscreen></iframe>
<<inlinehtml>>
----
======
#! /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 [namespace code [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 340 20 370 50 -fill gold -tags $tag
.c create text 355 35 -text 10 -font 10cent -fill DarkOrange -tags $tag
}
# 20 cent
proc creat_20c {tag} {
.c create oval 337 60 373 96 -fill gold -tags $tag
.c create text 355 78 -text 20 -font 20cent -fill DarkOrange -tags $tag
}
# 50 cent
proc creat_50c {tag} {
.c create oval 334 106 376 148 -fill gold -tags $tag
.c create text 355 127 -text 50 -font 50cent -fill DarkOrange -tags $tag
}
# 1 euro
proc creat_1e {tag} {
.c create oval 331 158 379 206 -fill gold -tags $tag
.c create oval 338 165 372 199 -fill gray90 -tags $tag
.c create text 355 182 -text 1 -font euro -fill gray70 -tags $tag
}
# 2 euro
proc creat_2e {tag} {
.c create oval 328 216 382 270 -fill gray90 -tags $tag
.c create oval 336 224 374 262 -fill gold -tags $tag
.c create text 355 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
bell
}
#
# 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 320 580 -fill red -outline black
.c create rectangle 20 580 30 600 -fill black
.c create rectangle 310 580 320 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 230 140 -window .c.k -anchor nw
.c create window 230 170 -window .c.c -anchor nw
.c create window 230 200 -window .c.t -anchor nw
.c create window 230 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}
# Preistrace add variable preis write upd_preis
trace add variable guthaben write upd_guthaben
trace add variable auswahl write choose
trace add variable filled write is_filled
after idle wm deiconify .
======
----
[HJG] To give the deco-text more room, I made the box a bit wider, and moved the buttons and coins.
<<categories>> Toys