Version 0 of 99 bottles of beer

Updated 1999-07-21 18:55:07

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.ionet.net/~timtroyr/funhouse/beer.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 ;-) -- Richard Suchenwirth