99 Bottles of Beer/Tcl

99 Bottles of Beer/Tcl is part of 99 Bottles of Beer. You may find other members of 99 Bottles of Beer at Category:99 Bottles of Beer.

99-bottles-of-beer.net

from http://99-bottles-of-beer.net/language-tcl-439.html <lang tcl>proc bottles {i} {

   return "$i bottle[expr {$i!=1?{s}:{}}] of beer"

}

proc line123 {i} {

   puts "[bottles $i] on the wall,"
   puts "[bottles $i],"
   puts "take one down, pass it around,"

}

proc line4 {i} {

   puts "[bottles $i] on the wall.\n"

}

for {set i 99} {$i>0} {} {

   line123 $i
   incr i -1
   line4 $i

}</lang>

using variable traces

Here's a version that uses Tcl's variable traces to set a global "bottle string" whenever the counter variable is set. <lang tcl>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"

}</lang>

The Boozy Version

A [http://99-bottles-of-beer.net/language-expect-249.html particularly entertaining version] is Don Libes’s coding from the mid-'90s in Expect, which "... SIMULATES a human typing the beer song."

This is a version of that code, adapted to use modern coding styles, and not require any extensions.

Works with: Tcl version 8.4

<lang tcl># 99 bottles of beer on the wall, Expect-style

1. Author: Don Libes <libes@nist.gov>
   1. 1. Adapted by: Donal K. Fellows <donal.k.fellows@manchester.ac.uk>

1. Unlike programs (http://www.ionet.net/~timtroyr/funhouse/beer.html)
2. which merely print out the 99 verses, this one SIMULATES a human
3. typing the beer song. Like a real human, typing mistakes and timing
4. becomes more erratic with each beer - the final verse is barely
5. recognizable and it is really like watching a typist hunt and peck
6. while drunk.

1. Finally, no humans actually sing all 99 verses - particularly when
2. drunk. In reality, they occasionally lose their place (or just get
3. bored) and skip verses, so this program does likewise.

proc bottles {i} {

   return "$i bottle[expr {$i!=1?{s}:{}}] of beer"

} proc line123 {i} {

   out $i "[bottles $i] on the wall,\n"
   out $i "[bottles $i],\n"
   out $i "take one down, pass it around,\n"

} proc line4 {i} {

   out $i "[bottles $i] on the wall.\n\n"

} proc out {i s} {

   boozyType $i [beerifyString $i $s]

}

1. 1. 1. Factored the code to make drunken edits to the song

proc beerifyString {i s} {

   foreach ch [split $s ""] {

# don't touch punctuation; just looks too strange if you do if {[regexp {[,. \n]} $ch]} { append d $ch continue }

# keep first couple of verses straight if {$i > 97} { append d $ch continue }

# +3 prevents it from degenerating too far # /2 makes it degenerate faster though if {int(rand() * ($i/2 + 3)) > 0} { append d $ch continue }

# do something strange switch [expr {int(rand()*3)}] { 0 { # substitute another letter if {[regexp {[aeiou]} $ch]} { # if vowel, substitute another append d [string index "aeiou" \ [expr {int(5 * rand())}]] } elseif {[regexp {[0-9]} $ch]} { # if number, substitute another append d [string index "123456789" \ [expr {int(9 * rand())}]] } else { # if consonant, substitute another append d [string index "bcdfghjklmnpqrstvwxyz" \ [expr {int(21 * rand())}]] } } 1 { # duplicate a letter append d $ch$ch } 2 { # drop a letter } }

   }
   return $d

}

1. 1. 1. Mainly an implementation of Expect's "human" mode

proc boozyType {i s} {

   ### Black magic with a Weibull distribution...
   set alphaStd [expr {0.4 - ($i/333.0)}]
   set alphaEOW [expr {0.6 - ($i/333.0)}]
   set c        [expr {1/(log($i/2.0 + 1) + 0.1)}]
   set tMin     0.0
   set tMax     [expr {6.0 - $i/20.0}]

   set inWord true
   set first true
   foreach ch [split $s {}] {

### use the end-of-word alpha at eow transitions if {$inWord || [string is punct $ch] || [string is space $ch]} { set alpha $alphaEOW } else { set alpha $alphaStd } set inWord [expr {!([string is punct $ch] || [string is space $ch])}]

### Work out how long to sleep set t [expr {$alpha * pow(-log(rand()), $c)}] if {$t < $tMin} { set t $tMin } if {$t > $tMax} { set t $tMax }

### Do the sleep, skipping only if it is the first character if {$first} { set first false } else { after [expr {int($t * 1000)}] } puts -nonewline $ch

   }

} fconfigure stdout -buffering none

for {set i 99} {$i>0} {} {

   line123 $i
   incr i -1
   line4 $i

   # get bored and skip ahead
   if {$i == 92} {

set i [expr {52+int(5*rand())}]

   }
   if {$i == 51} {

set i [expr {12+int(5*rand())}]

   }
   if {$i == 10} {

set i [expr {6+int(3*rand())}]

   }

}</lang>