Program Maze; { version 2.0 by Dave Cote }
{
Procedure & Function list
Introduction
Open_File Open a new maze input file.
Display_Maze Decode input maze into line drawing chars & display.
Rb_kbd.inc Get a key from user
Check_Move Check move validity: hitting a wall?
Move_It Move the piece from old to new location.
Move_Piece Decode movement commands.
}
{$I RB_KBD.INC} { Deciphers single keystroke inputs }
Const
Beep = #7; { Ring the bell Homer! }
ESC = #27;
M_Width = 80; { Maze width in character positions }
{ Must be an even number }
M_Depth = 24; { Maze depth in lines }
Namlgt = 255; { Max char length of a file name }
ShiftOut = 14; { ^N to invoke char set G1 }
ShiftIn = 15; { ^O to invoke char set G0 }
Type
Filename = String[Namlgt];
MazeLine = String[M_Width];
Var
Bumps : Integer; { Keep track of times bumped into wall}
Endx : Integer; { Ending column position }
Endy : Integer; { Ending line position }
Hor_Flip : Boolean; { Flip maze mirror image style }
In_Line : MazeLine;
Maze : Array[0..M_Depth] of MazeLine;
Maze_File : Filename; { input file contianing maze }
Maze_Lun : Text; { Maze file handle }
Maze_Num : Char; { Actually the letter designation }
Moves : Integer; { Keep track of number of moves }
NoMaze : Boolean; { Controls drawing of maze on screen }
OK : Boolean;
Py : Integer; { Current player line position }
Px : Integer; { Current player col position }
Vert_Flip : Boolean; { Flip maze upside down }
{*****************************************************************************}
Procedure Introduction;
{*****************************************************************************}
var Ch : char; { Character Pressed }
var F_Key : F_Key_Type; { Function Key Value }
var Ctrl_Key, {\ }
Shift_Key, { > True If On }
Lock_Key : boolean; {/ }
Begin
Writeln( ESC, '[2J', ESC,'[1;1H' );
Writeln( ESC, '#6 Welcome to Maze ver. 2, by Dave Cote' );
Writeln;
Writeln;
Writeln(' A Maze1a M Maze4a' );
Writeln(' B Maze1b N Maze4b' );
Writeln(' C Maze1c O Maze4c' );
Writeln(' D Maze1d P Maze4d' );
Writeln(' E Maze2a Q Maze5a' );
Writeln(' F Maze2b R Maze5b' );
Writeln(' G Maze2c S Maze5c' );
Writeln(' H Maze2d T Maze5d' );
Writeln(' I Maze3a U Maze6a' );
Writeln(' J Maze3b V Maze6b' );
Writeln(' K Maze3c W Maze6c' );
Writeln(' L Maze3d X Maze6d' );
Writeln;
Write(' Select a Maze, (A through X): ' );
RB_Kbd (Ch, F_Key, Ctrl_Key, Shift_Key, Lock_Key);
Maze_File := 'Maze1.maz';
Vert_Flip := False;
Hor_Flip := False;
If (Ch >= 'a') and (Ch <= 'z') Then Ch := chr( ord(Ch) - 32); { upcase }
Maze_Num := Ch;
If ((Ch >= 'E') and (Ch <= 'H')) Then Maze_File := 'Maze2.maz';
If ((Ch >= 'I') and (Ch <= 'L')) Then Maze_File := 'Maze3.maz';
If ((Ch >= 'M') and (Ch <= 'P')) Then Maze_File := 'Maze4.maz';
If ((Ch >= 'Q') and (Ch <= 'T')) Then Maze_File := 'Maze5.maz';
If ((Ch >= 'U') and (Ch <= 'X')) Then Maze_File := 'Maze6.maz';
Case ((ord(Ch) - ord('A')) mod 4) of
1: Vert_Flip := True;
2: Hor_Flip := True;
3: Begin
Vert_Flip := True;
Hor_Flip := True;
End;
End;
Writeln;
Write(' Do you want to play without drawing the maze (Y/N)? ');
RB_Kbd (Ch, F_Key, Ctrl_Key, Shift_Key, Lock_Key);
If (Ch = 'Y') or (Ch = 'y') Then NoMaze := True;
End; { of Proc. Introduction }
{*****************************************************************************}
Function Open_File( Filenm:Filename; Var File_Lun:Text ):Boolean;
{*****************************************************************************}
{ Generic input-file open/check routine. Given a filename in string 'Filenm'
try to open it, report failure if any, return logical name in 'File_Lun'.}
Var OK : Integer;
Begin
ASSIGN ( File_Lun, Filenm );
{$I-}
RESET ( File_Lun );
{$I+};
OK := IORESULT;
IF (OK = 0)
Then Open_File := True
Else
BEGIN
Open_File := False;
Write('The input data file ',Filenm );
Writeln(' could not be opened. IORESULT=',OK);
END;
End; { of Open_File Func. }
{*****************************************************************************}
Procedure Display_Maze;
{*****************************************************************************}
{ set P_Line & P_Column to the current player position where 'S' is found }
Var
Line : Integer;
Ch : Char;
Col, Col2 : Integer;
N,S,E,W : Boolean;
Begin
Clrscr;
Writeln( ESC,'[2;1H', ESC,'[?8l' ); { place cursor, turnoff autorepeat }
If Vert_Flip { Read input file into internal array }
Then For Line := M_Depth-1 downto 1 do { Upside down }
Readln( Maze_Lun, Maze[Line] )
Else For Line := 1 to M_Depth do { Rightside up }
Readln( Maze_Lun, Maze[Line] );
If Hor_Flip { Make mirror image }
Then For Line := 1 to M_Depth do
Begin
Col2 := M_Width;
For Col := 1 to M_Width div 2 do
Begin
Ch := Maze[Line][Col];
Maze[Line][Col] := Maze[Line][Col2];
Maze[Line][Col2] := Ch;
Col2 := Col2 -1;
End;
End;
For Col := 1 to M_Width do
Begin
Maze[0][Col] := ' '; { Clear out line #0 }
Maze[M_Depth][Col] := ' '; { Clear out bottom line }
End;
For Line := 0 to M_Depth do
Begin
Maze[Line][1] := ' '; { Clear out leftmost column }
Maze[Line][M_Width] := ' '; { Clear out rightmost column }
End;
{ Convert '@' signs into appropriate line drawing characters }
{ at same time look for 'S'tart and 'E'nd locations }
For Line := 1 to M_Depth-1 do
For Col := 2 to M_Width-1 do
Begin
Ch := Maze[ Line ][ Col ];
If Ch <> ' ' Then { ignore spaces }
Begin
If (Ch = 'S') or (Ch = 's') { 'S'tart ? }
Then Begin Px := Col;
Py := Line;
Maze[ Line ][ Col ] := ' ';
End
Else If (Ch = 'E') or (Ch = 'e') { 'E'nd ? }
Then Begin Endx := Col;
Endy := Line;
Maze[ Line ][ Col ] := ' ';
End
Else { line segment, decode }
Begin
N := Maze[ Line-1 ][ Col ] <> ' '; { Check above pos }
S := Maze[ Line+1 ][ Col ] <> ' '; { Check below pos }
E := Maze[ Line ][ Col+1 ] <> ' '; { Check rightpos }
W := Maze[ Line ][ Col-1 ] <> ' '; { Check left pos }
If (N and S and E and W) Then Maze[Line][Col] := 'n'
Else If (N and S and E) Then Maze[Line][Col] := 't'
Else If (N and S and W) Then Maze[Line][Col] := 'u'
Else If (N and E and W) Then Maze[Line][Col] := 'v'
Else If (S and E and W) Then Maze[Line][Col] := 'w'
Else If (N and E) Then Maze[Line][Col] := 'm'
Else If (N and W) Then Maze[Line][Col] := 'j'
Else If (S and E) Then Maze[Line][Col] := 'l'
Else If (S and W) Then Maze[Line][Col] := 'k'
Else If (E or W) Then Maze[Line][Col] := 'q'
Else Maze[Line][Col] := 'x';
End;
End; { of "If Ch <> ' '" }
End; { of "For Col ..." loop }
Write( ESC, ')0', chr(ShiftOut) ); { invoke Line drawing set }
If not NoMaze
Then For Line := 1 to M_Depth-1 do { write Maze out to screen }
Writeln( Maze[ Line ] );
Write( ESC,'[',Endy:1,';',Endx:1,'H', ESC,'[5ma', ESC,'[0m' ); { End }
Write( ESC,'[',Py:1,';',Px:1,'H`' ); { Draw player's position }
Write( ESC,'[',Py:1,';',Px:1,'H' );
End; { of Proc. Display_Maze }
{*****************************************************************************}
Function Check_Move( Newx, Newy : Integer ) : Boolean;
{*****************************************************************************}
{ Check that new location doesn't bump into a wall }
Begin
Check_Move := False;
If (Newx < 2) or (Newx > M_Width-1) Then { out of bounds }
Else If (Newy < 1) or (Newy > M_Depth-1) Then { out of bounds }
Else If Maze[Newy][Newx] = ' ' Then Check_Move := True;
End; { of Func Check_Move }
{*****************************************************************************}
Procedure Move_It( Var Px, Py : Integer; Newx, Newy : Integer;
Direction : F_Key_Type; Var Done : Boolean );
{*****************************************************************************}
Var N : Integer;
Begin
Done := False;
Write( ESC,'[',Py:1,';',Px:1,'H.' ); { drop breadcrumb on previous pos }
Write( ESC,'[',Newy:1,';',Newx:1,'H`' ); { draw new position }
Write( ESC,'[',Newy:1,';',Newx:1,'H' ); { Reset cursor }
Px := Newx;
Py := Newy;
If (Px = Endx) and (Py = Endy) { are we done ? }
Then Begin
Done := True;
For N := 1 to 15 do Write(ESC,'[?5h', Beep, ESC,'[?5l');
End
Else Begin { stretch move }
If (Direction = _UpArrow)
Then Begin
If (Maze[Py-1][Px] = ' ') and (Py > 2) and
(Maze[Py][Px-1] <> ' ') and (Maze[Py][Px+1] <> ' ')
Then Move_It( Px, Py, Newx, Newy-1, Direction, Done );
End
Else If (Direction = _DownArrow)
Then Begin
If (Maze[Py+1][Px] = ' ') and (Py < M_Depth-1) and
(Maze[Py][Px-1] <> ' ') and (Maze[Py][Px+1] <> ' ')
Then Move_It( Px, Py, Newx, Newy+1, Direction, Done );
End
Else If (Direction = _LeftArrow)
Then Begin
If (Maze[Py][Px-1] = ' ') and (Px > 2) and
(Maze[Py-1][Px] <> ' ') and (Maze[Py+1][Px] <> ' ')
Then Move_It( Px, Py, Newx-1, Newy, Direction, Done );
End
Else If (Direction = _RightArrow)
Then Begin
If (Maze[Py][Px+1] = ' ') and (Px < M_Width-1) and
(Maze[Py-1][Px] <> ' ') and (Maze[Py+1][Px] <> ' ')
Then Move_It( Px, Py, Newx+1, Newy, Direction, Done );
End;
End;
End; { Of Proc. Move_It }
{*****************************************************************************}
Procedure Move_Piece;
{*****************************************************************************}
{ Get arrow key inputs or <EXIT> and process these commands }
{ F_Key will equal _Exit, _UpArrow, _DownArrow, _RightArrow, or _LeftArrow }
var Ch : char; { Character Pressed }
var F_Key : F_Key_Type; { Function Key Value }
var Ctrl_Key, {\ }
Shift_Key, { > True If On }
Lock_Key : boolean; {/ }
Done: Boolean;
Newx, Newy : Integer;
OK : Boolean;
Begin
Done := False;
Repeat
Newx := Px;
Newy := Py;
RB_Kbd (Ch, F_Key, Ctrl_Key, Shift_Key, Lock_Key);
Case F_Key of
_Exit: Done := True;
_UpArrow: Newy := Newy -1;
_DownArrow: Newy := Newy +1;
_RightArrow: Newx := Newx +1;
_LeftArrow: Newx := Newx -1;
end;
If not done
Then Begin
Moves := Moves + 1;
OK := Check_Move( Newx, Newy );
If OK Then Move_It( Px, Py, Newx, Newy, F_Key, Done )
Else Begin
Write( Beep );
Bumps := Bumps + 1;
End;
End;
until Done;
End; { of Proc. Move_Piece }
{*****************************************************************************}
{ Main body of Maze program }
{*****************************************************************************}
Begin
Bumps := 0; { How many times did we bump into a wall ? }
Moves := 0; { How many moves have we made totally ? }
NoMaze := False;
Introduction;
OK := Open_File( Maze_File, Maze_Lun );
Display_Maze;
Move_Piece;
Write( ESC, ')B', chr(ShiftIn) ); { turn off Line drawing set }
Write( ESC,'[24;1H', ESC,'[?8h' ); { Reset cursor, turn on autorepeat }
Write( 'While playing maze ',Maze_Num );
Write(' you''ve bumped into ',Bumps:3,' walls during ',Moves:3,' moves!');
End. { ye absolute end of program }