99 Bottles of Beer/Basic: Difference between revisions

Content added Content deleted

Inline

Revision as of 23:57, 1 June 2017

99 Bottles of Beer done in any of the BASIC-languages.

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

BaCon

With lyrics and punctuation taken from the 99-bottles-of-beer.net site. <lang freebasic>' 99 bottles of beer on the wall DECLARE counter$ DECLARE bottle$ DECLARE ofbeer$ = "of beer" DECLARE onthewall$ = "on the wall"

SUB howmany(b)

   LOCAL plural$
   plural$ = IIF$(b != 1, "s", "")
   bottle$ = "bottle" & plural$
   counter$ = IIF$(b >= 1, STR$(b), "no more")

END SUB

FOR bottles = 99 DOWNTO 0

   howmany(bottles)
   IF counter$ = "no more" THEN counter$ = "No more"
   PRINT counter$, bottle$, ofbeer$, onthewall$ FORMAT "%s %s %s %s, "
   IF counter$ = "No more" THEN counter$ = "no more"
   PRINT counter$, bottle$, ofbeer$ FORMAT "%s %s %s.\n"
   IF bottles > 0 THEN
       PRINT "Take one down and pass it around" FORMAT "%s, "
       howmany(bottles - 1)
   ELSE
       PRINT "Go to the store and buy some more" FORMAT "%s, "
       howmany(99)
   ENDIF
   PRINT counter$, bottle$, ofbeer$, onthewall$ FORMAT "%s %s %s %s.\n"
   IF bottles > 0 THEN PRINT

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

     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 = 99 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 99,"","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>

smart BASIC

-- Scott A. Rossell, 12-16-16 <lang qbasic>READ b,s$(0),s$(1),a$,b$,c$,d$,e$,f$ g$ = CHR$(10) WHILE b > 0

   IF b>1 THEN
       x=1
   ELSE
       x=0
   ENDIF
   IF b-1 <> 1 THEN
       y=1
   ELSE
       y=0
   ENDIF

PRINT b;a$;s$(x);b$;c$;b;a$;s$(x);b$;".";g$;d$;b-1;a$;s$(y);b$;c$;g$ b = b - 1 END WHILE PRINT e$;a$;"s";b$;c$;e$;a$;"s";b$;".";g$;f$;a$;"s";b$;c$ DATA 99,"","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>

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>

True BASIC

<lang basic> ! TrueBASIC v6.007

LET bottles = 99 LET b$ = " bottles "

DO PRINT bottles; b$; "of beer hanging on the wall" PRINT bottles; b$; "f beer hanging on the wall" PRINT "And if one bottle of beer should accidentally be drunk" LET bottles = bottles -1 IF bottles = 1 THEN LET b$ = " bottle " ELSEIF bottles = 0 THEN LET b$ = " bottles " ELSE ! Press on 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" GET KEY done END </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>

@@ Line 777: / Line 777: @@
 EndPrgm</lang>
-==={{header|True Basic}}===
+==={{header|True BASIC}}===
-<lang TrueBASIC>
+<lang basic>
 ! TrueBASIC v6.007

99 Bottles of Beer/Basic: Difference between revisions

Revision as of 23:57, 1 June 2017

BASIC

QuickBASIC

Sound

Text

Applesoft BASIC

BaCon

BASIC256

BBC BASIC

Creative Basic

window version

console only version

FBSL

FreeBASIC

FUZE BASIC

Integer BASIC

Liberty BASIC

OxygenBasic

PureBasic

Normal version

An object-oriented solution

REALbasic

Run BASIC

smart BASIC

TI-83 BASIC

TI-89 BASIC

True BASIC

Visual Basic

Visual Basic .NET

ZX Spectrum Basic

VBA

VBScript

Simple Method

Regular Expressions and Embedded Scripting