Category : A Collection of Games for DOS and Windows
Archive   : AMAZE.ZIP
Filename : MAZE.PAS

 
Output of file : MAZE.PAS contained in archive : AMAZE.ZIP
Program Discover_Maze;

Uses
CRT;

Const
maze : array [1..8,1..8] of Integer =
((4,2,2,4,4,3,4,3),
(3,5,3,4,2,3,5,2),
(4,3,2,5,2,2,5,2),
(7,1,4,4,4,2,2,3),
(3,2,2,4,2,5,2,5),
(2,3,2,4,4,2,5,1),
(6,2,2,3,2,5,6,3),
(1,2,5,4,4,2,1,0));
mask : array [1..8,1..8] of Integer =
((0,0,1,0,0,1,0,1),
(0,0,0,0,0,0,0,1),
(0,0,0,1,0,0,0,0),
(0,0,0,0,0,0,0,0),
(1,0,0,0,0,0,0,0),
(0,1,0,0,0,0,0,1),
(0,0,0,1,0,0,0,0),
(0,1,0,0,0,0,1,0));


Var
MMask,OkayToGo,Go,GoNum,AtY,AtX,Dir,X,Y,NumMoves : Integer;

Procedure Exit_Out;
Begin
TextBackGround(0);
TextColor(7);
ClrScr;
Halt;
End;

Procedure DrawMaze;
Begin
TextBackGround(0);
ClrScr;
TextBackground(4);
for X := 5 to 23 do
begin
GoToXY(29,X);
Write(' ');
end;
TextBackGround(1);
for X := 6 to 22 do
begin
GoToXY(30,X);
Write(' ');
end;
for Y := 1 to 8 do
for X := 1 to 8 do
begin
GoToXY(3*Y+28,2*X+5);
if (mask[X,Y] = 1) then TextColor(12) else TextColor(2);
if (maze[X,Y] = 0) then Write('X') else Write(maze[X,Y]);
end;
End;

Procedure AtPos(AAtY,AAtX : Integer);
Var AcX,AcY : Integer;
Begin
TextBackGround(3);
AcY := 3*AAtX+28;
AcX := 2*AAtY+5;
GoToXY(AcY-1,AcX-1);
Write(' ');

GoToXY(AcY-1,AcX+1);
Write(' ');
GoToXY(AcY-1,AcX);
Write(' ');
GoToXY(AcY+1,AcX);
Write(' ');
GoToXY(1,1);
End;

Procedure NoAtPos(AAtY,AAtX : Integer);
Var AcX,AcY : Integer;
Begin
TextBackGround(1);
AcY := 3*AAtX+28;
AcX := 2*AAtY+5;
GoToXY(AcY-1,AcX-1);
Write(' ');
GoToXY(AcY-1,AcX+1);
Write(' ');
GoToXY(AcY-1,AcX);
Write(' ');
GoToXY(AcY+1,AcX);
Write(' ');
GoToXY(1,1);
End;

Function GetDir : Integer;
Var
XX,YY : Char;
GDir : Integer;
Begin
GDir := 0;
repeat
repeat
XX := ReadKey;
YY := #0;
If XX = #27 then Exit_Out;
if ((XX>char(48)) and (XX begin
YY := XX;
XX := #0;
end;
until ((XX = #0));
if (YY=#0) then YY := ReadKey;
case YY of
char(71): {Home}
GDir := 5;
char(55):
GDir := 5;
char(72): {Up}
GDir := 1;
char(56):
GDir := 1;
char(73): {PgUp}
GDir := 6;
char(57):
GDir := 6;
char(75): {Left}
GDir := 4;
char(52):
GDir := 4;
char(77): {Right}
GDir := 2;
char(54):
GDir := 2;
char(79): {End}
GDir := 8;
char(49):
GDir := 8;
char(80): {Down}
GDir := 3;
char(50):
GDir := 3;
char(81): {PgDn}
GDir := 7;
char(51):
GDir := 7;
end;
until (GDir>0);
GetDir := GDir;
end;
Function OkayDir : Integer;
Begin
OkayToGo:=0;
if ((Dir=0) and ((Go>0) and (Go<5))) then OkayToGo:=1;
if ((Dir=1) and ((Go>4) and (Go<9))) then OkayToGo:=1;
OkayDir := OkayToGo;
End;

Begin
TextMode(3);
AtY := 1;
AtX := 1;
Dir := 0;
NumMoves := 0;
DrawMaze;
AtPos(AtY,AtX);
While (not ((AtY = 8) and (AtX = 8))) do
begin
Go := GetDir;
If (OkayDir=1) then
begin
GoNum := Maze[AtY,AtX];
y := 0;
Case Go of
1:
If (AtY-GoNum)>0 then y:=1;
2:
If (AtX+GoNum)<9 then y:=1;
3:
If (AtY+GoNum)<9 then y:=1;
4:
If (AtX-Gonum)>0 then y:=1;
5:
If ((AtX-Gonum)>0) and ((AtY-GoNum)>0) then y:=1;
6:
If ((AtX+GoNum)<9) and ((AtY-GoNum)>0) then y:=1;
7:
If ((AtX+GoNum)<9) and ((AtY+GoNum)<9) then y:=1;
8:
If ((AtX-GoNum)>0) and ((AtY+GoNum)<9) then y:=1;
end;

if y=1 then
begin
NoAtPos(AtY,AtX);
Case Go of
1:
AtY := AtY-GoNum;
2:
AtX := AtX+GoNum;
3:
AtY := AtY+GoNum;
4:
AtX := AtX-GoNum;
5:
begin
AtX := AtX-GoNum;
AtY := AtY-GoNum;
end;
6:
begin
AtX := AtX+GoNum;
AtY := AtY-GoNum;
end;
7:
begin
AtX := AtX+GoNum;
AtY := AtY+GoNum;
end;
8:
begin
AtX := AtX-GoNum;
AtY := AtY+GoNum;
end;
end;
AtPos(AtY,AtX);
NumMoves := NumMoves +1;
MMask := Mask[AtY,AtX];
If (MMask = 1) then Dir:=1-Dir;
end;
end;
end;
TextBackGround(0);
TextColor(7);
GoToXY(1,23);
WriteLn('You Won in ',NumMoves,' Moves!!!');
End.

  3 Responses to “Category : A Collection of Games for DOS and Windows
Archive   : AMAZE.ZIP
Filename : MAZE.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/