dos_compilers/Borland Turbo Pascal v55/BREAKOUT.PAS
2024-07-02 06:49:04 -07:00

302 lines
6.5 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{ Turbo Breakout }
{ Copyright (c) 1989 by Borland International, Inc. }
program Breakout;
{ Turbo Pascal 5.5 object-oriented example.
This is a version of the classic arcade game, Breakout.
SCREEN.PAS
COUNT.PAS
BRICKS.PAS
BOUNDS.PAS
WALLS.PAS
BREAKOUT.PAS
To build an executable file, compile from the command line with:
tpc /b breakout
or load BREAKOUT.PAS into the integrated development
environment and press F9.
When testing the program, you may want to force the paddle to
follow the ball, so you'll never miss. The program contains
conditional compilation directives to produce this version, and
you can build it from the command line with:
tpc /DTest breakout
or load BREAKOUT.PAS into the integrated development
environment, select Alt-O/C/C, type 'Test' (without the quotes,
of course) followed by the Enter key, then select Alt-C/B to
rebuild the executable file.
}
uses Screen, Count, Bricks, Bounds, Walls, Crt, Dos;
var
ss : SaveScreen;
w : Wall;
b : Ball;
p : Paddle;
Speed : LimitCounter;
Left : LeftBound;
Top : UpperBound;
Right : RightBound;
Bottom : LowerBound;
Obstacles : ObstacleList;
PaddleMsg,
SpeedMsg,
StartMsg,
QuitMsg,
PauseMsg1,
PauseMsg2,
TypeMsg : TextString;
Score : Counter;
Highest : Counter;
Balls : DownCounter;
X : Integer;
Finished : Boolean;
FirstGame : Boolean;
TypeInc,
ch : Char;
procedure Startup;
begin
{ First set up the screen and the cursor }
ss.Init;
TextBackground(BLACK);
ClrScr;
{ Create the boundaries of the playfield }
Left.Init(0, 0, 27, False);
Top.Init(0, 0, 82, False);
Right.Init(81, 0, 27, False);
Bottom.Init(0, 24, 82, True);
{ Initialize the score displays }
Score.Init(0, 65, 24, 'Score', 15);
Score.Show;
Highest.Init(0, 60, 25, 'High Score', 14);
Highest.Show;
{ Set up the various menu messages }
PauseMsg1.Init(31, 18, 'Paused. Press any', 15);
PauseMsg2.Init(31, 19, ' key to continue.', 15);
SpeedMsg.Init(5, 23, #24 + #25 + ' to change speed', 14);
StartMsg.Init(5, 24, #17 + #196 + #217 + ' to begin game', 14);
PaddleMsg.Init(5, 24, #27 + #26 + ' to move paddle', 14);
QuitMsg.Init(5, 25, 'ESC to quit', 14);
QuitMsg.Show;
{ Set up the information messages }
Balls.Init(5, 40, 24, -1, 'Balls', 15);
Balls.Show;
Speed.Init(1, 40, 25, 1, 10, 'Speed', 14);
Speed.Show;
{ Build the wall }
w.Init(1, 1, 16, 10);
w.Show;
{ Need to initialize these, even though we're going to move them later }
b.Init(10, 22, 1, -1, YELLOW);
p.Init(8, 23, WHITE);
{ Put the various obstacles into a list. We don't really need
to do this, but it makes changing things around much easier }
Obstacles.Init;
Obstacles.Append(@p);
Obstacles.Append(@w);
Obstacles.Append(@Left);
Obstacles.Append(@Top);
Obstacles.Append(@Right);
Obstacles.Append(@Bottom);
TypeMsg.Init(22, 12, 'Increase typematic rate? (y/n) ', WHITE);
TypeMsg.Show;
repeat
TypeInc := UpCase(ReadKey);
until (TypeInc = 'Y') or (TypeInc = 'N');
TypeMsg.Hide;
if TypeInc = 'Y' then
ss.Speedup;
ss.SetCursor($2000);
Randomize;
FirstGame := True;
end;
procedure NewGame;
begin
Balls.Reset;
Score.Reset;
if not FirstGame then
w.Reset;
X := Random(78) + 3;
b.MoveTo(X, 22);
p.MoveTo(X-2, 23);
b.Show;
p.Show;
Balls.Decrement;
FirstGame := False;
end;
{ This procedure handles keystrokes between games.
It returns False if the user presses ESC, otherwise it returns True. }
function MainMenu : Boolean;
var
Done : Boolean;
begin
MainMenu := True;
Done := False;
SpeedMsg.Show;
StartMsg.Show;
while not Done do
begin
ch := ReadKey;
case ch of
Chr(27) :
begin
MainMenu := False;
Done := True;
end;
#13 : Done := True;
#0 :
begin
ch := ReadKey;
if Ord(ch) = 72 then
Speed.Increment
else if Ord(ch) = 80 then
Speed.Decrement;
end;
end;
end;
SpeedMsg.Hide;
StartMsg.Hide;
end;
{ This procedure handles keystrokes while the game is in progress }
procedure ProcessKeyStroke;
{ Pause the game }
procedure Pause;
begin
PauseMsg1.Show;
PauseMsg2.Show;
ch := ReadKey;
if KeyPressed then
ch := ReadKey; { Swallow extended keystrokes }
PauseMsg1.Hide;
PauseMsg2.Hide;
b.Show;
end;
begin
ch := ReadKey;
case ch of
Chr(27) : Finished := True;
Chr(0) :
begin
ch := ReadKey;
{$IFNDEF Test}
case Ord(ch) of
75: p.MoveTo(p.GetX - 1, p.GetY); { Left Arrow }
77: p.MoveTo(p.GetX + 1, p.GetY); { Right Arrow }
else
Pause;
end;
{$ELSE}
Pause;
{$ENDIF}
end
else
Pause;
end;
end;
{ This procedure checks for collisions with any of the obstacles
and updates the screen accordingly. }
procedure Update;
var
Offset : Integer;
begin
if Obstacles.CheckCollisions(b, Score) then
begin
b.MoveY;
p.MoveTo(b.GetX - 2, p.GetY);
sound(150);
Delay(300);
nosound;
Balls.Decrement;
while KeyPressed do
ch := ReadKey;
end;
b.MoveX;
b.MoveY;
{$IFDEF Test}
p.MoveTo(b.NextX -2, p.GetY);
{$ENDIF}
end;
{ This procedure cleans up when we're exiting from the program }
procedure ShutDown;
begin
b.Hide;
Obstacles.Hide;
Balls.Hide;
Score.Hide;
Obstacles.Done;
ss.Restore;
if TypeInc = 'Y' then
ss.Slowdown;
ClrScr;
end;
{ This procedure plays a game. The main loop allows up to ten keystrokes,
then moves the ball and checks for collisions }
procedure Play;
var
KeyLoops : Integer;
begin
NewGame;
{$IFNDEF Test}
PaddleMsg.Show;
{$ENDIF}
Finished := False;
KeyLoops := 0;
repeat
if KeyPressed then
ProcessKeyStroke;
Inc(KeyLoops);
if (KeyLoops = 10) and not Finished then
begin
KeyLoops := 0;
UpDate;
end;
Delay(12 - Speed.GetValue);
until Finished or Balls.Last;
PaddleMsg.Hide;
end;
begin
Startup;
while MainMenu do
begin
Play;
Balls.Reset;
b.Hide;
p.Hide;
if Score.GetValue > Highest.GetValue then
Highest.SetValue(Score.GetValue);
end;
ShutDown;
end.