99 bottles of beer on the wall, 99 bottles of beer.
Take one down, pass it around,
98 bottles of beer.
... (downto 0)

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]

set bottle(s) bottles
set n 99

proc take args {
    puts [concat take $args]
}

proc (n) {b args} {
    puts [concat $::n [set ::$b] $args]
}

proc (n-1) {b args} {
    incr ::n -1
    set ::bottle(s) [expr {$::n != 1 ? "bottles" : "bottle"}]
    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
}

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 ;^("

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"
}

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 

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

proc B i {set x " bottle[expr $i>1?{s}:{}] of beer"}
set w " on the wall"
set i 99
while \$i>1 {puts "$i[B $i]$w, $i[B $i].\nTake one down and pass it around, [incr i -1][B $i]$w."}
puts "1[B $i]$w, 1[B $i].\nGo to the store and buy some more, 99[B 9]$w."