99 Bottles of Beer/Basic: Difference between revisions
Line 431: | Line 431: | ||
while BeerSong.Sing() <> 99 |
while BeerSong.Sing() <> 99 |
||
end while |
end while |
||
</lang> |
|||
=={{header|FreeBASIC}}== |
|||
<lang freebasic> |
|||
' FB 1.05.0 Win64 |
|||
Dim As Integer bottles = 19 |
|||
Dim As String b = " bottles " |
|||
Do |
|||
Print Str(bottles); b; "of beer hanging on the wall" |
|||
Print Str(bottles); b; "of beer hanging on the wall" |
|||
Print "And if one bottle of beer should accidently be drunk" |
|||
bottles -= 1 |
|||
If bottles = 1 Then |
|||
b = " bottle " |
|||
ElseIf bottles = 0 Then |
|||
b = " bottles " |
|||
End If |
|||
Print "There'll be"; bottles; b; "of beer hanging on the wall" |
|||
Print |
|||
Loop Until bottles = 0 |
|||
Print "Press any key to sleep it off" |
|||
Sleep |
|||
</lang> |
</lang> |
||
Revision as of 15:59, 30 September 2016
99 Bottles of Beer done in any of the BASIC-languages.
BASIC
QuickBASIC
Sound
This version plays the tune 100 times while printing out the lyrics (not synchronized). <lang qbasic>PLAY "<" FOR x = 99 TO 0 STEP -1
PRINT x; "bottles of beer on the wall" PRINT x; "bottles of beer" PRINT "Take one down, pass it around" PRINT x-1; "bottles of beer on the wall" PRINT PLAY "e-8e-8e-8<b-8b-8b-8>e-8e-8e-8e-4"'X bottles of beer on the wall PLAY "f8f8f8c8c8c8f4"'X bottles of beer PLAY "d4d8d8 N0 d8d8d8d4"'take one down, pass it around PLAY "<a+8a+8a+8>c8c8d8d+8d+8d+8d+4"'X-1 bottles of beer on the wall
NEXT x</lang>
Text
<lang qbasic>FOR x = 99 TO 1 STEP -1
PRINT x; "bottles of beer on the wall" PRINT x; "bottles of beer" PRINT "Take one down, pass it around" PRINT x-1; "bottles of beer on the wall" PRINT
NEXT x</lang>
Applesoft BASIC
<lang Applesoft BASIC>H$ = "HELLO, WORLD!":B$ = " BOTTLES OF BEER":N$ = CHR$ (13):W$ = " ON THE WALL" + N$: FOR B = 99 TO 1 STEP - 1: PRINT B;B$W$B" "B$N$"TAKE ONE DOWN, PASS IT AROUND"N$B - 1;B$W$: NEXT </lang>
BASIC256
<lang BASIC256>#length of querter and eight note in ms n4 = 1000 * 60 / 80 / 4 n8 = n4 / 2
- frequency of musical notes in hz
e = 330 ef = 311 b = 247 bf = 233 f = 349 c = 262 d = 294 ds = 311 a = 220
dim notes(1) dim lengs(1)
- redim is automatic when using a {} list to assign an array
notes = {ef, ef, ef, bf, bf, bf, ef, ef, ef, ef, f , f , f , c , c , c , f , d , d , d , d , d , d , d , bf, bf, bf, c , c , ef, ef, ef, ef, ef} lengs = {n8, n8, n8, n8, n8, n8, n8, n8, n8, n4, n8, n8, n8, n8, n8, n8, n4, n4, n8, n8, n8, n8, n8, n4, n8, n8, n8, n8, n8, n8, n8, n8, n8, n4 }
for x = 99 to 1 step -1
for t = 0 to notes[?]-1 if t = 0 then print x + " bottles of beer on the wall" if t = 11 then print x + " bottles of beer" if t = 18 then print "Take one down, pass it around" if t = 25 then print(x-1) + " bottles of beer on the wall" sound notes[t], lengs[t] pause .002 next t print
next x </lang>
BBC BASIC
<lang bbcbasic>
N_Bottles = 99 beer$ = " of beer" wall$ = " on the wall" unit$ = "99 bottles" WHILE N_Bottles >= 0 IF N_Bottles=0 THEN PRINT '"No more bottles" beer$ wall$ ", " unit$ beer$ "." PRINT "Go to the store and buy some more, "; ELSE PRINT 'unit$ beer$ wall$ ", " unit$ beer$ "." PRINT "Take one down and pass it around, "; ENDIF N_Bottles -= 1 CASE N_Bottles OF WHEN 0: unit$ = "no more bottles" WHEN 1: unit$ = "1 bottle" OTHERWISE: unit$ = STR$((N_Bottles + 100) MOD 100) + " bottles" ENDCASE PRINT unit$ beer$ wall$ "." ENDWHILE END
</lang>
Creative Basic
window version
<lang Creative Basic>DEF Win:WINDOW DEF Close:CHAR DEF ScreenSizeX,ScreenSizeY:INT
DECLARE VSpace(Number:UINT) DECLARE CLR()
DEF TheLine$[4],Number$,Erase:STRING DEF TheLine,TextHeight,TextWidth:INT DEF TextX,TextY:UINT
TheLine$[0]="bottles" TheLine$[1]="of beer on the wall." TheLine$[2]="of beer." TheLine$[3]="Take one down, pass it around."
BottlesOfBeer=99 TheLine=1
GETSCREENSIZE(ScreenSizeX,ScreenSizeY)
WINDOW Win,0,0,ScreenSizeX,ScreenSizeY,@MINBOX|@MAXBOX|@SIZE,0,"99 Bottles Of Beer",MainHandler
GETTEXTSIZE(Win,TheLine$[3],TextWidth,TextHeight)
Erase$=STRING$(TextWidth," ")
PRINT Win,"Let's sing a song."
VSpace(2)
'1.2 seconds. STARTTIMER Win,1200
GOSUB Sing
WAITUNTIL Close=1
CLOSEWINDOW Win
END
SUB MainHandler
SELECT @CLASS
CASE @IDCLOSEWINDOW
Close=1
CASE @IDTIMER
GOSUB Sing
ENDSELECT
RETURN
SUB Sing
DEF Sing:INT
Sing=TheLine
MOVE Win,TextX,TextY
Number$=STR$(BottlesOfBeer)
IF BottlesOfBeer=0
Number$="No more"
TheLine$[0]="bottles" TheLine$[3]="Go to the store and buy some more."
ENDIF
IF BottlesOfBeer=1
TheLine$[0]="bottle" TheLine$[3]="Take it down, pass it around."
ENDIF
IF TheLine=4 THEN Sing=1
IF (TheLine=1)|(TheLine=2)|(TheLine=4)
IF BottlesOfBeer>-1 THEN PRINT Win,Number$+" "+TheLine$[0]+" "+TheLine$[Sing] ELSE GOSUB TheEnd
ELSE
PRINT Win,TheLine$[3]
BottlesOfBeer=BottlesOfBeer-1
ENDIF
TheLine=TheLine+1
VSpace(1)
IF TheLine>4
TheLine=1
VSpace(1)
ENDIF
RETURN
SUB TheEnd
PRINT Win,"What's the problem, offishur?"
STOPTIMER Win
VSpace(2)
MOVE Win,TextX,TextY:PRINT Win,"That's all."
RETURN
SUB VSpace(Number:UINT)
TextY=TextY+(TextHeight*Number)
IF TextY+(TextHeight*8)>ScreenSizeY THEN CLR()
RETURN
SUB CLR()
FOR X=0 TO ScreenSizeY
MOVE Win,0,X:PRINT Win,Erase$
TextY=8
NEXT X
RETURN </lang>
console only version
Rather quickly written and dirty. <lang Creative Basic>REM Using the ESC key to exit will not work in console programs under Windows 95/98 or ME.
DECLARE SingWallLn() DECLARE Delay1() DECLARE Delay2() 'To use ESC Key to exit. DECLARE Quit() DECLARE TheEnd()
DEF Bottles:UINT DEF Number$,Again$:STRING
OPENCONSOLE
PRINT"I'm going to sing a song.":PRINT
Delay1()
LABEL StartSong
Bottles=99
DO
Quit()
SingWallLn():Delay1()
PRINT LTRIM$(STR$(Bottles))+Number$+" of beer.":Delay1()
IF Bottles>0 THEN PRINT"Take one down, pass it around." ELSE PRINT"Take it down, pass it around.":Delay1()
Bottles=Bottles-1
SingWallLn()
Delay2()
PRINT:PRINT
UNTIL Bottles=0
Delay2()
ClS
LABEL Question
INPUT"Sing it again (y or n)?",Again$
SELECT Again$
CASE("y") CASE("Y")
CLS
GOTO StartSong
CASE "n" CASE "N"
CLS
PRINT"Fine, be that way.":Delay2()
TheEnd()
ENDSELECT
PRINT"Sorry, I didn't understand.":PRINT
GOTO Question
'Keep from running into subroutines. END
SUB SingWallLn()
IF Bottles=1 THEN Number$=" bottle" ELSE Number$=" bottles"
PRINT LTRIM$(STR$(Bottles))+Number$+" of beer on the wall."
RETURN
SUB Delay1()
FOR X=1 TO 7000:NEXT X
RETURN
SUB Delay2()
FOR X=1 TO 1750000:NEXT X
RETURN
SUB Quit()
'Close program by pressing the ESC key. 'Will not work in console under Windows 95/98 or ME. IF GETKEYSTATE(0x1B) THEN TheEnd()
RETURN
SUB TheEnd()
CLOSECONSOLE
END
RETURN </lang>
FBSL
This is a OO version, using FBSL v3.5 Beta <lang qbasic>#AppType Console
Class Wall bottles
Sub Initialize(%n = 99) bottles = n End Sub
Method Denom() if bottles+1 > 1 then return "one" elseif bottles+1 = 1 then return "it" end if End Method
Method StockUp( %n = 99 ) bottles = n End Method
Method TakeOneDown() bottles = bottles - 1 end Method
Method Pluraliser() if bottles > 1 then return "s" else return "" end if end method
Method Sing() print bottles, " bottle", Pluraliser(), " of beer on the wall" print bottles, " bottle", Pluraliser(), " of beer" TakeOneDown() print "take ", Denom(), " down and pass it round" if bottles > 0 then print bottles, " bottle", Pluraliser(), " of beer on the wall" print else print "no more bottles of beer on the wall" print print "no more bottles of beer on the wall" print "no more bottles of beer on the wall" print "go to the store and buy some more" StockUp(99) print bottles, " bottle", Pluraliser(), " of beer on the wall" print end if return bottles End Method
End Class
Dim BeerSong as new Wall(99)
while BeerSong.Sing() <> 99 end while </lang>
FreeBASIC
<lang freebasic> ' FB 1.05.0 Win64
Dim As Integer bottles = 19 Dim As String b = " bottles "
Do
Print Str(bottles); b; "of beer hanging on the wall" Print Str(bottles); b; "of beer hanging on the wall" Print "And if one bottle of beer should accidently be drunk" bottles -= 1 If bottles = 1 Then b = " bottle " ElseIf bottles = 0 Then b = " bottles " End If Print "There'll be"; bottles; b; "of beer hanging on the wall" Print
Loop Until bottles = 0
Print "Press any key to sleep it off" Sleep </lang>
FUZE BASIC
-- Scott A. Rossell, 02-27-16 <lang qbasic>CLS DIM s$(1) READ b,s$(0),s$(1),a$,b$,c$,d$,e$,f$ g$ = chr$(10) WHILE b > 0 CYCLE
PRINT b;a$;s$(b>1);b$;c$;b;a$;s$(b>1);b$;".";g$;d$;b-1;a$;s$(b-1<>1);b$;c$;g$ b = b - 1
REPEAT PRINT e$;a$;"s";b$;c$;e$;a$;"s";b$;".";g$;f$;a$;"s";b$;c$ DATA 5,"","s"," bottle"," of beer"," on the wall. ","Take one down, pass it around. " DATA "No more","Go to the store and buy some more. 99" END</lang>
Integer BASIC
IMPORTANT NOTE: Integer BASIC was written (and hand-assembled by Woz himself) for the Apple 1 and original Apple 2. The Apple 1 has NO support for lower-case letters, and it was an expensive (and later) option on the Apple 2. The UPPER-CASE output of this example accurately represents the only reasonable solution for those target devices, and therefore cannot be "fixed" for mixed case, only deleted.
<lang Integer BASIC>E000G (APPLE II) E000R (APPLE I) 10 REM ------------------------- 11 REM BEERSONG IN APPLE INTEGER 12 REM BASIC BY BARRYM 2011-8-21 13 REM THANKS : APPLEWIN1.17.2.0 14 REM THANKS ALSO : POM1 0.7B 15 REM ------------------------- 16 REM PRINTS THE COMPLETE UPPER 17 REM CASE LYRICS ON AN APPLE I 18 REM OR AN 'ORIGINAL' APPLE II 19 REM WITH WOZ'S INTEGER BASIC. 20 REM ------------------------- 21 REM THIS BASIC HAS AN UNUSUAL 22 REM 'THEN', WHICH EXECUTES OR 23 REM SKIPS ONE (AND ONLY ONE!) 24 REM STATEMENT. THIS CONFUSED 25 REM US KIDS REGULARLY WHEN WE 26 REM TRIED TRANSLATING INTEGER 27 REM BASIC GAMES TO APPLE$OFT! 30 REM ------------------------- 40 FOR B=99 TO 98 STEP 0: PRINT : FOR W=0 TO 2: IF W<2 THEN 70 50 IF B THEN PRINT "TAKE ONE DOWN AND PASS IT AROUND";:B=B-1 60 IF B+1 THEN 70:B=99: PRINT "GO TO THE STORE AND BUY SOME MORE"; 70 IF W THEN PRINT ",": IF B THEN PRINT B;: IF B=0 THEN PRINT "NO MORE"; 80 PRINT " BOTTLE";: IF B#1 THEN PRINT "S";: PRINT " OF BEER"; 90 IF W#1 THEN PRINT " ON THE WALL";: IF W THEN PRINT ".": NEXT W,B: END RUN</lang>
Liberty BASIC
<lang lb>For bottles = 99 To 1 Step -1
song$ = song$ + str$(bottles) + " bottle" If (bottles > 1) Then song$ = song$ + "s" song$ = song$ + " of beer on the wall, " + str$(bottles) + " bottle" If (bottles > 1) Then song$ = song$ + "s" song$ = song$ + " of beer," + chr$(13) + chr$(10) + "Take one down, pass it around, " + str$(bottles - 1) + " bottle" If (bottles > 2) Or (bottles = 1) Then song$ = song$ + "s" song$ = song$ + " of beer on the wall." + chr$(13) + chr$(10)
Next bottles song$ = song$ + "No more bottles of beer on the wall, no more bottles of beer." _
+ chr$(13) + chr$(10) + "Go to the store and buy some more, 99 bottles of beer on the wall."
Print song$</lang>
OxygenBasic
<lang qbasic> int x=99 string cr,tab,pr,bottles,bottlem,remain cr=chr(13) chr(10) tab=chr(9) pr="99 BOTTLES" cr cr bottles=" bottles " bottlem=" bottles " ' for x=99 to 1 step -1
if x=1 bottles=" bottle " bottlem=" bottles " remain="No" elseif x=2 bottlem=" bottle " remain=x-1 else remain=x-1 end if pr+= x bottles "of beer on the wall" cr + x bottles "of beer" cr + "Take one down, pass it around" cr + remain bottlem "of beer on the wall" cr + cr
next ' putfile "t.txt",pr </lang>
PureBasic
Normal version
<lang PureBasic>If OpenConsole()
Define Bottles=99 While Bottles PrintN(Str(Bottles)+" bottles of beer on the wall") PrintN(Str(Bottles)+" bottles of beer") PrintN("Take one down, pass it around") Bottles-1 PrintN(Str(Bottles)+" bottles of beer on the wall"+#CRLF$) Wend PrintN(#CRLF$+#CRLF$+"Press ENTER to exit"):Input() CloseConsole()
EndIf</lang>
An object-oriented solution
<lang PureBasic>Prototype Wall_Action(*Self, Number.i)
Structure WallClass
Inventory.i AddBottle.Wall_Action DrinkAndSing.Wall_Action
EndStructure
Procedure.s _B(n, Short=#False)
Select n Case 0 : result$="No more bottles " Case 1 : result$=Str(n)+" bottle of beer" Default: result$=Str(n)+" bottles of beer" EndSelect If Not Short: result$+" on the wall": EndIf ProcedureReturn result$+#CRLF$
EndProcedure
Procedure PrintBottles(*Self.WallClass, n)
Bottles$=" bottles of beer " Bottle$ =" bottle of beer " txt$ = _B(*Self\Inventory) txt$ + _B(*Self\Inventory, #True) txt$ + "Take one down, pass it around"+#CRLF$ *Self\AddBottle(*Self, -1) txt$ + _B(*self\Inventory) PrintN(txt$) ProcedureReturn *Self\Inventory
EndProcedure
Procedure AddBottle(*Self.WallClass, n)
i=*Self\Inventory+n If i>=0 *Self\Inventory=i EndIf
EndProcedure
Procedure InitClass()
*class.WallClass=AllocateMemory(SizeOf(WallClass)) If *class InitializeStructure(*class, WallClass) With *class \AddBottle =@AddBottle() \DrinkAndSing =@PrintBottles() EndWith EndIf ProcedureReturn *class
EndProcedure
If OpenConsole()
*MyWall.WallClass=InitClass() If *MyWall *MyWall\AddBottle(*MyWall, 99) While *MyWall\DrinkAndSing(*MyWall, #True): Wend ; PrintN(#CRLF$+#CRLF$+"Press ENTER to exit"):Input() CloseConsole() EndIf
EndIf</lang>
REALbasic
Place the following in the "open" event of a console application. <lang vb>dim bottles as Integer = 99 While bottles > 0
Print(str(bottles) + " bottles of beer on the wall") Print(str(bottles) + " bottles of beer") Print("Take one down, pass it around") bottles = bottles - 1 Print(str(bottles) + " bottles of beer on the wall")
Wend</lang>
Run BASIC
<lang Runbasic>b$ = " bottles" for bottles = 99 To 1 Step -1
If (bottles = 1) then b$ = " bottle" print bottles;b$;" of beer on the wall, " print bottles ;b$;" of beer" print "Take one down, pass it around, " if bottles = 1 then print "No bottles of beer on the wall" else print bottles - 1;b$;" of beer on the wall.";chr$(10) end if
next bottles</lang>
TI-83 BASIC
<lang ti83b>PROGRAM:BEER
- For(I,99,1,-1)
- Disp I
- Disp "BOTTLES OF BEER"
- Disp "ON THE WALL,"
- Disp I
- Pause "BOTTLES OF BEER,"
- Disp "TAKE ONE DOWN,"
- Disp "PASS IT AROUND,"
- Disp I-1
- Disp "BOTTLES OF BEER"
- Disp "ON THE WALL."
- End
</lang>
TI-89 BASIC
<lang ti89b>Prgm
Local i,plural,clockWas,t,k,wait "s" → plural 0 → k isClkOn() → clockWas
Define wait() = Prgm EndPrgm
ClockOn
For i,99,0,–1 Disp "" Disp string(i) & " bottle" & plural & " of beer on the" Disp "wall, " & string(i) & " bottle" & plural & " of beer."
getTime()[3]→t While getTime()[3] = t and k = 0 : getKey() → k : EndWhile If k ≠ 0 Then : Exit : EndIf
Disp "Take one down, pass it" Disp "around."
getTime()[3]→t While getTime()[3] = t and k = 0 : getKey() → k : EndWhile If k ≠ 0 Then : Exit : EndIf
If i - 1 = 1 Then "" → plural EndIf If i > 1 Then Disp string(i-1) & " bottle" & plural & " of beer on the" Disp "wall." Else Disp "No more bottles of beer on" Disp "the wall." EndIf
getTime()[3]→t While abs(getTime()[3] - t)<2 and k = 0 : getKey() → k : EndWhile If k ≠ 0 Then : Exit : EndIf
EndFor If not clockWas Then ClockOff ENdIf
EndPrgm</lang>
Visual Basic
<lang vb>Sub Main()
Const bottlesofbeer As String = " bottles of beer" Const onthewall As String = " on the wall" Const takeonedown As String = "Take one down, pass it around" Const onebeer As String = "1 bottle of beer"
Dim bottles As Long
For bottles = 99 To 3 Step -1 Debug.Print CStr(bottles) & bottlesofbeer & onthewall Debug.Print CStr(bottles) & bottlesofbeer Debug.Print takeonedown Debug.Print CStr(bottles - 1) & bottlesofbeer & onthewall Debug.Print Next
Debug.Print "2" & bottlesofbeer & onthewall Debug.Print "2" & bottlesofbeer Debug.Print takeonedown Debug.Print onebeer & onthewall Debug.Print
Debug.Print onebeer & onthewall Debug.Print onebeer Debug.Print takeonedown Debug.Print "No more" & bottlesofbeer & onthewall Debug.Print
Debug.Print "No" & bottlesofbeer & onthewall Debug.Print "No" & bottlesofbeer Debug.Print "Go to the store, buy some more" Debug.Print "99" & bottlesofbeer & onthewall
End Sub</lang>
Visual Basic .NET
Platform: .NET <lang vbnet>Module Module1
Sub Main() Dim Bottles As Integer For Bottles = 99 To 0 Step -1 If Bottles = 0 Then Console.WriteLine("No more bottles of beer on the wall, no more bottles of beer.") Console.WriteLine("Go to the store and buy some more, 99 bottles of beer on the wall.") Console.ReadLine() ElseIf Bottles = 1 Then Console.WriteLine(Bottles & " bottle of beer on the wall, " & Bottles & " bottle of beer.") Console.WriteLine("Take one down and pass it around, no more bottles of beer on the wall.") Console.ReadLine() Else Console.WriteLine(Bottles & " bottles of beer on the wall, " & Bottles & " bottles of beer.") Console.WriteLine("Take one down and pass it around, " & (Bottles - 1) & " bottles of beer on the wall.") Console.ReadLine() End If Next End Sub
End Module</lang>
ZX Spectrum Basic
<lang zxbasic>10 DEF FN n$(b)="no more" AND NOT b 20 DEF FN m$(b)=(STR$ b) AND b 30 DEF FN o$(b)="s" AND (b>1) 40 DEF FN b$(b)=FN m$(b)+FN n$(b) 50 DEF FN p$(b)=FN o$(b)+("s" AND NOT b) 60 FOR i=99 TO 0 STEP -1 70 LET x$=FN b$(i) 80 IF x$(1)="n" THEN LET x$(1)="N" 90 PRINT x$; 100 PRINT " bottle";FN o$(i);" of beer on the wall, "'FN b$(i);" bottle";FN p$(i);" of beer." 110 IF NOT i THEN GO TO 160 120 PRINT "Take one down"'"and pass it around, "; 130 PRINT FN b$(i-1);" bottle";FN p$(i-1);" of beer on the wall." 140 PRINT 150 NEXT i 160 PRINT "Go to the store and buy some more, 99 bottles of beer on the wall." </lang>
VBA
This version uses tail recursion and inline if-statements, plus a Static variable to count the number of bottles emptied.
<lang vb>Public Function countbottles(n As Integer, liquid As String) As String
countbottles = IIf(n > 1, Format$(n), IIf(n = 0, "no more", "one")) & " bottle" & IIf(n = 1, "", "s") & " of " & liquid
End Function
Public Sub drink(fullbottles As Integer, Optional liquid As String = "beer") Static emptybottles As Integer
Debug.Print countbottles(fullbottles, liquid) & " on the wall" Debug.Print countbottles(fullbottles, liquid)
If fullbottles > 0 Then Debug.Print "take " & IIf(fullbottles > 1, "one", "it") & " down, pass it around" Debug.Print countbottles(fullbottles - 1, liquid) & " on the wall" Debug.Print emptybottles = emptybottles + 1 drink fullbottles - 1, liquid Else Debug.Print "go to the store and buy some more" Debug.Print countbottles(emptybottles, liquid) & " on the wall" End If
End Sub</lang>
Usage: type "drink 99" in the Immediate window of the VBA editor. If you're not a beer drinker, you can specify your own favourite drink as the second argument; for example:
drink 3, "Johnnie Walker" 3 bottles of Johnnie Walker on the wall 3 bottles of Johnnie Walker take one down, pass it around 2 bottles of Johnnie Walker on the wall 2 bottles of Johnnie Walker on the wall 2 bottles of Johnnie Walker take one down, pass it around one bottle of Johnnie Walker on the wall one bottle of Johnnie Walker on the wall one bottle of Johnnie Walker take it down, pass it around no more bottles of Johnnie Walker on the wall no more bottles of Johnnie Walker on the wall no more bottles of Johnnie Walker go to the store and buy some more 3 bottles of Johnnie Walker on the wall
VBScript
Simple Method
<lang vb>sub song( numBottles ) dim i for i = numBottles to 0 step -1 if i > 0 then wscript.echo pluralBottles(i) & " of beer on the wall" wscript.echo pluralBottles(i) & " of beer" if i = 1 then wscript.echo "take it down" else wscript.echo "take one down" end if wscript.echo "and pass it round" wscript.echo pluralBottles(i-1) & " of beer on the wall" wscript.echo else wscript.echo "no more bottles of beer on the wall" wscript.echo "no more bottles of beer" wscript.echo "go to the store" wscript.echo "and buy some more" wscript.echo pluralBottles(numBottles) & " of beer on the wall" wscript.echo end if next end sub
function pluralBottles( n ) select case n case 1 pluralBottles = "one bottle" case 0 pluralBottles = "no more bottles" case else pluralBottles = n & " bottles" end select end function
song 3</lang>
- Output:
3 bottles of beer on the wall 3 bottles of beer take one down and pass it round 2 bottles of beer on the wall 2 bottles of beer on the wall 2 bottles of beer take one down and pass it round one bottle of beer on the wall one bottle of beer on the wall one bottle of beer take it down and pass it round no more bottles of beer on the wall no more bottles of beer on the wall no more bottles of beer go to the store and buy some more 3 bottles of beer on the wall
Regular Expressions and Embedded Scripting
Another way of doing it, using Regular Expressions to locate executable code inside {} and replacing the code with the result of its evaluation.
<lang vb>function pluralBottles( n ) select case n case 1 pluralBottles = "one bottle" case 0 pluralBottles = "no more bottles" case else pluralBottles = n & " bottles" end select end function
function eef( b, r1, r2 ) if b then eef = r1 else eef = r2 end if end function
Function evalEmbedded(sInput, sP1) dim oRe, oMatch, oMatches dim sExpr, sResult Set oRe = New RegExp 'Look for expressions as enclosed in braces oRe.Pattern = "{(.+?)}" sResult = sInput do Set oMatches = oRe.Execute(sResult) if oMatches.count = 0 then exit do for each oMatch in oMatches '~ wscript.echo oMatch.Value for j = 0 to omatch.submatches.count - 1 sExpr = omatch.submatches(j) sResult = Replace( sResult, "{" & sExpr & "}", eval(sExpr) ) next next loop evalEmbedded = sResult End Function
sub sing( numBottles ) dim i for i = numBottles to 0 step -1 if i = 0 then wscript.echo evalEmbedded("no more bottles of beer on the wall" & vbNewline & _ "no more bottles of beer" & vbNewline & _ "go to the store and buy some more" & vbNewline & _ "{pluralBottles(sP1)} of beer on the wall" & vbNewline, numBottles) else wscript.echo evalEmbedded("{pluralBottles(sP1)} of beer on the wall" & vbNewline & _ "{pluralBottles(sP1)} of beer" & vbNewline & _ "take {eef(sP1=1,""it"",""one"")} down and pass it round" & vbNewline & _ "{pluralBottles(sP1-1)} of beer on the wall" & vbNewline, i) end if next end sub
sing 3</lang>