(* This game was written between Tuesday 14th and Monday 20th of July 1992.
It is loosely based on a game written the year before by Jonathon Moore
of Alfred McAlpine's Penrhyn Quarry, Bethesda. My game was written for
an open day in the Quarry, for the little sprogs to play on, and is
meant to be broadly educational. However it just turned into a straight
off arcade game. I got payed �50 for it!

I'm pleased with the way the sheep move. My previous Turbo Invaders was
very shakey. This is better because only a small area of the screen is
animated. The clink on the 3rd level is good, as the the movement of the
rock on the second, but for the flicker. It had to be bilingual, which
was a bit of a bugger, as it meant the screen display was crowded.

Not bad for 4 or 5 days work.
Robert Summerwill - July '92 *)

{****************************************************************************}
Program QuarryGame;

uses Graph, Crt;

var Bangs : integer;
BaseX : integer;
BaseY : integer;
CarPointer : pointer;
CarPosition : integer;
Chance : integer;
Chopped : byte;
ChopperPointer : pointer;
Count : integer;
Count2 : integer;
Count3 : longint;
Count4 : longint;
Crashes : byte;
CurrentRock : byte;
Damage : byte;
Done : boolean;
Escape : byte;
Finished : boolean;
GraphDriver : integer;
GraphMode : integer;
HammerPointer : pointer;
HiScoreName : array [1..11] of string;
HiScore : array [1..11] of integer;
Input : char;
KeyStroke : char;
LogoPointer : pointer;
LinePos : byte;
Lump : byte;
Moves : integer;
OK : boolean;
OldPosition : integer;
Output : string;
Output2 : string;
Password : string;
Position : byte;
Quitted : boolean;
RockCount : byte;
RockPointer : pointer;
RockPosition : array [1..10] of integer;
RockDepth : array [1..10] of byte;
RockVisible : array [1..10] of boolean;
RightColour : byte;
Score1 : integer;
Score2 : integer;
Score3 : integer;
ScreenPointer : pointer;
ScreenSize : integer;
SlatePointer : pointer;
TargetTime : byte;
Temp : string;
Tilt : byte;
Time : integer;
TimeString : string;
Total : integer;
Var1 : integer;
Var2 : integer;
Wait : longint;

const Car : array [0..9, 0..31] of byte =(

(8,8,8,8,8,8,8,1,1,1,1,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8),
(8,7,0,7,2,7,1,1,1,1,1,1,1,2,7,2,7,2,7,1,1,1,1,7,2,7,2,7,2,0,2,8),
(8,8,2,0,7,1,1,1,1,1,1,1,1,1,2,7,1,1,1,1,1,1,1,2,7,2,7,2,0,7,8,8),
(8,8,8,7,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,2,8,8,8),
(8,8,8,8,2,7,2,7,2,7,2,7,2,7,2,7,2,7,2,7,2,7,2,7,2,7,2,7,8,8,8,8),
(8,8,0,0,0,0,8,8,0,0,0,0,4,4,8,8,8,8,4,4,0,0,0,0,8,8,0,0,0,0,8,8),
(8,8,0,0,0,0,8,8,0,0,0,0,8,8,8,14,14,8,8,8,0,0,0,0,8,8,0,0,0,0,8,8),
(8,8,0,0,0,0,0,0,0,0,0,0,14,14,14,14,14,14,14,14,0,0,0,0,0,0,0,0,0,0,8,8),
(8,8,0,0,0,0,8,8,0,0,0,0,8,8,8,8,8,8,8,8,0,0,0,0,8,8,0,0,0,0,8,8),
(8,8,0,0,0,0,8,8,0,0,0,0,8,8,8,8,8,8,8,8,0,0,0,0,8,8,0,0,0,0,8,8) );

const Rock : array [0..7, 0..20] of byte =(

(8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8),
(8,8,0,0,0,0,0,8,8,8,8,8,8,8,8,8,8,8,8,8,8),
(8,8,0,0,0,0,0,15,7,7,7,15,7,7,7,8,8,8,8,8,8),
(8,8,8,8,8,7,15,7,7,15,7,7,15,7,15,7,7,8,8,8,8),
(8,8,8,8,8,7,7,15,7,7,15,7,7,7,15,7,7,8,8,8,8),
(8,8,8,8,8,8,7,7,7,7,7,7,15,7,7,7,8,8,8,8,8),
(8,8,8,8,8,8,8,0,8,8,8,8,8,0,8,8,8,8,8,8,8),
(8,8,8,8,8,8,8,0,8,8,8,8,8,0,8,8,8,8,8,8,8) );

const Chopper : array [0..14, 0..7] of byte =(

(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,8,7,7,8,0,0),
(0,0,0,7,7,0,0,0),
(0,0,0,7,7,0,0,0),
(0,0,0,7,7,0,0,0),
(0,0,0,7,7,0,0,0),
(0,0,0,7,7,0,0,0) );

const Hammer : array [0..9, 0..15] of byte =(

(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0),
(0,0,0,7,7,0,0,0,0,0,0,4,4,4,4,4),
(0,0,0,7,7,8,8,8,4,4,4,4,4,4,4,4),
(0,0,0,7,7,0,0,0,0,0,0,4,4,4,4,4),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0),
(0,0,7,7,7,7,0,0,0,0,0,0,0,0,0,0) );

