Richard Suchenwirth 1999-07-21 - I much too late discovered the "99 bottles of beer" game, where the text of the admittedly silly song
99 bottles of beer on the wall, 99 bottles of beer.
Take one down, pass it around,
98 bottles of beer.
... (downto 0)has to be produced by a program. Tim Robinson ([email protected]) exhibits a collection of presently 227 programming languages (some with >1 example) in http://www.westnet.com/mirrors/99bottles/beer.html
(This person's pages at www.ionet.net appear to have completely disappeared. Anyone know anything?)RS: Yes - just found http://internet.ls-la.net/mirrors/99bottles/
HJG They moved to http://www.99-bottles-of-beer.net and http://www.99-bottles-of-beer.net/language-tcl-439.html
Tcl is represented there with a program by Don Libes http://www.ionet.net/~timtroyr/funhouse/beer/beer_s_z.html#tcl , also see Expect and Itcl, but there's more than one way to do it, as they say. In a joyful discussion in news:comp.lang.tcl , the following code was jointly developed:
proc en:num {n {optional 0}} {
#---------------- English spelling for integer numbers
if {[catch {set n [expr $n]}]} {return $n}
if {$optional && $n==0} {return ""}
array set dic {
0 zero 1 one 2 two 3 three 4 four 5 five 6 six 7 seven
8 eight 9 nine 10 ten 11 eleven 12 twelve
}
if [info exists dic($n)] {return $dic($n)}
foreach {value word} {1000000 million 1000 thousand 100 hundred} {
if {$n>=$value} {
return "[en:num $n/$value] $word [en:num $n%$value 1]"
}
} ;#--------------- composing between 13 and 99...
if $n>=20 {
set res $dic([expr $n/10])ty
if $n%10 {append res -$dic([expr $n%10])}
} else {
set res $dic([expr $n-10])teen
} ;#----------- fix over-regular compositions
regsub "twoty" $res "twenty" res
regsub "threet" $res "thirt" res
regsub "fourty" $res "forty" res
regsub "fivet" $res "fift" res
regsub "eightt" $res "eight" res
return $res
}
proc s {n {w 0}} {
concat [expr $n?"[en:num $n]":"no more"]\
bottle[expr $n!=1?"s":""] of beer\
[expr $w?" on the wall":{}]
}
proc string:title s {
return [string toupper [string index $s 0]][string range $s 1 end]
} ;#--- can be done with [string totitle since 8.1.1 ---
proc bob {n} {if $n {subst "
[string:title [s $n 1]], [s $n].
Take [expr $n>1?{one}:{it}] down, pass it around,
[s [incr n -1] 1].\n[bob $n]"} else {subst "
Go to the store, buy some more,
[s 99 1]."}}
puts [bob 99]If not for the fun, this seems to be a good playground on which to compare languages, and exercise a language to its limits ;-)
Peter Lewerin would do it this way... no, wait, this way -- no, actually I'd do it this way, I think:
set bottle(s) bottles
set n 99
proc take args {
puts [concat take $args]
}
proc (n) {b args} {
global n bottle
puts [concat $n [set ::$b] $args]
}
proc (n-1) {b args} {
global n bottle
incr n -1
set bottle(s) bottle[expr {$n==1?"":"s"}]
if {$n == 0} {
set n "no more"
}
puts [concat $n [set ::$b] $args]\n
}
while {$n ne "no more"} {
(n) bottle(s) of beer on the wall
(n) bottle(s) of beer
take one down, pass it around
(n-1) bottle(s) of beer on the wall
}Similar, but a fall-through:
set text "\$N bottle(s) of beer on the wall take one down, pass it around,"
set N 100
set n [ list 0 6 , 0 3 . 7 end ]
while { $N } {
set sing [ subst $text ]
foreach [ list i j k ] $n {
puts [ lrange $sing $i $j ]$k
}
incr N -1
set sing [ subst $text ]
puts "[ lrange $sing 0 6 ].\n"
}
puts "No more bottles of beer on the wall ;^("NOTE: The above is NOT good. It is bottles for everything over 1 and bottle for the last one.
glennj a very compact version using variable write traces:
proc setBottles {varName args} {
upvar #0 $varName n
set ::bottles [format "%d bottle%s" $n [expr {$n == 1 ? "" : "s"}]]
}
trace add variable i write setBottles
for {set i 99} {$i > 0} {} {
puts "$bottles of beer on the wall"
puts "$bottles of beer"
puts "take one down, pass it around"
incr i -1
puts "$bottles of beer on the wall\n"
}See also http://www.rosettacode.org/wiki/99_Bottles_of_Beer
Here's a mug of cyberbeer in Tk:
pack [canvas .c]
.c create rectangle 10 20 70 100 -fill gray95
.c create arc 50 30 90 75 -start 90 -extent -180 \
-style arc -width 10 -outline gray95
.c create oval 15 10 65 30 -fill white -outline white
.c create rectangle 15 20 65 85 -fill yellow
.c create text 40 50 -text CYBER -fill red Enjoy! -- Didn't PSE once write: Tcl... the beer of languages... goes well with a BLT...
For a poem on other drinks, see Super and Subscripts in a text widget
tcl is dynamic!
pack [canvas .c]
.c create rectangle 10 20 70 100 -fill gray95
.c create arc 50 30 90 75 -start 90 -extent -180 \
-style arc -width 10 -outline gray95
.c create oval 15 10 65 30 -fill white -outline white -tags {foam content}
.c create rectangle 15 20 65 85 -fill {} -tags {front}
.c create rectangle 15 20 65 85 -fill yellow -tags {beer content}
.c create text 40 50 -text CYBER -fill red -tags {front}
proc drink {} {
after 1000 drink
.c scale content 40 85 1.0 0.9
.c raise foam
.c raise front
}
drink ;# prost, UK