Return to nmaze.p CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / tstpx / src

Annotation of 43BSDTahoe/ucb/pascal/tstpx/src/nmaze.p, revision 1.1

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.