Procedure SANSfont; external; {$L \tp\bgi\sans.obj }
Procedure EGAVGADriver; external; {$L \tp\bgi\egavga.obj }

Procedure AddARock; forward;
Procedure AddName; forward;
Procedure Baa; forward;
Procedure CaptureScreen; forward;
Procedure CheckFor (SearchString : string); forward;
Procedure DisplayScreen; forward;
Procedure DrawLevel2; forward;
Procedure DrawRock; forward;
Procedure FinishedStage1; forward;
Procedure FinishedStage2; forward;
Procedure FinishedStage3; forward;
Procedure FloodFills; forward;
Procedure Frames; forward;
Procedure Game1; forward;
Procedure Game2; forward;
Procedure Game3; forward;
Procedure GetKeyStrokes; forward;
Procedure GrassFade; forward;
Procedure HaveACrash; forward;
Procedure InitialiseGraphics; forward;
Procedure InitialiseHiScores; forward;
Procedure InputText; forward;
Procedure IsItGood; forward;
Procedure Mountains; forward;
Procedure ReadySteadyGo; forward;
Procedure ReadySteadyGo2; forward;
Procedure Rocks; forward;
Procedure SetGraphicsMode; forward;
Procedure SetUpVariables; forward;
Procedure ShowHighScores; forward;
Procedure SkyFade; forward;
Procedure SortCarSprite; forward;
Procedure SortChopper; forward;
Procedure SortLogo; forward;
Procedure SortRockSprite; forward;
Procedure SortSlate; forward;
Procedure Stage1; forward;
Procedure Stage2; forward;
Procedure Stage3; forward;
Procedure TitleScreen; forward;

{****************************************************************************}
Procedure AddARock;

begin
Inc (RockCount);
Inc (CurrentRock);
if CurrentRock = 11 then CurrentRock := 1;
RockVisible [CurrentRock] := True;
RockDepth [CurrentRock] := 1;
RockPosition [CurrentRock] := Random (34)-18;
end;

{****************************************************************************}
Procedure AddName;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetTextStyle (3, 0, 4);
OutTextXY (116, 4, 'Well done! - Well done!');
SetTextStyle (0, 0, 1);
SetColor (Green);
OutTextXY (205, 50, 'You have got a high score');
OutTextXY (220, 80, 'Please enter your name');
SetColor (Yellow);
OutTextXY (205, 60, 'You have got a high score');
OutTextXY (220, 90, 'Please enter your name');
SetColor (White);
GotoXY (180, 100);
InputText;
Temp := '';
OK := True;
for Count := 1 to Length (Output) do
if Output [Count] <> ' ' then Temp := Temp + UpCase (Output [Count]);

{Swear word removal}

CheckFor ('ARSE');
CheckFor ('BASTARD');
CheckFor ('BELL END');
CheckFor ('BENDER');
CheckFor ('BLOODY');
CheckFor ('BOLLOCKS');
CheckFor ('BOOBS');
CheckFor ('BOTTOM');
CheckFor ('BREASTS');
CheckFor ('BUGGER');
CheckFor ('BUM');
CheckFor ('CLIT');
CheckFor ('COCK');
CheckFor ('CUNT');
CheckFor ('DICK');
CheckFor ('DONG');
CheckFor ('FANNY');
CheckFor ('FUCK');
CheckFor ('GAY');
CheckFor ('MINGE');
CheckFor ('PENIS');
CheckFor ('PORNO');
CheckFor ('QUEER');
CheckFor ('SHAG');
CheckFor ('SUCK');
CheckFor ('TIT');
CheckFor ('TWAT');
CheckFor ('WANK');
CheckFor ('WILLY');

{If there are no swear words, then enter it}
if OK then
begin
HiScoreName [Position] := Output;
HiScore [Position] := Total;
end;
SetColor (White);
end;

{****************************************************************************}
Procedure Baa;

begin
For Count3 := 400 to 600 do
begin
Sound (Count3);
for Count4 := 1 to 200 do begin end;
end;
for Count3 := 600 downto 300 do
begin
Sound (Count3);
for Count4 := 1 to 200 do begin end;
end;
NoSound;
end;

{****************************************************************************}
Procedure CaptureScreen;

