diff --git a/01 Acey Ducey/README.md b/01 Acey Ducey/README.md index 11c6b1a8..ad0bdbad 100644 --- a/01 Acey Ducey/README.md +++ b/01 Acey Ducey/README.md @@ -5,7 +5,3 @@ https://www.atariarchives.org/basicgames/showpage.php?page=2 Downloaded from Vintage Basic at http://www.vintage-basic.net/games.html - -#### Other languages: - -- [Pascal/Object Pascal](https://github.com/gcarreno/basic-computer-games-in-pascal/tree/main/01%20Acey%20Ducey) \ No newline at end of file diff --git a/01 Acey Ducey/pascal/.gitattributes b/01 Acey Ducey/pascal/.gitattributes new file mode 100644 index 00000000..f59d5ede --- /dev/null +++ b/01 Acey Ducey/pascal/.gitattributes @@ -0,0 +1,36 @@ +# Set the default behavior, in case people don't have core.autocrlf set. +* text=auto + +# Explicitly declare text files you want to always be normalized and converted +# to native line endings on checkout. +*.inc text +*.pas text +*.pp text +*.lpk text +*.lpi text +*.lps text +*.lpr text +*.def text +*.css text +*.html text +*.xml text +*.sql text + +# Declare files that will always have CRLF line endings on checkout. +*.dpk text eol=crlf +*.dproj text eol=crlf + +# Declare files that will always have LF line endings on checkout. + + +# Denote all files that are truly binary and should not be modified. +*.png binary +*.jpg binary +*.exe binary +*.res binary +*.ico binary +*.dll binary + +# Keep these files from archive/exports, mainly from production. +.gitignore export-ignore +.gitattributes export-ignore diff --git a/01 Acey Ducey/pascal/.gitignore b/01 Acey Ducey/pascal/.gitignore new file mode 100644 index 00000000..a95e39cf --- /dev/null +++ b/01 Acey Ducey/pascal/.gitignore @@ -0,0 +1,63 @@ +# Basic Computer Programs project specific +aceyducey +aceyducey.exe + +# Compiled l10n files: .mo should be ignored +*.mo + +# Ghostwriter backups +*.backup + +# nano editor backup files +*.swp + +# Uncomment these types if you want even more clean repository. But be careful. +# It can make harm to an existing project source. Read explanations below. +# +# Resource files are binaries containing manifest, project icon and version info. +# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. +*.res + +# Delphi/Lazarus compiler-generated binaries (safe to delete) +*.exe +*.dll +*.bpl +*.bpi +*.dcp +*.so +*.apk +*.drc +*.map +*.dres +*.rsm +*.tds +*.dcu +*.lib +*.[ao] +*.or +*.ppu +*.dbg +*.compiled + +# Delphi autogenerated files (duplicated info) +*.cfg +*Resource.rc + +# Delphi local files (user-specific info) +*.local +*.identcache +*.projdata +*.tvsconfig +*.dsk + +# Delphi history and backups +__history/ +*.~* + +# Lazarus history, backups and session +backup/ +*.bak +*.lps + +# Castalia statistics file +*.stat diff --git a/01 Acey Ducey/pascal/object-pascal/aceyducey.lpi b/01 Acey Ducey/pascal/object-pascal/aceyducey.lpi new file mode 100644 index 00000000..9e1a30e8 --- /dev/null +++ b/01 Acey Ducey/pascal/object-pascal/aceyducey.lpi @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <Units Count="3"> + <Unit0> + <Filename Value="aceyducey.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="game.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Game"/> + </Unit1> + <Unit2> + <Filename Value="deck.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Deck"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="aceyducey"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/01 Acey Ducey/pascal/object-pascal/aceyducey.pas b/01 Acey Ducey/pascal/object-pascal/aceyducey.pas new file mode 100644 index 00000000..733221f5 --- /dev/null +++ b/01 Acey Ducey/pascal/object-pascal/aceyducey.pas @@ -0,0 +1,18 @@ +program aceyducey; + +{$IFDEF FPC} +{$mode objfpc}{$H+} +{$ENDIF} + +uses + Game, Deck +; + +var + Acey_Ducey: TGame; + +begin + Acey_Ducey:= TGame.Create; + Acey_Ducey.Run; +end. + diff --git a/01 Acey Ducey/pascal/object-pascal/deck.pas b/01 Acey Ducey/pascal/object-pascal/deck.pas new file mode 100644 index 00000000..d5940fe2 --- /dev/null +++ b/01 Acey Ducey/pascal/object-pascal/deck.pas @@ -0,0 +1,111 @@ +unit Deck; + +{$IFDEF FPC} +{$mode objfpc}{$H+} +{$ENDIF} + +interface + +uses + Classes +, SysUtils +; + +type +{ TDeck } + TDeck = class + private + FDealerLow: Integer; + FDealerHigh: Integer; + FPlayer: Integer; + + procedure PrintCard(const ACard: Integer); + protected + public + property DealerLow: Integer + read FDealerLow; + property DealerHigh: Integer + read FDealerHigh; + property Player: Integer + read FPlayer; + + procedure DrawCards; + procedure ShowDealerCards; + procedure ShowPlayerCard; + function PlayerWins: Boolean; + published + end; + +implementation + +{ TDeck } + +procedure TDeck.PrintCard(const ACard: Integer); +begin + if ACard < 11 then + begin + Write(ACard); + end; + if ACard = 11 then + begin + Write('JACK'); + end; + if ACard = 12 then + begin + Write('QUEEN'); + end; + if ACard = 13 then + begin + Write('KING'); + end; + if ACard = 14 then + begin + Write('ACE'); + end; +end; + +procedure TDeck.DrawCards; +var + tmp: Integer; +begin + repeat + FDealerLow:= Random(14) + 2; + until (FDealerLow >= 2) and (FDealerLow <= 14); + repeat + FDealerHigh:= Random(14) + 2; + until (FDealerHigh >= 2) and (FDealerHigh <= 14) and (FDealerLow <> FDealerHigh); + if FDealerLow > FDealerHigh then + begin + tmp:= FDealerHigh; + FDealerHigh:= FDealerLow; + FDealerLow:= tmp; + end; + repeat + FPlayer:= Random(14) + 2; + until (FPlayer >= 2) and (FPlayer <= 14); +end; + +procedure TDeck.ShowDealerCards; +begin + Write('HERE ARE YOUR NEXT TWO CARDS: '); + PrintCard(FDealerLow); + Write(' '); + PrintCard(FDealerHigh); + WriteLN; + WriteLN; +end; + +procedure TDeck.ShowPlayerCard; +begin + PrintCard(FPlayer); + WriteLN; + WriteLN; +end; + +function TDeck.PlayerWins: Boolean; +begin + Result:= (FPlayer > FDealerLow) and (FPlayer < FDealerHigh); +end; + +end. + diff --git a/01 Acey Ducey/pascal/object-pascal/game.pas b/01 Acey Ducey/pascal/object-pascal/game.pas new file mode 100644 index 00000000..1a263159 --- /dev/null +++ b/01 Acey Ducey/pascal/object-pascal/game.pas @@ -0,0 +1,136 @@ +unit Game; + +{$IFDEF FPC} +{$mode objfpc}{$H+} +{$ENDIF} + +interface + +uses + Classes +, SysUtils +, Crt +, Deck +; + +type +{ TGame } + TGame = class + private + FStash: Integer; + FBet: Integer; + FDeck: TDeck; + + procedure PrintGreeting; + procedure PrintBalance; + function GetBet: Integer; + function TryAgain: Boolean; + protected + public + constructor Create; + destructor Destroy; override; + + procedure Run; + published + end; + +implementation + +{ TGame } + +procedure TGame.PrintGreeting; +begin + WriteLN(' ':26, 'ACEY DUCEY CARD GAME'); + WriteLN(' ':15, 'CREATIVE COMPUTING MORRISTOWN, NEW JERSEY'); + WriteLN; + WriteLN; + WriteLN('ACEY-DUCEY IS PLAYED IN THE FOLLOWING MANNER '); + WriteLN('THE DEALER (COMPUTER) DEALS TWO CARDS FACE UP'); + WriteLN('YOU HAVE AN OPTION TO BET OR NOT BET DEPENDING'); + WriteLN('ON WHETHER OR NOT YOU FEEL THE CARD WILL HAVE'); + WriteLN('A VALUE BETWEEN THE FIRST TWO.'); + WriteLN('IF YOU DO NOT WANT TO BET, INPUT A 0'); + WriteLN; +end; + +procedure TGame.PrintBalance; +begin + WriteLN('YOU NOW HAVE ', FStash,' DOLLARS.'); + WriteLN; +end; + +function TGame.GetBet: Integer; +begin + Result:= 0; + repeat + Write('WHAT IS YOUR BET: '); + ReadLN(Result); + if Result > FStash then + begin + WriteLn('SORRY, MY FRIEND, BUT YOU BET TOO MUCH.'); + WriteLn('YOU HAVE ONLY ', FStash,' DOLLARS TO BET.'); + end; + until (Result >=0) and (Result <= FStash); +end; + +function TGame.TryAgain: Boolean; +var + answer: String; +begin + Result:= False; + Write('TRY AGAIN (YES OR NO)'); + ReadLn(answer); + Result:= (LowerCase(answer)='yes') or (LowerCase(answer)='y'); +end; + +constructor TGame.Create; +begin + FDeck:= TDeck.Create; +end; + +destructor TGame.Destroy; +begin + FDeck.Free; + inherited Destroy; +end; + +procedure TGame.Run; +begin + ClrScr; + PrintGreeting; + repeat + Randomize; + FStash:= 100; + repeat + PrintBalance; + FDeck.DrawCards; + //DrawDealerCards; + FDeck.ShowDealerCards; + FBet:= GetBet; + if FBet = 0 then + begin + WriteLN('CHICKEN!!'); + continue; + end; + //DrawPlayerCard; + FDeck.ShowPlayerCard; + //if (FCardC > FCardA) and (FCardC < FCardB) then + if FDeck.PlayerWins then + begin + WriteLN('YOU WIN!!!'); + Inc(FStash, FBet) + end + else + begin + WriteLN('SORRY, YOU LOSE'); + Dec(FStash, FBet) + end; + until FStash = 0; + WriteLN('SORRY, FRIEND, BUT YOU BLEW YOUR WAD.'); + WriteLN; + until not TryAgain; + WriteLN('O.K., HOPE YOU HAD FUN!'); +end; + +end. + diff --git a/01 Acey Ducey/pascal/simple/aceyducey.lpi b/01 Acey Ducey/pascal/simple/aceyducey.lpi new file mode 100644 index 00000000..f80bb634 --- /dev/null +++ b/01 Acey Ducey/pascal/simple/aceyducey.lpi @@ -0,0 +1,58 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="11"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <MainUnitHasScaledStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="aceyducey"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="aceyducey.pas"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="aceyducey"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/01 Acey Ducey/pascal/simple/aceyducey.pas b/01 Acey Ducey/pascal/simple/aceyducey.pas new file mode 100644 index 00000000..35a9dd64 --- /dev/null +++ b/01 Acey Ducey/pascal/simple/aceyducey.pas @@ -0,0 +1,152 @@ +program aceyducey; + +{$IFDEF FPC} +{$mode objfpc}{$H+} +{$ENDIF} + +uses + Crt; + +var + Stash: Integer; + CardA: Integer; + CardB: Integer; + CardC: Integer; + Bet: Integer; + +procedure PrintGreeting; +begin + WriteLN(' ':26, 'ACEY DUCEY CARD GAME'); + WriteLN(' ':15, 'CREATIVE COMPUTING MORRISTOWN, NEW JERSEY'); + WriteLN; + WriteLN; + WriteLN('ACEY-DUCEY IS PLAYED IN THE FOLLOWING MANNER '); + WriteLN('THE DEALER (COMPUTER) DEALS TWO CARDS FACE UP'); + WriteLN('YOU HAVE AN OPTION TO BET OR NOT BET DEPENDING'); + WriteLN('ON WHETHER OR NOT YOU FEEL THE CARD WILL HAVE'); + WriteLN('A VALUE BETWEEN THE FIRST TWO.'); + WriteLN('IF YOU DO NOT WANT TO BET, INPUT A 0'); + WriteLN; +end; + +procedure PrintBalance; +begin + WriteLN('YOU NOW HAVE ', Stash,' DOLLARS.'); + WriteLN; +end; + +procedure PrintCard(const ACard: Integer); +begin + if ACard < 11 then + begin + Write(ACard); + end; + if ACard = 11 then + begin + Write('JACK'); + end; + if ACard = 12 then + begin + Write('QUEEN'); + end; + if ACard = 13 then + begin + Write('KING'); + end; + if ACard = 14 then + begin + Write('ACE'); + end; +end; + +procedure DrawDealerCards; +var + tmp: Integer; +begin + Write('HERE ARE YOUR NEXT TWO CARDS: '); + repeat + CardA:= Random(14) + 2; + until (CardA >= 2) and (CardA <= 14); + repeat + CardB:= Random(14) + 2; + until (CardB >= 2) and (CardB <= 14) and (CardA <> CardB); + if CardA > CardB then + begin + tmp:= CardB; + CardB:= CardA; + CardA:= tmp; + end; + PrintCard(CardA); + Write(' '); + PrintCard(CardB); + WriteLN; + WriteLN; +end; + +procedure DrawPlayerCard; +begin + repeat + CardC:= Random(14) + 2; + until (CardC >= 2) and (CardC <= 14); + PrintCard(CardC); + WriteLN; + WriteLN; +end; + +function GetBet: Integer; +begin + Result:= 0; + repeat + Write('WHAT IS YOUR BET: '); + ReadLN(Result); + if Result > Stash then + begin + WriteLn('SORRY, MY FRIEND, BUT YOU BET TOO MUCH.'); + WriteLn('YOU HAVE ONLY ', Stash,' DOLLARS TO BET.'); + end; + until (Result >=0) and (Result <= Stash); +end; + +function TryAgain: Boolean; +var + answer: String; +begin + Result:= False; + Write('TRY AGAIN (YES OR NO)'); + ReadLn(answer); + Result:= (LowerCase(answer)='yes') or (LowerCase(answer)='y'); +end; + +begin + ClrScr; + PrintGreeting; + repeat + Randomize; + Stash:= 100; + repeat + PrintBalance; + DrawDealerCards; + Bet:= GetBet; + if Bet = 0 then + begin + WriteLN('CHICKEN!!'); + continue; + end; + DrawPlayerCard; + if (CardC > CardA) and (CardC < CardB) then + begin + WriteLN('YOU WIN!!!'); + Inc(Stash, Bet) + end + else + begin + WriteLN('SORRY, YOU LOSE'); + Dec(Stash, Bet) + end; + until Stash = 0; + WriteLN('SORRY, FRIEND, BUT YOU BLEW YOUR WAD.'); + WriteLN; + until not TryAgain; + WriteLN('O.K., HOPE YOU HAD FUN!'); +end. +