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

Podobne strony

Podobne Strony
O ile nie zaznaczono inaczej, treść tej strony objęta jest licencją Creative Commons Attribution-ShareAlike 3.0 License