|
|
1.1 root 1:
2: program randpath(input,output);
3: const maxwidth=122;maxheight=52;{lpt page size}
4: n=4;nfact=24;
5: type row=array[1..n]of 1..n;
6: mtype=(border,path,wall);
7: var maze:array[-2..maxwidth,-2..maxheight] of mtype;
8: table:array[1..24]of row;
9: xdir,ydir:array[1..4] of -2..2;
10: width:1 .. maxwidth; height: 1..maxheight; startx,starty:integer;
11: touchl,touchr:boolean {touched left and right edges};
12: wannamaze:char;
13: {Generation of permutations in lexicographic order,
14: adapted from CACM Algorithm 202 (Mok-Kong Shen)}
15: procedure perle (var s:row); {s is a row consisting of the nth permutation,
16: and will be changed to contain the n+1 st}
17: label 1;
18: var j,u,w:integer;
19: begin
20: w:=n; {permuting integers 1..n}
21: while s[w]<s[w-1] do w:=w-1;
22: u:=s[w-1];
23: for j:= n downto w do
24: begin
25: if s[j]>u then begin s[w-1]:=s[j];
26: s[j]:=u;
27: goto 1
28: end
29: end;
30: 1: for j:=0 to round((n-w-1)/2 +0.1) do
31: begin u:= s[n-j];
32: s[n-j]:=s[w+j];
33: s[w+j]:= u
34: end
35: end; {of perle}
36: procedure initable;
37: var i:integer;
38: begin
39: for i:=1 to n do table[1][i]:=i; {initialize first row}
40: for i:=2 to nfact do begin
41: table[i]:=table[i-1] {copy row};
42: perle(table[i])
43: end;
44: end;
45: procedure init; {initialize maze}
46: var pip, i,j:integer;
47: begin
48: write('width=');readln(width);write('height=');readln(height);
49: write('randomizing seed=');readln(pip);
50: pip:=seed(pip);
51: for i:=-1 to 2*width+1 do for j:=-1 to 2*height+1 do maze[i,j]:=wall;
52: for i:=-2 to 2*width+2 do begin maze[i,-2]:=border;
53: maze[i,2*height+2]:=border end;
54: for j:= -2 to 2*height+2 do begin maze[-2,j]:=border;
55: maze[2*width+2,j]:=border end;
56: end;
57: procedure growtree(x,y,px,py:integer);
58: var i,m,t:integer; choice:row;
59: procedure fillin;
60: begin
61: maze[(x+px)div 2,(y+py)div 2]:=path;
62: maze[x,y]:=path
63: end;
64:
65: begin {growtree}
66: if maze[x,y] = wall
67: then begin fillin;
68: m:=round(random(1.0)*23.0)+1; {random number between 1 and 24}
69: for i:=1 to 4 do
70: begin
71: choice:=table[m]; {determine row in table}
72: t:=choice[i]; {choice is 1, 2, 3, 4 ;; e s w n}
73: growtree(x+xdir[t],y+ydir[t],x,y);
74: end {of for}
75: end {of then};
76: if (x=-2) and (touchl=false) then begin touchl:=true {touched left border};
77: fillin
78: end;
79: if (x=2*width+2) and (touchr=false) then begin touchr:=true;
80: fillin end
81:
82: {otherwise, just return}
83: end; {of growtree}
84:
85: procedure printmaze;
86: var i,j:integer;
87: begin for j:= 2*height+1 downto -1 do begin
88: write(' ');
89: for i:=-1 to 2*width+1 do case maze[i,j] of
90: path:write(' ');
91: border,wall:write('X'); {for lineprinter}
92: end; writeln
93: end end;
94: begin {main}
95: xdir[1]:=2;xdir[2]:=0;xdir[3]:=-2;xdir[4]:=0;
96: ydir[1]:=0;ydir[2]:=-2;ydir[3]:=0;ydir[4]:=2;
97: wannamaze:= 'y';
98: initable;
99: while wannamaze='y' do
100: begin
101: init;
102: touchl:=false;touchr:=false;
103: startx:= 2*(round((1.5+random(1.0))*width) div 4);
104: starty:= 2*(round((1.5+random(1.0))*height)div 4);
105: { start near but not at middle }
106: growtree(startx,starty,startx,starty);
107: printmaze;
108: write('want another? (y or n)') ; readln(wannamaze);
109: end {wannamaze}
110: end.
111:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.