%!PS-Adobe-1.0 %%Creator: David Tock %%Title: Mazegen V1.0 %%CreationDate: January 1993 %%Pages: 1 %%PageOrder: Ascend %%Orientation: Portrait %%DocumentMedia: Plain 595 841 0 white () %%DocumentPaperSizes: A4 %%BoundingBox: 35 35 559 820 %%EndComments %%BeginProlog % % This is the result of an idea I had many years ago. I have seen PostScript % programs for drawing fractals, space filling curves etc, but I had never % seen one for drawing mazes. This is an implementation of a simple depth % first maze drawing algorithm. Just sending this file to a PostScript % printer will result in a different maze each time (OK, nearly every time). % % No originality is claimed for the method or the idea. Anyone can do what % they want with the code, for which I offer no guarantees. I am sure there % is room for much improvement, but I simply translated an old Pascal program % I had, with little attempt to optimise anything. I would be interested if % you make any significant improvements or developments. % % A word of warning: it is not very fast. A 50x75 cell maze will take quite % a few minutes. (At least, it does on our printers) % % David Tock dit@maths.aberdeen.ac.uk % % --------------------------------------------------------------------------- % % Lots of constants to begin with % %- % Minor tweaks 2006 by sburke@cpan.org /width 522 def % overall width of maze on page. Change if not A4. /height 783 def % overall height of maze on page. Change if not A4. /sx 50 def % number of cells across page /sy 75 def % number of cells down page. Best if 1.5 * sx. /bx 36 def % x offset of bottom left hand corner /by 36 def % y offset of bottom left hand corner % % the rest should not need changing % /scx width sx div def % x scaling factor computed from sizes above /scy height sy div def % y scaling factor computed from sizes above /ml sx sy mul array def % /mx sx sy mul array def % three arrays for building the maze in /my sx sy mul array def % /cand 20 array def % array for candidate directions /WT 16#8000 def % bitwise masks for doors in/out and walls /WR 16#4000 def % at Top, Borttom, Right and Left /WB 16#2000 def /WL 16#1000 def /DIT 16#800 def /DIR 16#400 def /DIB 16#200 def /DIL 16#100 def /DIA 16#f00 def /DOT 16#80 def /DOR 16#40 def /DOB 16#20 def /DOL 16#10 def /ST 2 def % marks the start /EN 1 def % marks the end % set line thickness according to maze dimensions scx scy lt {scx} {scy} ifelse 10 div setlinewidth 1 setlinecap % Seed the randomizer, if possible /realtime where { pop realtime } { 1 } ifelse srand % define some functions to allow 2D access to 1D PostScript arrays /mlget {sx mul add ml exch get} bind def /mlput {/val exch def sx mul add ml exch val put} bind def /mland {/val exch def sx mul add ml exch 2 copy get val and put} bind def /mlor {/val exch def sx mul add ml exch 2 copy get val or put} bind def % function to return random number within upper bound /getrand {rand exch mod} bind def % % initialise the arrays, draw the ealls, and set the start and finish % /init { % initialise the arrays to 0 0 1 sy 1 sub { /y exch def 0 1 sx 1 sub { y 0 mlput } for } for % then put in the bounding wall 0 1 sy 1 sub { dup 0 exch WL mlor sx 1 sub exch WR mlor } for 0 1 sx 1 sub { dup 0 WT mlor sy 1 sub WB mlor } for % finish at bottom /cx sx getrand def /cy sy 1 sub def cx cy DOB EN or mlor cx cy WB not mland gsave cx scx mul scx 2 div add cy scy mul scy 2 div add translate scx 5 div scy 5 div scale 0.5 setlinewidth 1 0 moveto 0 0 1 0 360 arc stroke grestore % start at top /cx sx getrand def /cy 0 def cx cy DIT ST or mlor cx cy WT not mland gsave cx scx mul scx 2 div add cy scy mul scy 2 div add translate scx 4 div dup 0 moveto neg scy 4 div 2 copy 2 copy rlineto neg rlineto exch neg exch 2 copy neg rlineto rlineto stroke grestore /sqnum 0 def } def % % the main routine % /create { gsave bx by translate init /newdir 2 def % set arbitary direction for the step before the first one % actually draw the bounding walls before we go any further 0 1 sx 1 sub {dup 0 2 drawwall sy 1 sub 0 drawwall} for 0 1 sy 1 sub {dup 0 exch 3 drawwall sx 1 sub exch 1 drawwall} for { % start of main generation loop mx sqnum cx put my sqnum cy put { % start of choose dir loop /newdir newdir choosedir def % choose a new direction newdir -1 ne {exit} if % if we have a direction deal with it backup -1 eq { exit} if % if we don't, then backtrack } loop newdir -1 eq {exit} if % no new direction? then maze is finished cx cy DOT newdir neg bitshift mlor % record way out of cell newdir 0 eq { /cy cy 1 sub def } if % calculate new cell based on dir newdir 1 eq { /cx cx 1 add def } if newdir 2 eq { /cy cy 1 add def } if newdir 3 eq { /cx cx 1 sub def } if /sqnum sqnum 1 add def % record path for backtracking cx cy DIT newdir 2 add 4 mod neg bitshift mlor % record way into cell } loop } def /choosedir { /ldir exch def % last direction moved. Can be used to bias new dir /cnum 0 def % general principle is to check if there is a wall or a way in or a way out % already in the candidate direction. If so, we can not move. If not, and the % cell reached by moving in that direction has not been visited, then it is % a candidate direction. Record all candidates and choose one at random. % /dir can be used to bias the direction chosen. For example, uncommenting % the four commented lines will favour continuing in a straight line, if poss. cx cy mlget WT DIT DOT or or and 0 eq { cx cy 1 sub mlget DIA and 0 eq { %ldir 0 eq {cand cnum 0 put /cnum cnum 1 add def} if cand cnum 0 put /cnum cnum 1 add def } { cx cy WT mlor % can not go that way so draw in the wall cx cy 1 sub WB mlor % and for the cell the other side of the wall cx cy 2 drawwall } ifelse } if cx cy mlget WR DIR DOR or or and 0 eq { cx 1 add cy mlget DIA and 0 eq { %ldir 1 eq {cand cnum 1 put /cnum cnum 1 add def} if cand cnum 1 put /cnum cnum 1 add def } { cx cy WR mlor cx 1 add cy WL mlor cx cy 1 drawwall } ifelse } if cx cy mlget WB DIB DOB or or and 0 eq { cx cy 1 add mlget DIA and 0 eq { %ldir 2 eq {cand cnum 2 put /cnum cnum 1 add def} if cand cnum 2 put /cnum cnum 1 add def } { cx cy WB mlor cx cy 1 add WT mlor cx cy 0 drawwall } ifelse } if cx cy mlget WL DIL DOL or or and 0 eq { cx 1 sub cy mlget DIA and 0 eq { %ldir 3 eq {cand cnum 3 put /cnum cnum 1 add def} if cand cnum 3 put /cnum cnum 1 add def } { cx cy WL mlor cx 1 sub cy WR mlor cx cy 3 drawwall } ifelse } if % now choose one of the candidate directions, if any cnum 0 eq { -1 } { cand cnum 1 eq {0 get } {cnum getrand get} ifelse } ifelse } bind def /backup { % each step is recorded on a stack. % This pops the last direction move off the stack. /sqnum sqnum 1 sub def sqnum 0 ge { /cx mx sqnum get def /cy my sqnum get def } if sqnum } bind def /drawwall { % Given the coordinates of a cell, this draw a wall in an appropriate direction. % Care should be taken with this section, as the edges of the cells must be % positioned correctly to avoid gaps in the walls. % Try reducing scy and scy to see what I mean. /dir exch def gsave exch scx mul scx 2 div add exch scy mul scy 2 div add translate dir 1 gt {180 rotate /dir dir 2 sub def} if scx 2 div scy 2 div moveto % scx 2.5 div scy 2.5 div moveto % this line is wrong. See above comment dir 0 eq {scx neg 0} {0 scy neg} ifelse rlineto stroke grestore } bind def %%EndProlog %%Page: 1 1 create showpage % % if you are feeling really rotten, this can keep a printer busy for a while % % { create showpage } loop %%EOF