[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Apple Pascal Maze Creator
Well here it is. Wow look at the date on that !!! No wonder I can't remember much after almost 25 years !!! I would have to learn Pascal all over again. It had 6 levels of difficulty. I remember the highest level took a long time to create which is why emulation would be good. So far I can't get Pascal using Applewin to read the volume name. Ciderpress recognizes the volume name and I extracted this source:
PROGRAM maze; uses applestuff;
{ maze generator version 2.4 }
{ 2/12/88 by Larry A. Greene }
CONST
version = '2.4';
date = '2/12/88';
pchar = '+' { print character };
VAR
xstart,ystart,direction,segments,totalsegments,mazenumber,totalmazes,
copynumber,totalcopies,x,y,xcoord,xcoord2,ycoord,ycoord2,indexh,indexv,
width,depth,hlines,vlines,hchars,vchars,level
:INTEGER;
response
:CHAR;
oktoplot
:BOOLEAN;
intersect { matrix of intersection points }
:array [1..49,1..39] of INTEGER;
graph { character display of maze }
:array [1..97,1..79] of CHAR;
PROCEDURE initprinter; { setup code for 7/72 inch line spacing }
BEGIN
write(chr(27),chr(49));
END; { initprinter }
{ assign dimensions for different levels of difficulty }
PROCEDURE level1;
BEGIN
width:= 7; { block width }
depth:= 7; { block depth }
vlines:= 14; { lines vertically }
hlines:= 17; { lines horizontally }
END;
PROCEDURE level2;
BEGIN
width:= 5;
depth:= 5;
vlines:= 20;
hlines:= 25;
END;
PROCEDURE level3;
BEGIN
width:= 4;
depth:= 4;
vlines:= 23;
hlines:= 29;
END;
PROCEDURE level4;
BEGIN
width:= 4;
depth:= 4;
vlines:= 27;
hlines:= 33;
END;
PROCEDURE level5;
BEGIN
width:= 3;
depth:= 3;
vlines:= 33;
hlines:= 41;
END;
PROCEDURE level6;
BEGIN
width:= 3;
depth:= 3;
vlines:= 39;
hlines:= 49;
END;
PROCEDURE initialize;
BEGIN
{ initialize graph character display to all blanks }
FOR ycoord:= 1 TO vchars DO
BEGIN
FOR xcoord:= 1 TO hchars DO
graph[ycoord,xcoord]:= ' ';
END;
{ initialize upper and lower border intersect points to 1 and 0 }
FOR xcoord:= 1 TO vlines DO
intersect[1,xcoord] := 1;
FOR xcoord:= 1 TO hchars DO
graph[1,xcoord] := pchar;
FOR ycoord:= 2 TO (hlines-1) DO
intersect[ycoord,vlines] := 1;
FOR ycoord:= 2 TO ((depth-1)*(hlines-2)+1) DO
graph[ycoord,hchars] := pchar;
FOR ycoord:= 2 TO (hlines-1) DO
intersect[ycoord,1] := 0;
FOR ycoord:= depth TO (vchars-1) DO
graph[ycoord,1] := pchar;
FOR xcoord:= 1 TO vlines DO
intersect[hlines,xcoord] := 0;
FOR xcoord:= 1 to hchars DO
graph[vchars,xcoord] := pchar;
{ initialize center intersect points to 2 }
FOR ycoord:= 2 TO (hlines-1) DO
BEGIN
FOR xcoord:= 2 TO (vlines-1) DO
BEGIN
intersect[ycoord,xcoord] := 2;
END;
END;
END; { initialize }
FUNCTION rand(low,high: INTEGER): INTEGER;
{ returns random integer between low and high }
VAR
max,range,temp
:INTEGER;
BEGIN
range:= high - low + 1;
max:= MAXINT - (MAXINT-range+1) MOD range;
REPEAT
temp:= random { applestuff function }
UNTIL temp <= max;
rand:= low + temp MOD range
END; { rand }
PROCEDURE checkplot; { returns oktoplot TRUE or FALSE }
{ is point not connected to tree ? }
BEGIN
IF intersect[ycoord,xcoord] > 1 THEN
oktoplot:= TRUE
ELSE
oktoplot:= FALSE;
END; { checkplot }
{ map plotted line to tree intersection value }
PROCEDURE mapup;
BEGIN
FOR y:= ystart DOWNTO ycoord DO
intersect[y,xcoord]:= intersect[ycoord,xcoord];
END; { mapup }
PROCEDURE mapright;
BEGIN
FOR x:= xstart TO xcoord DO
intersect[ycoord,x]:= intersect[ycoord,xcoord];
END; { mapright }
PROCEDURE mapdown;
BEGIN
FOR y:= ystart TO ycoord DO
intersect[y,xcoord]:= intersect[ycoord,xcoord];
END; { mapdown }
PROCEDURE mapleft;
BEGIN
FOR x:= xstart DOWNTO xcoord DO
intersect[ycoord,x]:= intersect[ycoord,xcoord];
END; { mapdown }
PROCEDURE convertcoord;
{ convert intersect coords to graph coords }
BEGIN
ycoord:= (ycoord-1)*(depth-1)+1;
xcoord:= (xcoord-1)*(width-1)+1;
END; { convertcoord }
{ assign coord2 in chosen direction. plot segment on graph }
PROCEDURE plotup;
BEGIN
ycoord2:= ycoord-1;
xcoord2:= xcoord;
convertcoord;
FOR y:= 0 TO (depth-1) DO
graph[(ycoord-y),xcoord]:= pchar;
END; { plotup }
PROCEDURE plotright;
BEGIN
ycoord2:= ycoord;
xcoord2:= xcoord+1;
convertcoord;
FOR x:= 0 TO (width-1) DO
graph[ycoord,(xcoord+x)]:= pchar;
END; { plotright }
PROCEDURE plotdown;
BEGIN
ycoord2:= ycoord+1;
xcoord2:= xcoord;
convertcoord;
FOR y:= 0 TO (depth-1) DO
graph[(ycoord+y),xcoord]:= pchar;
END; { plotdown }
PROCEDURE plotleft;
BEGIN
ycoord2:= ycoord;
xcoord2:= xcoord-1;
convertcoord;
FOR x:= 0 TO (width-1) DO
graph[ycoord,(xcoord-x)]:= pchar;
END; { plotleft }
PROCEDURE nextxy; { sequence plot }
{ assign coords to indexed h,v point and increment h,v indexes }
BEGIN
xcoord:= indexh;
ycoord:= indexv;
indexh:= indexh+1;
IF (indexh=vlines) THEN
BEGIN
indexh:= 2;
indexv:= indexv+1;
IF (indexv=hlines) THEN
indexv:= 2;
END;
END; {nextxy}
PROCEDURE randxy; { random plot }
BEGIN
xcoord:= rand(2,(vlines-1));
ycoord:= rand(2,(hlines-1));
END; {randxy}
PROCEDURE plot;
BEGIN
IF (segments > (totalsegments DIV 10)) THEN
randxy { random plot first 90% of lines }
ELSE
nextxy; { sequence plot remaining 10% to increase execution speed }
checkplot;
IF NOT oktoplot THEN EXIT(plot);
xstart:= xcoord;
ystart:= ycoord;
direction:= rand(1,4);
{ do not cross quadrant boundaries for first 25% of lines }
IF (segments > (totalsegments*3) DIV 4) THEN
BEGIN
IF ((xcoord <= vlines DIV 2) AND (ycoord <= hlines DIV 2)) THEN
IF ((direction = 2) OR (direction = 3)) THEN EXIT(plot);
IF ((xcoord > vlines DIV 2) AND (ycoord <= hlines DIV 2)) THEN
IF ((direction = 3) OR (direction = 4)) THEN EXIT(plot);
IF ((xcoord <= vlines DIV 2) AND (ycoord > hlines DIV 2)) THEN
IF ((direction = 1) OR (direction = 2)) THEN EXIT(plot);
IF ((xcoord > vlines DIV 2) AND (ycoord > hlines DIV 2)) THEN
IF ((direction = 1) OR (direction = 4)) THEN EXIT(plot);
END;
REPEAT
gotoxy(47,10);
write(segments,' ');
CASE direction OF
1: plotup;
2: plotright;
3: plotdown;
4: plotleft;
END;
ycoord:= ycoord2;
xcoord:= xcoord2;
segments:= segments-1;
UNTIL (intersect[ycoord,xcoord] < 2);
CASE direction OF
1: mapup;
2: mapright;
3: mapdown;
4: mapleft;
END;
END; { plot }
PROCEDURE print; { send maze to printer }
BEGIN
close(output);
rewrite(output,'PRINTER:');
initprinter;
writeln('V ',version,' level ',level,' maze #',mazenumber,' of ',
totalmazes);
writeln;
writeln;
FOR ycoord:= 1 TO vchars DO
BEGIN
FOR xcoord:= 1 TO hchars DO
BEGIN
write(graph[ycoord,xcoord]);
END;
writeln;
END;
page(output);
close(output);
rewrite(output,'CONSOLE:');
END; { print }
BEGIN { main program loop }
REPEAT { until response = 'n' }
page(output);
gotoxy(25,0);
write('*** Maze Generator V ',version,' ***');
gotoxy(27,2);
write(date,' by Larry A. Greene');
level:= 0;
WHILE NOT (level IN [1..6]) DO
BEGIN
gotoxy(25,6);
write('select level of difficulty (1-6) ');
gotoxy(57,6);
readln(level);
END;
CASE level OF
1: level1;
2: level2;
3: level3;
4: level4;
5: level5;
6: level6;
END;
hchars:= (width-1)*(vlines-1)+1;
vchars:= (depth-1)*(hlines-1)+1;
gotoxy(25,8);
write('how many different mazes ?');
readln(totalmazes);
gotoxy(25,10);
write('how many copies of each ?');
readln(totalcopies);
mazenumber:= 1;
REPEAT { until all mazes printed }
gotoxy(25,6);
write('maze level ',level,': #',mazenumber,' of ',totalmazes);
write(' ');
totalsegments:= (vlines-2)*(hlines-2);
segments:= totalsegments;
randomize; { reseed random function }
indexh:= rand(2,(vlines-1));
indexv:= rand(2,(hlines-1));
gotoxy(25,10);
write('lines to be plotted = ',segments,' ');
gotoxy(25,8);
write('initializing... ');
initialize;
gotoxy(25,8);
write('plotting... ');
REPEAT
plot;
UNTIL (segments = 0);
gotoxy(25,10);
write(' ');
gotoxy(25,8);
write('printing...');
copynumber:= 1;
REPEAT { until all copies of single maze printed }
print;
copynumber:= copynumber+1;
UNTIL (copynumber > totalcopies);
mazenumber:= mazenumber + 1;
UNTIL (mazenumber > totalmazes);
gotoxy(25,6);
write('done. ');
gotoxy(25,8);
write('generate another series (y/n)?');
readln(response);
UNTIL ((response='n') OR (response='N'));
REPEAT { forever }
page(output);
write('insert another disk and reboot...');
readln(response);
UNTIL (level=7); { infinite loop }
END. { maze }