home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug017.arc
/
STARSHOT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
6KB
|
260 lines
Program StarShot(Input,Output);
{Writen by Peter Billing 14 - 6 - 1985}
Const
on = '*';
off = 'o';
Var
board : array[1..3,1..5] of char;
i,j : integer;
quit : boolean;
move : integer;
Procedure Initialize;
begin
move :=0;
for i := 1 to 3 do
for j := 1 to 5 do
board[i,j] := off;
board[2,3] := on;
for i := 1 to 3 do
begin
board[i,2] := ' ';
board[i,4] := ' ';
end;
gotoxy(20,16); writeln('1 2 3');
gotoxy(20,17); writeln('4 5 6');
gotoxy(20,18); writeln('7 8 9');
gotoxy(34,14);
writeln(' ');
gotoxy(25,23);
writeln(' ');
end;
Procedure Instruction;
begin
gotoxy(1,1);
writeln('S T A R S H O O T':48);
writeln;
writeln('You may only shoot at stars that are turned on. eg "on" The star will turn off');
writeln('eg "o", and depending on its position will turn on stars adjacent to itself.');
writeln('The object of the game is to reverse the initial pattern.');
writeln;
writeln(' INITIAL FINAL');
writeln(' o o o * * *');
writeln(' o * o * o *');
writeln(' o o o * * *');
writeln;
writeln(' Best possible score is 11 moves. Enter 0 to start again, Q to Quit.');
writeln(' Press D for a DEMONSTRATION in 11 moves.');
end;
Procedure Display;
var
y,i,j : integer;
begin
gotoxy(30,15); write('Move >',move:2);
y := 15;
for i := 1 to 3 do
begin
writeln;
gotoxy(38,y+i);
for j := 1 to 5 do
write(board[i,j]);
end;
end;
Procedure Horizontal(x : integer);
var
y : integer;
begin
y := 1;
repeat
if board[x,y] =on
then board[x,y] := off
else board[x,y] := on;
y := y + 2;
until y = 7;
move := move +1;
end;
Procedure Vertical(y : integer);
var
x : integer;
begin
for x := 1 to 3 do
if board[x,y] =on
then board[x,y] := off
else board[x,y] := on;
move := move +1;
end;
Procedure Center;
begin
horizontal(2);
if board[1,3] =on
then board[1,3] := off
else board[1,3] := on;
if board[3,3] =on
then board[3,3] := off
else board[3,3] := on;
end;
Procedure Corner(x,y : integer);
var
temp : integer;
begin
temp := y;
for i := x to x+1 do
begin
y := temp;
repeat
if board[i,y] =on
then board[i,y] := off
else board[i,y] := on;
y := y+2;
until temp+4 = y;
end;
move := move +1;
end;
Function Check(x,y :integer) :boolean;
begin
if board[x,y] = on
then check := true
else check := false;
end;
Function Win :boolean;
var
z,x,y :integer;
begin
z := 0;
x := 1;
repeat
y := 1;
repeat
if board[x,y] = off
then z := 1;
y := y+2;
until y=7;
x := x+2
until x = 5;
if board[2,1] = off
then z := 1;
if board[2,5] = off
then z := 1;
if board[2,3] = on
then z := 1;
if z=1
then win := false
else win := true;
end;
Procedure p;
begin
delay (1000)
end;
Procedure Demo;
begin
center; display;p;
horizontal(3);display;p;
corner(2,1); display;p;
corner(2,3); display;p;
horizontal(1);display;p;
corner(1,1); display;p;
center; display;p;
corner(1,3); display;p;
horizontal(1);display;p;
horizontal(3);display;p;
center; display;p;
end;
Procedure Command;
var
x,y,k : integer;
ch : char;
begin
gotoxy(25,22);
write('Command > ');
read(kbd,ch);
write(ch);
case ch of
'5' :
if check(2,3)
then center;
'4' :
if check(2,1)
then vertical(1);
'6' :
if check(2,5)
then vertical(5);
'2' :
if check(1,3)
then horizontal(1);
'8' :
if check(3,3)
then horizontal(3);
'1' :
if check(1,1)
then corner(1,1);
'3' :
if check(1,5)
then corner(1,3);
'7' :
if check(3,1)
then corner(2,1);
'9' :
if check(3,5)
then corner(2,3);
'0' :
Initialize;
'd','D' :
if move < 1
then demo;
'q','Q' :
quit := true;
else command
end;
display;
if win
then
begin
gotoxy(34,14);
writeln('You have won!!!');
gotoxy(25,23);
writeln('Do you wish to try again? Y/N ');
gotoxy(25,22);write('Command > ');
repeat
read(kbd,ch);
until upcase(ch) in ['Y','N'];
if upcase(ch) = 'Y'
then
begin
quit := false;
initialize;
display
end
else
begin
quit := true;
clrscr
end
end;
if (ch ='D') or (ch ='d') then quit := false;
end;
begin
ClrScr;
Initialize;
Instruction;
Display;
Quit := false;
Repeat
Command;
Until quit;
end.