99 Bottles Of Beer
Ada
-- Ada version of 99 Bottles of Beer
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Bottles is
count : Integer := 99;
begin
while count > 0 loop
Put (count, Width=>0); Put_Line (" bottles of beer on the wall,");
Put (count, Width=>0); Put_Line (" bottles of beer.");
Put_Line ("Take one down and pass it around.");
count := count - 1;
if count = 0 then
Put_Line("No bottles of beer on the wall!");
else
Put (count, Width=>0); Put_Line (" bottles of beer on the wall.");
end if;
New_Line;
end loop;
end Bottles;
ALGOL
% Algol (60), Unisys MCP (descendant of Burroughs B6700) variant.
%
% January 21, 2003 by Tom Herbertson
% http://members.cox.net/herbertsont/
%
% Run with ;VALUE = <number> to specify initial quantity NEQ 99
% Run with ;SW1 for American ("happen to fall") version
% Run with ;SW2 to spell out numbers
% Send results to printer by running with ;FILE TERM(PRINTER)
% or to disk with ;FILE TERM(DISK,PROTECTION=SAVE,TITLE=<file name>)
% Enter ?HI to quit early
BEGIN
FILE TERM(KIND=REMOTE,MYUSE=OUT);
EBCDIC ARRAY OUTLINE[0:71];
TRANSLATETABLE LOWERTOUPPER
("abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
EBCDIC VALUE ARRAY
TENS
(" "," ",
"twenty ","thirty ","forty ","fifty ",
"sixty ","seventy ","eighty ","ninety "),
UNDER_TWENTY
("zero ","one ","two ","three ",
"four ","five ","six ","seven ",
"eight ","nine ","ten ","eleven ",
"twelve ","thirteen ","fourteen ","fifteen ",
"sixteen ","seventeen ","eighteen ","nineteen ");
PROCEDURE BOTTLECOUNT(I,P,SPELLING);
VALUE I, SPELLING;
INTEGER I; POINTER P; BOOLEAN SPELLING;
BEGIN
POINTER FIRST_LETTER;
INTEGER T, U;
IF I EQL 0 THEN
REPLACE P:P BY "No more"
ELSE
BEGIN
IF SPELLING AND I LEQ 99 THEN
BEGIN
T := I DIV 10;
U := I MOD 10;
FIRST_LETTER := P;
IF T GEQ 2 THEN
BEGIN
REPLACE P:P BY TENS [T*12] UNTIL = " "; % each entry is 12 chars
IF U NEQ 0 THEN
REPLACE P:P BY "-";
END
ELSE
IF T = 1 THEN
U:=*+10; % bring back the teens
IF U NEQ 0 THEN
REPLACE P:P BY UNDER_TWENTY [U*12] UNTIL = " "; % like TENS
REPLACE FIRST_LETTER BY FIRST_LETTER FOR 1 WITH LOWERTOUPPER;
END TURNING NUMBER INTO WORDS
ELSE
REPLACE P:P BY I FOR * DIGITS
END;
REPLACE P:P BY " bottles" FOR 7 + REAL(I NEQ 1), " ";
END;
DEFINE FORM = REPLACE OP:OP BY # ;
POINTER OP;
BOOLEAN REMOTE_OUTPUT, EARLYEXIT;
INTERRUPT HI;
BEGIN
EARLYEXIT := TRUE;
END;
PROCEDURE SPOUT;
BEGIN
WRITE(TERM,72,OUTLINE);
REPLACE (OP:=OUTLINE) BY " " FOR 72;
END;
BOOLEAN FALL, SPELL;
REAL TV;
INTEGER BOTTLES;
DEFINE MANTISSAF = [38:39] #, % Determines max single-precision integer
ALL1 = REAL (NOT FALSE) #,
MAXINT = ALL1.MANTISSAF #;
REPLACE (OP:=OUTLINE) BY " " FOR 72;
OPEN(TERM);
REMOTE_OUTPUT := (TERM.KIND EQL VALUE(REMOTE));
FALL := MYSELF.SW1;
SPELL := MYSELF.SW2;
IF (TV := MYSELF.TASKVALUE) GTR MAXINT THEN
BEGIN
FORM "Too many bottles, using ";
IF SPELL THEN
FORM "ninety-nine."
ELSE
FORM "99.";
SPOUT;
SPOUT; % blank line
BOTTLES := 99;
END
ELSE
IF (BOTTLES := TV) EQL 0 THEN
BOTTLES := 99;
IF BOTTLES > 99 AND SPELL THEN
BEGIN
FORM "I know the words only up to ninety-nine.";
SPOUT;
SPOUT; % blank line
END;
ATTACH HI TO MYSELF.EXCEPTIONEVENT;
FOR BOTTLES := BOTTLES STEP -1 UNTIL 1 DO
BEGIN
BOTTLECOUNT(BOTTLES,OP,SPELL);
FORM "of beer on the wall,";
SPOUT;
BOTTLECOUNT(BOTTLES,OP,SPELL);
FORM "of beer,";
SPOUT;
IF FALL THEN
BEGIN
FORM "If ";
IF BOTTLES = 1 THEN
FORM "that bottle "
ELSE
FORM "one of those bottles ";
FORM "should happen to fall,";
END
ELSE
BEGIN
FORM "Take ";
IF BOTTLES = 1 THEN
FORM "it "
ELSE
FORM "one ";
FORM "down and pass it around,";
END;
SPOUT;
BOTTLECOUNT(BOTTLES-1,OP,SPELL);
FORM "of beer on the wall.";
SPOUT;
IF BOTTLES GTR 1 THEN
BEGIN
SPOUT; % interstanza blank separator line
IF EARLYEXIT THEN
BEGIN
FORM "Closing time!";
SPOUT;
BOTTLES := 1; % stop loop
END
ELSE
IF REMOTE_OUTPUT THEN
WHEN (1); % one-second interval to allow terminal to catch up
% (and be responsive to EXCEPTIONEVENT (?HI))
END;
END OF BOTTLES LOOP;
END.
AO
# COMBINATORS USED ---------------------------
[? '\n' ?] ?n OP
[(x) x x x] X3 OP
[(_)] X- OP
[-> (_ x) x] ->> OP
[(f i c) [i] [i c <] [] [i f . i 1 -] REC] Downto OP
[{atoi(0 @Str) - Int}] Atoi OP
# THE BOTTLES PROGRAM ------------------------
[X- "Take one down, pass it around, No more bottles of beer on the wall!\n" ?n] Nomore OP
["Take one down, pass it around, " ? 1 - ?
" bottle(s) of beer on the wall.\n" ?n] Beers OP
[X3 ? " bottle(s) of beer on the wall," ?n ? " bottle(s) of beer." ?n
[1 =] [Nomore] [Beers] IFTE]
ARGC 2 = [ARGV 1 ->> Atoi] [1] IFTE 1 Downto
Delphi
// ---- file Singers.pas ----
unit Singers;
interface
uses
SysUtils ;
type
ISinger = interface(IUnknown)
function Sing: String ;
function CanSing: boolean ;
end ;
TAbstractSinger = class(TInterfacedObject,ISinger)
private
FLine: String ;
FCanSing: boolean ;
function GetLine: String ; virtual ;
procedure SetLine(aLine: String) ; virtual ;
public
function CanSing: boolean ; virtual ;
property Line: String read GetLine write SetLine ;
function Sing: String ; virtual ; abstract ;
end ;
TBottlesSinger = class(TAbstractSinger)
private
FCounter: integer ;
function EvalS: String ;
procedure SetCounter(aValue: integer) ;
procedure PrepareLine ;
property Counter: integer read FCounter write SetCounter ;
public
constructor Create ;
function Sing: String ; override ;
end ;
const
CRLF: String = '' + #13#10 ;
implementation
{ TAbstractSinger }
function TAbstractSinger.CanSing: boolean;
begin
result := FCanSing ;
end;
function TAbstractSinger.GetLine: String;
begin
result := FLine ;
end;
procedure TAbstractSinger.SetLine(aLine: String);
begin
FLine := aLine ;
end;
{ TBottlesSinger }
constructor TBottlesSinger.Create;
begin
inherited;
FCounter := 99 ;
FCanSing := true ;
end;
function TBottlesSinger.EvalS: String;
var
res : string ;
begin
res := 's' ;
if FCounter = 1 then
res := '' ;
result := res ;
end;
procedure TBottlesSinger.PrepareLine;
var
lineForOne, lineForMore, lineForNone: String ;
begin
lineForMore := inttostr(Counter) +
' bottles of beer on the wall, ' + inttostr(Counter) +
' bottles of beer.' + CRLF +
'Take one down and pass it around, ' + inttostr(Counter-1) +
' bottle' + EvalS + ' of beer on the wall.' + CRLF ;
lineForOne := '1 bottle of beer on the wall, 1 bottle of beer.' + CRLF +
'Take one down and pass it around,' +
' no more bottles of beer on the wall.' + CRLF ;
lineForNone := 'No more bottle of beer on the wall,' +
' no more bottles of beer.' + CRLF +
'Go to the store and buy some more,' +
' 99 bottles of beer on the wall.' + CRLF ;
case Counter of
1 : begin
FLine := lineForOne ;
Counter := Counter-1 ;
end ;
0 : begin
FLine := lineForNone ;
FCanSing := false ;
end ;
else
begin
FLine := lineForMore ;
Counter := Counter-1 ;
end ;
end ; {case}
end;
procedure TBottlesSinger.SetCounter(aValue: integer);
begin
FCounter := aValue ;
end;
function TBottlesSinger.Sing: String;
begin
PrepareLine ;
result := Line ;
end;
end. // ---- end of file Singers.pas ----
// ---- file Bottles.dpr ----
program Bottles;
{$APPTYPE CONSOLE}
uses
SysUtils,
Singers in 'Singers.pas';
var
Singer: ISinger ;
begin
Singer := TBottlesSinger.Create ;
While Singer.CanSing do
WriteLn(Singer.Sing) ;
FreeAndNil(Singer) ;
end. // ---- end of file Bottles.dpr
FORTRAN
program ninetynine
implicit none
integer i
do i=99,1,-1
print*, i,' bottles of beer on the wall, ',i,' bottles of beer'
print*, 'take one down, pass it around, ',i-1,
. ' bottles of beer on the wall'
enddo
end
Modula
(* Modula-2 version of 99 Bottles of Beer *)
(* Tested on a VAX 7700 running OpenVMS *)
(* Programmer: Jeremy Rule rulej@tempest.adsnet.net *)
MODULE BottlesOfBeer;
FROM InOut IMPORT WriteCard, WriteString, WriteLn;
CONST
BOTTLES = 99;
VAR
counter : CARDINAL;
BEGIN
counter := BOTTLES;
REPEAT
WriteCard( counter,2 );
WriteString(" bottles of beer on the wall, ");
WriteCard( counter,2 );
WriteString(" bottles of beer."); WriteLn;
WriteString(" Take one down, and pass it around, ");
DEC( counter );
WriteCard( counter,2 );
WriteString(" bottles of beer on the wall."); WriteLn;
UNTIL ( counter = 1 );
WriteString("1 bottle of beer on the wall, 1 bottle of beer"); WriteLn;
WriteString("Take it down and pass it around, ");
WriteString("No more bottles of beer on the wall."); WriteLn;
END BottlesOfBeer.
Pascal
program Bottles(input, output);
{ Alice Pascal version of 99 Bottles of beer (Bottles.ap) }
{ See http://www.templetons.com/brad/alice.html }
{ Philipp Winterberg, http://www.winterbergs.de }
var
b : Byte;
begin
b := 99;
repeat
writeln(b:2, ' bottle(s) of beer on the wall,');
writeln(b:2, ' bottle(s) of beer');
writeln('Take one down, pass it around,');
b := b - 1;
writeln(b:2, ' bottle(s) of beer on the wall.');
writeln('');
until b = 0;
end.
Smalltalk
"Copy into a workspace, highlight the code and choose do it."
"Tested under Squeak 3.7 and VisualWorks 7.3"
| verseBlock |
verseBlock := [ :bottles | | verse |
verse := WriteStream with: (String new).
bottles = 0 ifTrue:
[verse
nextPutAll: 'No more bottles of beer on the wall. No more bottles of beer...'; cr;
nextPutAll: 'Go to the store and buy some more... 99 bottles of beer.'; cr].
bottles = 1 ifTrue:
[verse
nextPutAll: '1 bottle of beer on the wall. 1 bottle of beer...'; cr;
nextPutAll: 'Take one down and pass it around, no more bottles of beer on the wall'; cr].
bottles > 1 ifTrue:
[verse
nextPutAll: bottles printString; nextPutAll: ' bottles of beer on the wall. ';
nextPutAll: bottles printString; nextPutAll: ' bottles of beer...'; cr;
nextPutAll: 'Take one down and pass it around, ';
nextPutAll: (bottles - 1) printString, ' bottle';
nextPutAll: (((bottles - 1) > 1) ifTrue: ['s '] ifFalse: [' ']);
nextPutAll: 'of beer on the wall'; cr].
verse contents].
99 to: 0 by: -1 do: [: i | Transcript show: (verseBlock value: i); cr].
wersja strony: 7, ostatnia edycja: 17 Jul 2009 17:53