begin
ScreenSize := ImageSize (12, 4, 404, 164);
GetMem (ScreenPointer, ScreenSize);
GetImage (12, 4, 404, 164, ScreenPointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure CheckFor (SearchString : string);

begin
for Count := 1 to (Length (Temp)-Length (SearchString)+1) do
begin
Count3 := 0;
for Count2 := 1 to Length (SearchString) do
if Temp [Count+Count2-1] = SearchString [Count2] then Inc (Count3);
if Count3 = Length (SearchString) then OK := False;
end;
end;

{****************************************************************************}
Procedure DisplayScreen;

begin
ClearViewPort;
SetFillStyle (SolidFill, DarkGray);
PutImage (12, 4, ScreenPointer^, CopyPut);
SetColor (Yellow);
OutTextXY (250, 175, 'Mind the sheep!');
OutTextXY (460, 155, 'Damage');
OutTextXY (460, 105, 'Time Remaining:');
SetColor (Green);
OutTextXY (64, 175, 'Mind the sheep!');
OutTextXY (460, 145, 'Damage');
OutTextXY (460, 95, 'Time Remaining:');
SetColor (White);
PutImage (CarPosition, 150, CarPointer^, CopyPut);
SetTextStyle (3, 0, 4);
end;

{****************************************************************************}
Procedure DrawLevel2;

begin
ClearViewPort;
SetFillStyle (9, Green);
Bar (200, 0, 275, 199);
SetColor (White);
Line (199, 0, 199, 199);
Line (276, 0, 276, 199);
SetColor (White);
Rectangle (300, 40, 500, 80);
Line (268, 60, 299, 60);
Line (268, 61, 299, 61);
Line (262, 60, 265, 60);
Line (262, 61, 265, 61);
Line (260, 30, 260, 90);
SetFillStyle (SolidFill, White);
Bar (301, 56, 499, 64);
SetColor (LightGray);
Line (268, 59, 299, 59);
Line (268, 62, 299, 62);
SetFillStyle (SolidFill, LightGray);
Bar (301, 48, 499, 55);
Bar (301, 65, 499, 72);
SetColor (DarkGray);
Line (268, 58, 299, 58);
Line (268, 63, 299, 63);
SetFillStyle (SolidFill, DarkGray);
Bar (301, 41, 499, 47);
Bar (301, 73, 499, 79);
SetColor (Black);
Line (266, 57, 299, 57);
Line (266, 64, 299, 64);
Line (266, 64, 266, 57);
Line (267, 64, 267, 64);
Line (261, 59, 265, 59);
Line (261, 62, 265, 62);
Line (261, 59, 261, 62);
{Draw Floor}
SetColor (White);
Line (277, 65, 299, 65);
Line (277, 56, 299, 56);
SetFillStyle (10, Red);
FloodFill (0, 0, White);
FloodFill (277, 0, White);
SetColor (Black);
Line (277, 65, 299, 65);
Line (277, 56, 299, 56);
end;

{****************************************************************************}
Procedure DrawRock;

begin

{Top side}
if Lump = Count
then
begin
Line (210, Position, 235, Position-3);
Line (235, Position-3, 260, Position);
end
else
Line (210, Position, 260, Position);

{Right Side}
Inc (Count);
if Count = 5 then Count := 1;
if Lump = Count
then
begin
Line (260, Position, 265, Position+10);
Line (265, Position+10, 260, Position+20);
if (Position = 70) then
begin
Lump := 0;
Inc (Chopped);
SetFillStyle (9, Green);
Bar (261, 70, 270, 90);
end;
end
else
Line (260, Position, 260, Position+20);

{Bottom Side}
Inc (Count);
if Count = 5 then Count := 1;
if Lump = Count
then
begin
Line (260, Position+20, 235, Position+23);
Line (235, Position+23, 210, Position+20);
end
else
Line (260, Position+20, 210, Position+20);

{Left Side}
Inc (Count);
if Count = 5 then Count := 1;
if Lump = Count
then
begin
Line (210, Position+20, 205, Position+10);
Line (205, Position+10, 210, Position);
end
else
Line (210, Position+20, 210, Position);

{Inside}
Case GetColor of
Green : begin
SetFillStyle (9, Green);
Bar (210, Position+18, 260, Position+24);
if Position > 70 then Bar (261, Position, 265, Position+24);
Bar (205, Position, 209, Position+24);
end;
White : begin
SetFillStyle (9, Blue);
Bar (211, Position+1, 259, Position+19);
end;
end;
end;

{****************************************************************************}
Procedure FinishedStage1;

begin
ClearViewPort;
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetColor (Green);
OutTextXY (10, 10, 'Well done, you have arrived at the sawshed.');
SetColor (Yellow);
OutTextXY (10, 20, 'Well done, you have arrived at the sawshed.');
Score1 := 1000 - Moves - (20*Damage) - (250*Crashes);
if Score1 < 0 then Score1 := 0;
Str (Score1, Temp);
SetColor (Green);
OutTextXY (10, 40, 'You scored '+Temp+' points');
SetColor (Yellow);
OutTextXY (10, 50, 'You scored '+Temp+' points');
SetColor (Red);
OutTextXY (10, 100, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure FinishedStage2;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
Score2 := (Chopped*40)-(Moves*10);
Str (Chopped, Temp);
SetColor (Green);
OutTextXY (10, 10, 'You successfully cut '+Temp+' out of the 20 blocks.');
SetColor (Yellow);
OutTextXY (10, 20, 'You successfully cut '+Temp+' out of the 20 blocks.');
Str (Score2, Temp);
SetColor (Green);
OutTextXY (10, 40, 'You scored '+Temp+' points.');
SetColor (Yellow);
OutTextXY (10, 50, 'You scored '+Temp+' points.');
Total := Score1 + Score2;
Str (Total, Temp);
SetColor (Green);
OutTextXY (10, 70, 'Your score so far is '+Temp+' points. Well done!');
SetColor (Yellow);
OutTextXY (10, 80, 'Your score so far is '+Temp+' points. Well done!');
SetColor (Red);
OutTextXY (10, 110, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Total := Score1+Score2;
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure FinishedStage3;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
Str (Bangs+1, Temp);
SetColor (Green);
OutTextXY (10, 10, 'You split '+Temp+' slates.');
SetColor (Yellow);
OutTextXY (10, 20, 'You split '+Temp+' slates.');
SetColor (Green);
Bangs := 62-Bangs;
Str (Abs (Bangs), Temp);
if Bangs < 0 then OutTextXY (170, 10,' You split '+Temp+' too many.');
if Bangs > 0 then OutTextXY (170, 10,' You split '+Temp+' too few.');
if Bangs = 0 then OutTextXY (170,10, ' Perfect!');
SetColor (Yellow);
if Bangs < 0 then OutTextXY (170, 20,' You split '+Temp+' too many.');
if Bangs > 0 then OutTextXY (170, 20,' You split '+Temp+' too few.');
if Bangs = 0 then OutTextXY (170, 20, ' Perfect!');
Score3 := (62-Bangs)*15;
if (Score3 < 0) or (Score3 > 1000) then Score3 := 0;
Str (Score3, Temp);
SetColor (Green);
OutTextXY (10, 40, 'You scored '+Temp+' points.');
SetColor (Yellow);
OutTextXY (10, 50, 'You scored '+Temp+' points.');
Total := Total+Score3;
Str (Total, Temp);
SetColor (Green);
OutTextXY (10, 70, 'Your final score is: '+Temp);
SetColor (Yellow);
OutTextXY (10, 80, 'Your final score is: '+Temp);
SetColor (Red);
OutTextXY (10, 100, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure FloodFills;

begin
SetFillStyle (9, DarkGray);
FloodFill (100, 85, White);
SetFillStyle (10, DarkGray);
FloodFill (230, 85, White);
SetFillStyle (9, LightGray);
FloodFill (390, 70, White);
SetFillStyle (SolidFill, DarkGray);
FloodFill (200, 150, White);
end;

{****************************************************************************}
Procedure Frames;

begin
SetColor (White);
Rectangle (15, 7, 401, 161);
SetColor (Cyan);
Rectangle (14, 6, 402, 162);
Line (13, 6, 13, 162);
Line (403, 6, 403, 162);
end;

{****************************************************************************}
Procedure Game1;

begin
Repeat
Sound (100);
Bar (OldPosition, 150, OldPosition+32, 160);
PutImage (CarPosition, 150, CarPointer^, CopyPut);
Inc (LinePos);
if LinePos = 11 then LinePos := 1;
Rocks;
Done := False;
Count := 0;
if ((Time div 20) = 55) or ((Time div 20) = TargetTime) then
begin
SetFillStyle (SolidFill, Black);
Bar (472, 10, 639, 90);
SetFillStyle (SolidFill, DarkGray);
end;
if (Time mod 20) = 0 then
begin
Str ((Time div 20), TimeString);
SetTextStyle (3, 0, 4);
SetFillStyle (SolidFill, Black);
Bar (600, 84, 640, 117);
SetColor (Red);
OutTextXY (600, 85, TimeString);
SetTextStyle (0, 0, 1);
SetColor (White);
SetFillStyle (SolidFill, DarkGray);
if (Time div 20 = 0) then Finished := True;
end;
Dec (Time);
NoSound;
Repeat
Inc (Count);
if KeyPressed then
begin
KeyStroke := UpCase (ReadKey);
Case Keystroke of
'Z' : begin
if CarPosition > 60 then
begin
Done := True;
OldPosition := CarPosition;
CarPosition := CarPosition - 10;
Inc (Moves);
end;
end;
'X' : begin
if CarPosition < 340 then
begin
Done := True;
OldPosition := CarPosition;
CarPosition := CarPosition + 10;
Inc (Moves);
end;
end;
#27 : begin
Quitted := True;
Done := True;
end;
end;
end;
Until Done or (Count = 1000);
Until Quitted or Finished;
end;

{****************************************************************************}
Procedure Game2;

begin
Chopped := 0;
Moves := 0;
for Count2 := 1 to 20 do
begin
SetFillStyle (9, Green);
Bar (209, 0, 261, 25);
Lump := Trunc (Random (4))+1;
Tilt := 1;
for Position := 180 downto 5 do
begin
if (Position < 70) and (Position > 50) and (Lump = 0) then
begin
Sound (110+Position);
for Count3 := 1 to 5000 do begin end;
NoSound;
end;
if (Position = 49) then NoSound;
if (Position = 5) then
begin
SetFillStyle (10, Red);
Bar (400, 100, 600, 170);
SetColor (Green);
OutTextXY (404, 104, 'Blocks Remaining:');
SetColor (Yellow);
OutTextXY (404, 114, 'Blocks Remaining:');
Str (20-Count2, Temp);
SetColor (White);
SetTextStyle (3, 0, 4);
OutTextXY (556, 94, Temp);
SetTextStyle (0, 0, 1);
end;
Count := Tilt;
SetColor (White);
DrawRock;
Line (260, 30, 260, 90);
SetColor (LightGray);
Line (261, 30, 261, 90);
for Count := 1 to 7500 do begin end;
SetColor (Green);
Count := Tilt;
DrawRock;
SetColor (Black);
Line (260, 30, 260, 90);
SetColor (DarkGray);
Line (261, 30, 261, 90);
if KeyPressed then GetKeyStrokes;
if Quitted then Position := 5;
if Quitted then Count2 := 20;
end;
SetFillStyle (SolidFill, DarkGray);
SetColor (White);
end;
end;

{****************************************************************************}
Procedure Game3;

begin
ClearViewPort;
PutImage (70, 120, SlatePointer^, CopyPut);
SetColor (Black);
for Count := 1 to 62 do
Line (68+(Count*8), 120, 68+(Count*8), 189);
SetColor (White);
ReadySteadyGo;
SetFillStyle (SolidFill, Black);
Bangs := 0;
Quitted := False;
for Count := 30 to 569 do
begin
if Count = 50 then Bar (472, 10, 639, 90);
Bar (Count-1, 100, Count+3, 115);
PutImage (Count-4, 100, ChopperPointer^, CopyPut);
Count2 := 0;
KeyStroke := #0;
Repeat
if KeyPressed then
begin
KeyStroke := UpCase (ReadKey);
if KeyStroke = #27 then Quitted := True;
if (KeyStroke = 'Z') and (Count > 69) then
begin
for Count3 := 100 to 105 do
begin
for Count4 := 1 to 10000 do begin end;
Bar (Count-2, 100, Count+3, 119);
PutImage (Count-4, Count3, ChopperPointer^, CopyPut);
end;
for Count3 := 120 to 189 do
begin
PutPixel (Count, Count3, White);
for Count4 := 1 to 800 do begin end;
end;
Inc (Bangs);
for Count3 := 500 downto 495 do
begin
Sound (Count3);
for Count4 := 1 to 100 do begin end;
end;
NoSound;
for Count3 := 105 downto 100 do
begin
for Count4 := 1 to 10000 do begin end;
Bar (Count-1, 100, Count+3, 119);
PutImage (Count-4, Count3, ChopperPointer^, CopyPut);
end;
end;
end;
Inc (Count2);
Until (Count2 > 2000) or (KeyStroke <> #0);
if Quitted then Count := 569;
end;
if Quitted = False then
begin
SetFillStyle (SolidFill, DarkGray);
SetColor (Red);
OutTextXY (10, 10, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
end;
end;

{****************************************************************************}
Procedure GetKeyStrokes;

begin
KeyStroke := UpCase (ReadKey);
if Position > 69 then
Case KeyStroke of
'Z' : begin
Inc (Tilt);
Inc (Moves);
if Tilt = 5 then Tilt := 1;
end;
'X' : begin
Dec (Tilt);
Inc (Moves);
if Tilt = 0 then Tilt := 4;
end;
#27 : Quitted := True
end;
end;

{****************************************************************************}
Procedure GrassFade;

begin
for Count := 0 to 59 do
for Count2 := 16 to 400 do
begin
Chance := (Count*100) div 120;
if Random (100) < Chance
then
RightColour := Green
else
RightColour := Black;
PutPixel (Count2, Count+101, RightColour);
end;
MoveTo (16, 160);
LineTo (240, 100);
LineTo (400, 160);
end;

{****************************************************************************}
Procedure HaveACrash;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (10, 10, White);
SetFillStyle (SolidFill, DarkGray);
SetColor (Green);
OutTextXY (10, 10, 'Oh dear, you have crashed the truck.');
OutTextXY (10, 40, 'Be more careful next time.');
SetColor (Yellow);
OutTextXY (10, 20, 'Oh dear, you have crashed the truck.');
OutTextXY (10, 50, 'Be more careful next time.');
SetColor (Red);
OutTextXY (10, 100, 'Press the space bar to get back on the road.');
OutTextXY (10, 110, 'Press the space bar to get back on the road.');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
if KeyStroke = #27 then Quitted := True;
Inc (Crashes);
Damage := 0;
TargetTime := (Time div 20) - 5;
ClearViewPort;
PutImage (12, 4, ScreenPointer^, CopyPut);
SetColor (Yellow);
OutTextXY (250, 175, 'Mind the sheep!');
OutTextXY (460, 155, 'Damage');
OutTextXY (460, 105, 'Time Remaining:');
SetColor (Green);
OutTextXY (64, 175, 'Mind the sheep!');
OutTextXY (460, 145, 'Damage');
OutTextXY (460, 95, 'Time Remaining:');
SetColor (White);
ReadySteadyGo;
end;

{****************************************************************************}
Procedure InitialiseGraphics;

begin
CheckBreak := False;
if RegisterBGIdriver (@EGAVGADriver) < 0 then Halt (0);
if RegisterBGIfont (@SANSfont) < 0 then Halt (0);
SetGraphicsMode;
SetActivePage (1);
SetVisualPage (2);
Frames;
SkyFade;
Mountains;
GrassFade;
FloodFills;
CaptureScreen;
SortCarSprite;
SortRockSprite;
SortLogo;
SortSlate;
SortChopper;
SetVisualPage (1);
end;

{****************************************************************************}
Procedure InitialiseHiScores;

begin
for Count := 1 to 10 do
begin
HiScoreName [Count] := 'Robert';
HiScore [Count] := 1600-(100*Count);
end;
end;

{****************************************************************************}
Procedure InputText;

begin
SetFillStyle (SolidFill, Black);
Bar (220, 110, 403, 117);
SetColor (Red);
OutTextXY (220, 110, '->');
OutTextXY (388, 110, '<-');
Output := '';
SetFillStyle (SolidFill, Black);
Repeat
Input := chr (0);
If KeyPressed then
begin
Input := ReadKey;
if ((Length (Output) < 17) or (Input = #8)) and (Input <> #13) then Output := Output + Input;
{Check for delete characters}
if (Input = #8) and (Length (Output) > 1) then
begin
Output2 := '';
Bar (244, 110, 244+Length (Output)*8, 117);
for Count := 1 to Length (Output) - 2 do
Output2 := Output2 + Output [Count];
Output := Output2;
end;
if (Input = #8) and (Length (Output) = 1) then Output := '';
Bar (244, 110, 244+Length (Output)*8, 117);
OutTextXY (244, 110, Output);
end;
Until Input = #13;
SetColor (White);
end;

{****************************************************************************}
Procedure IsItGood;

begin
Position := 11;
For Count := 10 downto 1 do
if Total > HiScore [Count] then
begin
HiScore [Count+1] := HiScore [Count];
HiScoreName [Count+1] := HiScoreName [Count];
Position := Count;
end;
if Position < 11 then AddName;
end;

{****************************************************************************}
Procedure Mountains;

begin
SetColor (White);
Line (16, 100, 400, 100);
MoveTo (16, 72);
LineTo (60, 60);
LineTo (72, 52);
LineTo (100, 46);
LineTo (120, 56);
LineTo (140, 70);
LineTo (170, 75);
LineTo (190, 78);
LineTo (200, 85);
LineTo (215, 100);
MoveTo (200, 85);
LineTo (230, 80);
LineTo (250, 70);
LineTo (270, 54);
LineTo (300, 40);
LineTo (330, 45);
LineTo (360, 53);
LineTo (380, 70);
LineTo (400, 60);
MoveTo (380, 70);
LineTo (360, 75);
LineTo (340, 80);
LineTo (320, 88);
LineTo (270, 100);
end;

{****************************************************************************}
Procedure ReadySteadyGo;

begin
SetColor (Red);
SetFillStyle (SolidFill, Black);
SetTextStyle (3, 0, 4);
OutTextXY (472, 10, 'Ready!');
OutTextXY (472, 40, 'Ready!');
for Wait := 1 to 500000 do begin end;
Bar (472, 10, 639, 90);
SetColor (Yellow);
OutTextXY (472, 10, 'Steady!');
OutTextXY (472, 40, 'Steady!');
for Wait := 1 to 500000 do begin end;
Bar (472, 10, 639, 90);
SetColor (Green);
OutTextXY (472, 10, 'Go!');
OutTextXY (472, 40, 'Go!');
SetTextStyle (0, 0, 1);
SetColor (White);
SetFillStyle (SolidFill, DarkGray);
end;

{****************************************************************************}
Procedure ReadySteadyGo2;

begin
SetColor (Red);
SetFillStyle (SolidFill, Black);
SetTextStyle (3, 0, 4);
Bar (400, 100, 504, 170);
OutTextXY (400, 100, 'Ready!');
OutTextXY (400, 130, 'Ready!');
for Wait := 1 to 500000 do begin end;
Bar (400, 100, 504, 170);
SetColor (Yellow);
OutTextXY (400, 100, 'Steady!');
OutTextXY (400, 130, 'Steady!');
for Wait := 1 to 500000 do begin end;
Bar (400, 100, 504, 170);
SetColor (Green);
OutTextXY (400, 100, 'Go!');
OutTextXY (400, 130, 'Go!');
SetTextStyle (0, 0, 1);
SetColor (White);
SetFillStyle (SolidFill, DarkGray);
end;

{****************************************************************************}
Procedure Rocks;

begin
if (Random (100) < 20) and (RockCount < 11) then AddARock;
for Count := 1 to 10 do
begin
if (RockVisible [Count]) and (RockDepth [Count] < 41) then
begin
Var1 := 220+(RockPosition [Count]*RockDepth [Count]) div 5;
Var2 := RockDepth [Count]+110;
Bar (Var1, Var2, Var1+20, Var2+8);
Inc (RockDepth [Count]);
Var1 := 220+(RockPosition [Count]*RockDepth [Count]) div 5;
Var2 := RockDepth [Count]+110;
PutImage (Var1, Var2, RockPointer^, CopyPut);
end;
if (RockDepth [Count] > 37) and RockVisible [Count] then
begin
Var1 := 220+(RockPosition [Count]*RockDepth [Count]) div 5;
if Abs (Var1-CarPosition) < 20 then
begin
Baa;
Inc (Damage);
if (Damage = 16) then HaveACrash;
Case Damage of
0..5 : SetFillStyle (SolidFill, Green);
6..10 : SetFillStyle (SolidFill, Yellow);
11..16 : SetFillStyle (SolidFill, Red);
end;
Bar (440, 160-Damage*4, 447, 158-Damage*4);
SetFillStyle (SolidFill, DarkGray);
RockVisible [Count] := False;
Dec (RockCount);
Bar (Var1, RockDepth [Count]+110, Var1+20, RockDepth [Count]+118);
end;
end;
if (RockDepth [Count] = 40) and RockVisible [Count] then
begin
RockVisible [Count] := False;
Dec (RockCount);
Var1 := 220+(RockPosition [Count]*RockDepth [Count]) div 5;
Bar (Var1, 150, Var1+20, 158);
end;
end;
end;

{****************************************************************************}
Procedure SetGraphicsMode;

begin
GraphDriver := EGA;
GraphMode := EGALo;
InitGraph (GraphDriver, GraphMode, '');
end;

{****************************************************************************}
Procedure SetUpVariables;

begin
CurrentRock := 1;
RockCount := 1;
for Count := 1 to 10 do
begin
RockVisible [Count] := False;
RockPosition [Count] := 0;
RockDepth [Count] := 0;
end;
CarPosition := 200;
OldPosition := 200;
Quitted := False;
Time := 1200;
Damage := 0;
LinePos := 1;
Moves := 0;
Finished := False;
KeyStroke := #0;
Crashes := 0;
TargetTime := 0;
end;

{****************************************************************************}
Procedure ShowHighScores;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (10, 10, White);
SetTextStyle (3, 0, 4);
OutTextXY (190, 4, 'High Score Table');
SetTextStyle (0, 0, 1);
for Count := 1 to 5 do
begin
if Odd (Count)
then
SetColor (Green)
else
SetColor (Yellow);
if (Count = Position) and OK then SetColor (Red);
Str (Count, Temp);
Temp := Temp+'. '+HiScoreName [Count];
OutTextXY (50, Count*10+40, Temp);
if Odd (Count)
then
SetColor (Green)
else
SetColor (Yellow);
if (Count+5 = Position) and OK then SetColor (Red);
Str (HiScore [Count+5], Temp);
OutTextXY (600-(Length (Temp)*8), Count*10+40, Temp);
if Odd (Count)
then
SetColor (Yellow)
else
SetColor (Green);
if (Count = Position) and OK then SetColor (Red);
Str (HiScore [Count], Temp);
OutTextXY (280-(Length (Temp)*8), Count*10+40, Temp);
if Odd (Count)
then
SetColor (Yellow)
else
SetColor (Green);
if (Count+5 = Position) and OK then SetColor (Red);
Str (Count+5, Temp);
Temp := Temp+'. '+HiScoreName [Count+5];
OutTextXY (370, Count*10+40, Temp);
end;
SetColor (Red);
OutTextXY (100, 115, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #32) or (KeyStroke = #27);
end;

{****************************************************************************}
Procedure SkyFade;

begin
for Count := 0 to 83 do
for Count2 := 16 to 400 do
begin
Chance := (Count*100) div 83;
if Random (100) < Chance
then
RightColour := Black
else
RightColour := Blue;
PutPixel (Count2, Count+8, RightColour);
end;
end;

{****************************************************************************}
Procedure SortCarSprite;

begin
for Count := 0 to 9 do
for Count2 := 0 to 31 do
PutPixel (Count2, Count, Car [Count, Count2]);
ScreenSize := ImageSize (0, 0, 31, 9);
GetMem (CarPointer, ScreenSize);
GetImage (0, 0, 31, 9, CarPointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure SortChopper;

begin
for Count := 0 to 14 do
for Count2 := 0 to 7 do
PutPixel (Count2, Count, Chopper [Count, Count2]);
ScreenSize := ImageSize (0, 0, 7, 14);
GetMem (ChopperPointer, ScreenSize);
GetImage (0, 0, 7, 14, ChopperPointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure SortLogo;

begin
BaseX := 100; BaseY := 150;
SetColor (White);
MoveTo (BaseX, BaseY);
LineTo (BaseX+280, BaseY);
LineTo (BaseX+280, BaseY-55);
LineTo (BaseX+210, BaseY);
LineTo (BaseX+140, BaseY-55);
LineTo (BaseX+140, BaseY);
LineTo (BaseX+70, BaseY-55);
LineTo (BaseX, BaseY);
MoveTo (BaseX+70, BaseY-55);
LineTo (BaseX+130, BaseY-50);
LineTo (BaseX+140, BaseY-43);
MoveTo (BaseX+140, BaseY-55);
LineTo (BaseX+220, BaseY-50);
LineTo (BaseX+247, BaseY-28);
MoveTo (BaseX+280, BaseY-55);
LineTo (BaseX+360, BaseY-50);
LineTo (BaseX+360, BaseY);
LineTo (BaseX+280, BaseY);
SetFillStyle (SolidFill, Yellow);
FloodFill (BaseX+60, BaseY-10, White);
SetFillStyle (9, Yellow);
FloodFill (BaseX+80, BaseY-50, White);
SetFillStyle (SolidFill, Green);
FloodFill (BaseX+150, BaseY-10, White);
FloodFill (BaseX+270, BaseY-10, White);
SetFillStyle (9, Green);
FloodFill (BaseX+300, BaseY-10, White);
FloodFill (BaseX+210, BaseY-20, White);
SetFillStyle (SolidFill, DarkGray);
ScreenSize := ImageSize (BaseX, BaseY-55, BaseX+360, BaseY);
GetMem (LogoPointer, ScreenSize);
GetImage (BaseX, BaseY-55, BaseX+360, BaseY, LogoPointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure SortRockSprite;

begin
for Count := 0 to 7 do
for Count2 := 0 to 19 do
PutPixel (Count2, Count, Rock [Count, Count2]);
ScreenSize := ImageSize (0, 0, 19, 7);
GetMem (RockPointer, ScreenSize);
GetImage (0, 0, 19, 7, RockPointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure SortSlate;

begin
for Count := 0 to 499 do
for Count2 := 0 to 69 do
if Odd (Count) and Odd (Count2)
then
PutPixel (Count, Count2, Blue)
else
PutPixel (Count, Count2, DarkGray);
ScreenSize := ImageSize (0, 0, 499, 69);
GetMem (SlatePointer, ScreenSize);
GetImage (0, 0, 499, 69, SlatePointer^);
ClearViewPort;
end;

{****************************************************************************}
Procedure Stage1;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetTextStyle (3, 0, 4);
OutTextXY (10, 4, 'Stage 1 - Stage 1');
Line (10, 36, 56, 36);
Line (75, 36, 120, 36);
Line (490, 0, 490, 80);
Line (490, 80, 639, 80);
SetTextStyle (0, 0, 1);
SetColor (Green);
OutTextXY (10, 50, 'Drive the dump truck back from the quarry.');
OutTextXY (10, 70, 'Be careful, there''s 40 tonnes of slate on the back.');
OutTextXY (10, 90, 'And by the way, mind the sheep!');
OutTextXY (534, 30, 'Left');
OutTextXY (534, 50, 'Right');
SetColor (Yellow);
OutTextXY (10, 60, 'Drive the dump truck back from the quarry.');
OutTextXY (10, 80, 'Be careful, there''s 40 tonnes of slate on the back.');
OutTextXY (10, 100, 'And by the way, mind the sheep!');
OutTextXY (534, 40, 'Left');
OutTextXY (534, 60, 'Right');
SetColor (White);
OutTextXY (502, 30, 'Z -');
OutTextXY (502, 50, 'X -');
SetColor (Red);
OutTextXY (10, 115, 'Press the space bar to continue - Press the space bar to continue');
SetColor (Cyan);
OutTextXY (502, 10, 'Keys / Keys');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #32) or (KeyStroke = #27);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure Stage2;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetTextStyle (3, 0, 4);
OutTextXY (10, 4, 'Stage 2');
Line (10, 36, 56, 36);
Line (76, 36, 124, 36);
SetTextStyle (0, 0, 1);
SetColor (Green);
OutTextXY (10, 50, 'The blocks of slate are now at the sawing shed. Each block has a bad');
OutTextXY (10, 70, 'edge, which must be cut off. As the blocks move up the screen, rotate');
OutTextXY (10, 90, 'them with ''Z'' and ''X'' so that the bad edge is cut off.');
SetColor (Yellow);
OutTextXY (10, 60, 'The blocks of slate are now at the sawing shed. Each block has a bad');
OutTextXY (10, 80, 'edge, which must be cut off. As the blocks move up the screen, rotate');
OutTextXY (10, 100, 'them with ''Z'' and ''X'' so that the bad edge is cut off.');
SetColor (Red);
OutTextXY (10, 115, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #32) or (KeyStroke = #27);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure Stage3;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetTextStyle (3, 0, 4);
OutTextXY (10, 4, 'Stage 3');
Line (10, 36, 56, 36);
Line (75, 36, 120, 36);
SetTextStyle (0, 0, 1);
SetColor (Green);
OutTextXY (10, 50, 'The slate has been sawn into square blocks. You must now split it into');
OutTextXY (10, 80, 'individual slates. Tap ''Z'' when the chisel is above the lines. ');
SetColor (Yellow);
OutTextXY (10, 60, 'The slate has been sawn into square blocks. You must now split it into');
OutTextXY (10, 90, 'individual slates. Tap ''Z'' when the chisel is above the lines. ');
SetColor (Red);
OutTextXY (10, 110, 'Press the space bar to continue - Press the space bar to continue');
SetColor (White);
Repeat
KeyStroke := ReadKey;
Until (KeyStroke = #27) or (KeyStroke = #32);
if KeyStroke = #27 then Quitted := True;
end;

{****************************************************************************}
Procedure TitleScreen;

begin
ClearViewPort;
Rectangle (0, 0, 639, 199);
PutImage (140, 130, LogoPointer^, CopyPut);
SetFillStyle (9, Blue);
FloodFill (1, 1, White);
SetTextStyle (3, 0, 4);
OutTextXY (32, 32, 'The Quarry Game - The Quarry Game');
SetTextStyle (0, 0, 1);
SetColor (Green);
OutTextXY (40, 105, 'Press the space bar to continue');
SetColor (Yellow);
OutTextXY (350, 105, 'Press the space bar to continue');
SetColor (White);
OutTextXY (241, 190, 'Robert Summerwill ''92');
Escape := 0;
Password := 'STARFISHANDCOFFEE';
Repeat
KeyStroke := UpCase (ReadKey);
if (KeyStroke = PassWord [Escape+1]) then Inc (Escape);
if Escape = 17 then
begin
CloseGraph;
Halt (0);
end;
Until KeyStroke = #32;
end;

{******************************* Main Program *******************************}

begin
Randomize;
InitialiseGraphics;
InitialiseHiScores;
Repeat
TitleScreen;
SetUpVariables;
{Level 1}
Stage1;
if Quitted = False then
begin
DisplayScreen;
ReadySteadyGo;
Game1;
end;
if Finished then FinishedStage1;
{Level 2}
if Quitted = False then Stage2;
if Quitted = False then
begin
DrawLevel2;
ReadySteadyGo2;
Game2;
end;
if Quitted = False then FinishedStage2;
{Level 3}
if Quitted = False then Stage3;
if Quitted = False then Game3;
if Quitted = False then FinishedStage3;
{High Score Table}
if Quitted = False then
begin
IsItGood;
ShowHighScores;
end;
Until False;
end.