program Face_Race (input,output);
uses crt,windos,graph;
const
MONEY=1000000.00;
FACE1='1. Spanky ';
FACE2='2. Mr. Horse ';
FACE3='3. Casey ';
FACE4='4. Adam ';
FACE5='5. Mr. Ed ';
FACE6='6. Wild Thing ';
FACE7='7. Big ''Un ';
PAYWIN=8;
PAYPLACE=4;
PAYSHOW=2;
var
win,
place,
show,
face,
how:integer;
bet,
winnings:real;
quit:char;
(**************************************************************************)
(* Procedure to display initial screen for the program. *)
procedure Initial_Screen;
var
graphmode,
graphdriver:integer;
continue:char;
begin {procedure Initial_Screen}
clrscr;
graphdriver:=detect;
initgraph(graphdriver,graphmode,'d:\tp\bgi');
if graphresult=grok then
setbkcolor(green);
setcolor(blue);
settextstyle(4,0,10);
outtextxy(65,100, 'Face Race');
settextstyle(7,0,2);
setcolor(red);
outtextxy(60,350, 'Another fine product from Kirksville, Kentucky!');
outtextxy(260,400, '(c) 1995');
continue:=readkey;
closegraph;
end; {procedure Initial_Screen}
(**************************************************************************)
(* Procedure to hide the cursor. *)
procedure hidecursor;assembler;
asm {begin assembler routine}
mov ax,$0100
mov cx,$2607
int $10
end; {assembler routine}
(**************************************************************************)
(* Procedure to show cursor. *)
procedure showcursor;assembler;
asm {begin assembler routine}
mov ax,$0100
mov cx,$0506
int $10
end; {assembler routine}
(**************************************************************************)
(* Procedure to pick a face. *)
procedure Pick_Face (var face,how:integer;var bet,winnings:real);
var
choice:char;
error:integer;
amount:string[8];
begin {procedure Pick_Face}
clrscr;
textcolor(9);
writeln (' Pick A Face ');
writeln (' ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ');
writeln (' Ý Þ');
write (' Ý');
write (' ',FACE1);
writeln (' Þ');
write (' Ý');
textcolor(10);
write (' ',FACE2);
textcolor(9);
writeln (' Þ');
write (' Ý');
textcolor(11);
write (' ',FACE3);
textcolor(9);
writeln (' Þ');
write (' Ý');
textcolor(12);
write (' ',FACE4);
textcolor(9);
writeln (' Þ');
write (' Ý');
textcolor(13);
write (' ',FACE5);
textcolor(9);
writeln (' Þ');
write (' Ý');
textcolor(14);
write (' ',FACE6);
textcolor(9);
writeln (' Þ');
write (' Ý');
textcolor(15);
write (' ',FACE7);
textcolor(9);
writeln (' Þ');
writeln (' Ý Þ');
writeln (' ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß');
writeln;
write (' Enter your choice ... ');
error:=1;
while (error <> 0) or (face < 1) or (face > 7) do
begin {while loop}
choice:=readkey;
Val (choice,face,error);
if (error <> 0) or (face < 1) or (face > 7) then
begin {if statement}
writeln;
writeln('Invalid Entry! Please reenter.');
end; {if statement}
end; {while loop}
clrscr;
writeln(' ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ');
writeln(' Ý Þ');
writeln(' Ý 1. Bet on WIN. Þ');
writeln(' Ý 2. Bet on PLACE. Þ');
writeln(' Ý 3. Bet on SHOW. Þ');
writeln(' Ý Þ');
writeln(' ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß');
writeln;
write(' Please enter your choice...');
error:=1;
while (error <> 0) or (how < 1) or (how > 3) do
begin {while loop}
choice:=readkey;
Val (choice,how,error);
if (error <> 0) or (how < 1) or (how > 3) then
begin {if statement}
writeln;
writeln('Invalid choice! Please reenter.');
end; {if statement}
end; {while loop}
writeln;
writeln ('Your bank roll is currently $',winnings:3:2,'!');
writeln;
writeln('Minimum bet is $2.00. Maximum bet $',winnings:3:2,'.');
error:=1;
while (error <> 0) or (bet < 2) or (bet > winnings) do
begin {while loop}
write('Enter in the amount you want to bet ... $');
readln (amount);
Val (amount,bet,error);
if (error <> 0) or (bet < 2) or (bet > winnings) then
begin {if statement}
writeln;
writeln('Invalid bet! Please reenter.');
end; {if statement}
end;
winnings:=winnings - bet;
end; {procedure Pick_Face}
(**************************************************************************)
(* Procedure to run the race. *)
procedure Race (var win,place,show:integer);
var
move,
row8,
col8,
row10,
col10,
row12,
col12,
row14,
col14,
row16,
col16,
row18,
col18,
row20,
col20,
winner,
count1,
clear:integer;
continue,
clearline:char;
done:boolean;
begin {procedure Race}
textbackground (0);
textcolor (15);
clrscr;
row8:=8;
row10:=10;
row12:=12;
row14:=14;
row16:=16;
row18:=18;
row20:=20;
col8:=10;
col10:=10;
col12:=10;
col14:=10;
col16:=10;
col18:=10;
col20:=10;
clearline:=' ';
win:=0;
place:=0;
show:=0;
Randomize;
gotoxy (col8,row8);
textcolor(9);
write ('');
gotoxy (col10,row10);
textcolor(10);
write ('');
gotoxy (col12,row12);
textcolor(11);
write ('');
gotoxy (col14,row14);
textcolor(12);
write ('');
gotoxy (col16,row16);
textcolor(13);
write ('');
gotoxy (col18,row18);
textcolor(14);
write ('');
gotoxy (col20,row20);
textcolor(15);
write ('');
textcolor(red);
gotoxy(70,1);
writeln('F');
gotoxy(70,2);
writeln('I');
gotoxy(70,3);
writeln('N');
gotoxy(70,4);
writeln('I');
gotoxy(70,5);
writeln('S');
gotoxy(70,6);
writeln('H');
gotoxy(70,7);
writeln('Ý');
gotoxy(70,8);
writeln('Ý');
gotoxy(70,9);
writeln('Ý');
gotoxy(70,10);
writeln('Ý');
gotoxy(70,11);
writeln('Ý');
gotoxy(70,12);
writeln('Ý');
gotoxy(70,13);
writeln('Ý');
gotoxy(70,14);
writeln('Ý');
gotoxy(70,15);
writeln('Ý');
gotoxy(70,16);
writeln('Ý');
gotoxy(70,17);
writeln('Ý');
gotoxy(70,18);
writeln('Ý');
gotoxy(70,19);
writeln('Ý');
gotoxy(70,20);
writeln('Ý');
gotoxy(70,21);
writeln('L');
gotoxy(70,22);
writeln('I');
gotoxy(70,23);
writeln('N');
gotoxy(70,24);
writeln('E');
gotoxy(1,8);
textcolor(9);
write('1.');
gotoxy(1,10);
textcolor(10);
write('2.');
gotoxy(1,12);
textcolor(11);
write('3.');
gotoxy(1,14);
textcolor(12);
write('4.');
gotoxy(1,16);
textcolor(13);
write('5.');
gotoxy(1,18);
textcolor(14);
write('6.');
gotoxy(1,20);
textcolor(15);
write('7.');
done:=false;
hidecursor;
done:=false;
while not done do
begin {while loop}
gotoxy (10,22);
winner:=Random (7) + 1;
move:=Random (3) + 1;
case winner of
1:if col8 < 70 then
begin {if statement}
textcolor(9);
for count1:=col8 to col8 + move do
begin {for loop}
gotoxy (1,row8);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row8);
write (clearline);
end; {for loop}
gotoxy (count1,row8);
write ('');
delay (100);
end; {for loop}
col8:=count1;
if col8 >= 70 then
begin {if statement}
if win = 0 then
win:=1
else if place = 0 then
place:=1
else if show = 0 then
show:=1;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
2:if col10 < 70 then
begin {if statement}
textcolor(10);
for count1:=col10 to col10 + move do
begin {for loop}
gotoxy (1,row10);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row10);
write (clearline);
end; {for loop}
gotoxy (count1,row10);
write ('');
delay (100);
end; {for loop}
col10:=count1;
if col10 >= 70 then
begin {if statement}
if win = 0 then
win:=2
else if place = 0 then
place:=2
else if show = 0 then
show:=2;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
3:if col12 < 70 then
begin {if statement}
textcolor(11);
for count1:=col12 to col12 + move do
begin {for loop}
gotoxy (1,row12);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row12);
write (clearline);
end; {for loop}
gotoxy (count1,row12);
write ('');
delay (100);
end; {for loop}
col12:=count1;
if col12 >= 70 then
begin {if statement}
if win = 0 then
win:=3
else if place = 0 then
place:=3
else if show = 0 then
show:=3;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
4:if col14 < 70 then
begin {if statement}
textcolor(12);
for count1:=col14 to col14 + move do
begin {for loop}
gotoxy (1,row14);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row14);
write (clearline);
end; {for loop}
gotoxy (count1,row14);
write ('');
delay (100);
end; {for loop}
col14:=count1;
if col14 >= 70 then
begin {if statement}
if win = 0 then
win:=4
else if place = 0 then
place:=4
else if show = 0 then
show:=4;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
5:if col16 < 70 then
begin {if statement}
textcolor(13);
for count1:=col16 to col16 + move do
begin {for loop}
gotoxy (1,row16);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row16);
write (clearline);
end; {for loop}
gotoxy (count1,row16);
write ('');
delay (100);
end; {for loop}
col16:=count1;
if col16 >= 70 then
begin {if statement}
if win = 0 then
win:=5
else if place = 0 then
place:=5
else if show = 0 then
show:=5;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
6:if col18 < 70 then
begin {if statement}
textcolor(14);
for count1:=col18 to col18 + move do
begin {for loop}
gotoxy (1,row18);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row18);
write (clearline);
end; {for loop}
gotoxy (count1,row18);
write ('');
delay (100);
end; {for loop}
col18:=count1;
if col18 >= 70 then
begin {if statement}
if win = 0 then
win:=6
else if place = 0 then
place:=6
else if show = 0 then
show:=6;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
7:if col20 < 70 then
begin {if statement}
textcolor(15);
for count1:=col20 to col20 + move do
begin {for loop}
gotoxy (1,row20);
for clear:=1 to 2 do
begin {for loop}
gotoxy (count1-1,row20);
write (clearline);
end; {for loop}
gotoxy (count1,row20);
write ('');
delay (100);
end; {for loop}
col20:=count1;
if col20 >= 70 then
begin {if statement}
if win = 0 then
win:=7
else if place = 0 then
place:=7
else if show = 0 then
show:=7;
if (win > 0) and (place > 0)
and (show > 0) then
done:=true;
end; {if statement}
end; {if statement}
end; {case statement}
end; {while loop}
gotoxy (20,23);
writeln ('Press any key to continue ... ');
continue:=readkey;
NormVideo;
end; {procedure Race}
(**************************************************************************)
(* Function to determine text color for displaying results. *)
function Which_Color (number:integer):integer;
begin {function Which_Color}
case number of
1:Which_Color:=9;
2:Which_Color:=10;
3:Which_Color:=11;
4:Which_Color:=12;
5:Which_Color:=13;
6:Which_Color:=14;
7:Which_Color:=15;
end; {case statement}
end; {function Which_Color}
(**************************************************************************)
(* Procedure to display win, place, or show face. *)
procedure Position_Face (number:integer);
begin {procedure Position_Face}
case number of
1:writeln (FACE1);
2:writeln (FACE2);
3:writeln (FACE3);
4:writeln (FACE4);
5:writeln (FACE5);
6:writeln (FACE6);
7:writeln (FACE7);
end; {case statement}
end; {procedure Position_Face}
(**************************************************************************)
(* Procedure to display results of the race. *)
procedure Results (win,place,show,face,how:integer;
bet:real;var winnings:real);
var
amount:real;
begin {procedure Results}
amount:=0;
if win = face then
begin {if statement}
if how = 1 then
amount:=bet + bet * PAYWIN
else if how = 2 then
amount:=bet + bet * PAYPLACE
else if how = 3 then
amount:=bet + bet * PAYSHOW;
end {if statement}
else if place = face then
begin {else if statement}
if how = 2 then
amount:=bet + bet * PAYPLACE
else if how = 3 then
amount:=bet + bet * PAYSHOW;
end {else if statement}
else if (show = face) and (how = 3) then
amount:=bet + bet * PAYSHOW;
winnings:=winnings + amount;
clrscr;
textcolor(red);
writeln ('Here are the race results ... ');
writeln;
write ('The win face is # ');
textcolor (Which_Color (win));
Position_Face (win);
textcolor(red);
write ('The place face is # ');
textcolor (Which_Color (place));
Position_Face (place);
textcolor(red);
write ('The show face is # ');
textcolor (Which_Color (show));
Position_Face (show);
writeln;writeln;writeln;writeln;
textcolor(green);
writeln ('You won $',amount:3:2,' on this race!');
writeln;
writeln ('You now have a bank roll of $',winnings:3:2,' to bet!');
writeln;writeln;
textcolor(yellow);
writeln ('Press esc to quit, any other key to continue ... ');
end; {procedure Results}
(**************************************************************************)
(* Main program *)
begin {main program}
Initial_Screen;
winnings:=MONEY;
quit:=' ';
while (quit <> #27) and (winnings <> 0) do
begin {while loop}
Pick_Face (face,how,bet,winnings);
Race (win,place,show);
Results (win,place,show,face,how,bet,winnings);
quit:=readkey;
end; {while loop}
end. {main program}