99 Bottles of Beer

Voting

Please select* Bad as Hell** Nothing new*** Good**** Nice Coding***** TOP GEEK

Category

real language

Bookmarking

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

Alternative Versions

Version	Author	Date	Comments	Rate
Recursive version	Juan Carlos Molinos	01/12/06	2
standard version	Anonymous	04/20/05	4
OO Simple version (not using Interfaces)	Luis Carlos F. Dias	09/04/05	0
NonVCL version	Philipp Winterberg	04/20/05	0
OO version (with interface)	Luis Carlos F. Dias	09/05/05	0

Comments

 Marco said on 12/06/05 13:40:23

A lot of code...

 PeterS said on 01/11/06 14:39:07

Since Singer is an interface it should not be freed at the end possibly set to nil but that's not really needed either.

 Boubalou said on 01/11/06 19:29:03

Actually, Delphi isnt a language... Pascal is the language used by Delphi's IDE.

 Luis Carlos F. Dias said on 01/13/06 02:51:04

Indeed, it's not necessary neither useful to call FreeAndNil over an interface. This call is present only by a careless copy/paste done over OO simple version (not using interfaces) and even in this case it's there only to show library features.

My goal here was to put as many Object Pascal/Delphi features as I could and by the way, Object Pascal is a language and Delphi is an IDE that uses Object Pascal.

 slieka said on 06/06/06 23:08:21

you can get the same result by this code


program Bottles;

{$APPTYPE CONSOLE}

uses
SysUtils;
var
i:integer;
begin
i:=99;
while i > 0 do
begin
writeln(inttostr(i) + ' bottles of beer on the wall,' + inttostr(i) + ' bottles of beer.');
writeln('Take one down and pass it around, ' + inttostr(i-1) + ' bottle' + ' of beer on the wall.');
i := i -1;
end;
writeln('No more bottle of beer on the wall,' + ' no more bottles of beer.' );
writeln('Go to the store and buy some more,' + ' 99 bottles of beer on the wall.');
readln
end.


:D

 Luis Carlos F. Dias said on 06/07/06 04:03:19

Yes, Slieka, it's true: you can get the same result using the code you wrote. That's why there are different versions - the "standard version" which is like yours, and this "OO Version", which is not. The aim here is not to write the song in the simplest way, but to show Object Pascal/Delphi features like Objects, Inheritance, Interfaces, Encapsulation, Polymorphism, and so on.

 Rodrigo E. Nunes said on 05/08/07 23:33:45

Since Delphi 7, the language name is Delphi, no more Object Pascal.

 Luis Carlos F. Dias said on 05/15/07 01:43:24

Yes, Rodrigo, since Delphi 7 the language is referred to as Delphi Language.

 Kai Olav Fredriksen said on 01/08/09 14:10:17

As PeterS says - don't free the interface. And const the string in "procedure TAbstractSinger.SetLine(aLine: String);
begin
FLine := aLine ;
end;"

-> TAbstractSinger.SetLine(const aLine: String);

Add Comment

Please provide a value for the fields Name, Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.

Please don't post large portions of code here! Use the form to submit new examples or updates instead!

Name:

eMail:

URL:

Security Code:
  
Comment: