draw2d/resource/postscript/maze.ps

%!PS
%%Pages: 1
%%EndComments

% Yet Another Maze Maker
% Version 2
% Written by Peter Sorotokin, 1996-1998
% This program is in the public domain.

% Note: do not send this job to the printer until you know
% how to cancel it (it may take a LOT of time on slow printer;
% it takes couple minutes on my LaserJet 4).

%%BeginSetup

% put your sizes here:

/width  25 def
/height 25 def

% seed number here:

0 srand % put your seed number instead of 0 (normally not required)
systemdict /realtime known { realtime srand } if

% initialization

/size  width height mul def
/zone  size array def
/zsize size array def
/vert  width 1 add array def
/hor   height 1 add array def

/w1 width 1 sub def
/h1 height 1 sub def

0 1 size 1 sub { dup zsize exch 1 put zone exch dup put } bind for
0 1 width { vert exch height string 0 1 h1
    { 1 index exch 255 put } for put } bind for
0 1 height { hor exch width string 0 1 w1
    { 1 index exch 255 put } for put } bind for

% define subroutines

/db { dup 20 string cvs = } bind def

/find_set { { zone 1 index get dup 3 1 roll eq {exit} if } loop} bind def

/merge_sets {
  2 copy zsize exch get
  exch zsize exch get 2 copy gt
  3 1 roll add exch
    { zsize 2 index 3 -1 roll put
        zone 3 1 roll put  }
    { zsize 3 index 3 -1 roll put
        zone 3 1 roll exch put  }
  ifelse } bind def

%%EndSetup

%%Page: maze 1

% building

size 1 sub
{
    {
        rand 2 mod 0 eq
        {
            rand height mod
            rand w1 mod 2 copy
            height mul add
            dup height add
            find_set exch find_set
            2 copy eq
            {
                pop pop pop pop
            }
            {
                merge_sets vert exch 1 add get exch 0 put exit
            }
            ifelse
        }
        {
            rand h1 mod
            rand width mod 2 copy
            height mul add
            dup 1 add
            find_set exch find_set
            2 copy eq
            {
                pop pop pop pop
            }
            {
                merge_sets exch hor exch 1 add get exch 0 put exit
            }
            ifelse
        }
        ifelse
    }
    loop
} bind repeat

% make entrance and exit

vert 0     get rand height mod 0 put
vert width get rand height mod 0 put

% setup output

clippath pathbbox
2 index sub exch
3 index sub exch
4 2 roll translate
2 copy height 4 add div exch width 4 add div
2 copy gt {exch} if pop /myscale exch def

myscale height mul sub 2 div exch
myscale width  mul sub 2 div exch
translate

myscale myscale scale
0.05 setlinewidth

newpath

% render the maze

0 1 width { dup 0 moveto vert exch get 0 1 height 1 sub
 { 1 index exch get 0 eq 0 1 3 -1 roll { rmoveto } { rlineto } ifelse }
            for pop } bind for

0 1 height { dup 0 exch moveto hor exch get 0 1 width 1 sub
 { 1 index exch get 0 eq 1 0 3 -1 roll { rmoveto } { rlineto } ifelse }
            for pop } bind for

stroke

stroke

% Quick hack to solve the maze.
% This part written by Christian Lehner.

clear

/NORTH 1 def
/WEST 2 def
/SOUTH 4 def
/EAST 8 def
/CRUMB 16 def

/find_door {% column => index
	dup 0 1 3 -1 roll length 1 sub {
		2 copy get 0 eq {
			exch pop
			exit
		} {
			pop
		} ifelse
	} for
} bind def

/mentrance vert 0 get find_door def
/mexit vert width get find_door def

/maze [height {[width {0} repeat]} repeat] def

/mget {% row col => int
	maze 3 -1 roll get exch get
} bind def

/mset {% row col int => -
	maze 4 -1 roll get 3 -2 roll put
} bind def

/initmaze {
	0 1 height 1 sub {/row exch def
		/mrow maze row get def
		0 1 width 1 sub {/col exch def
			% north
			hor row 1 add get col get 0 eq {
				mrow col 2 copy get //NORTH or put
			} if
			% west
			vert col get row get 0 eq {
				mrow col 2 copy get //WEST or put
			} if
			% south
			hor row get col get 0 eq {
				mrow col 2 copy get //SOUTH or put
			} if
			% east
			vert col 1 add get row get 0 eq {
				mrow col 2 copy get //EAST or put
			} if
		} for
	} for
} bind def

/step {% row col side => row' col'
	/side exch def
	/col exch def
	/row exch def
	side //NORTH eq {
		row 1 add col
	} {
		side //WEST eq {
			row col 1 sub
		} {
			side //SOUTH eq {
				row 1 sub col
			} {
				side //EAST eq {
					row col 1 add
				} {
					(step: bad side ) print side ==
				} ifelse
			} ifelse
		} ifelse
	} ifelse
} bind def

/done false def

/escape {% row col => -
	/col exch def
	/row exch def
	row mexit eq col width 1 sub eq and {
		(done)==
		row col
		/done true store
	} {
		row col 2 copy mget //CRUMB or mset
		row col
		[//NORTH //WEST //SOUTH //EAST] {/side exch def
			done {exit} if
			2 copy mget /val exch def
			val side and 0 ne {
				2 copy side step 2 copy
				mget /val exch def
				val //CRUMB and 0 eq {
					escape
				} {
					pop pop
				} ifelse
			} if
		} forall
		done not {
			pop pop
		} if
	} ifelse
} bind def

/solve {
	% close the entrance
	vert 0 get mentrance 1 put
	initmaze
	% start the escape
	/path [mentrance -1 mentrance 0 escape 2 copy 1 add] def
	% draw the path
	.5 setgray
	.5 .5 translate
	path 1 get path 0 get moveto
	2 2 path length 1 sub {/i exch def
		path i 1 add get path i get lineto
	} for
	stroke
	showpage
} bind def

% eject the page

copypage solve

%%EOF