ellers.ps

%!PS-Adobe-3.0
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Eller's Maze Generation
%
% This postscript program implements Eller's maze generation algorithm.
% The algorithm is extremely memory efficient as it only needs space
% proportional to a row; as opposed to holding space for the whole maze.
%
% The algorithm thus allows for generation of infinite perfect mazes.
% Also, it is capable of adding bias (horizontal/vertical passages).
%
% (c) 2019-2020, Daniel Wiltsche-Prokesch <daniel.prokesch@gmail.com>
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/mm { %  mm => pt
    360 mul 127 div
} bind def

% width of a maze cell
/a 5 mm def

% margin for maze
/margin 12 mm def

% vertical 0.0 <--> 1.0 horizontal
/bias 0.5 def

(Begin\n) print
seed =  % print for RNG

% canvas dimensions
/A4-dim { 210 mm 297 mm } bind def

A4-dim
%80 mm 80 mm
margin 2 mul sub /maze-height exch def
margin 2 mul sub /maze-width exch def

% initialize RNG
seed srand

% prob
% 0.0 ... never true
% 1.0 ... always true
/cointoss { % prob => bool
    100 mul
    rand 100 mod
    gt
} bind def

/N        maze-width  a div cvi def
/num-rows maze-height a div cvi def

/forall_N { % proc => --
    0 1 N 1 sub
    4 -1 roll % dig up proc
    for
} bind def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Drawing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/-a a neg def
/nstr 20 string def

/draw-text-num { % arr => --
    dup length 0 exch {
        /i exch def
        i 0 gt { ( - ) show } if
        dup i get
        nstr cvs show
        i 1 add
    } repeat
    pop % pop arr
} bind def

/draw-text-info {
    /Helvetica findfont
    10 scalefont setfont
    [ seed N num-rows ] draw-text-num pop
} bind def

/draw-init {
    margin dup moveto
} bind def

/draw-top {
    draw-init
    currentpoint
    currentpoint
    0 -10 rmoveto
    draw-text-info
    moveto
    N a mul 0 rlineto
    moveto
} bind def

/draw-row {
    currentpoint % start of this line
    0 a rlineto % leftmost border
    0 -a rmoveto
    { /i exch def  % for i = 0 .. N-1
        0 a rmoveto
        a  0  border-bottom i get {rlineto} {rmoveto} ifelse
        0 -a  border-right  i get {rlineto} {rmoveto} ifelse
    } forall_N
    moveto % back to start of line
    0 a rmoveto % offset for next line
} bind def

/draw-glue-marks {
    currentpoint
    currentpoint
    currentpoint
    gsave
    newpath
    moveto
    -2 mm 0 rmoveto
    -4 mm 0 rlineto
    moveto
    N a mul 0 rmoveto
    2 mm 0 rmoveto
    4 mm 0 rlineto
    moveto
    closepath
    1 setlinewidth
    stroke
    grestore
} bind def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Border manipulation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/border-right  N array def
/border-bottom N array def

/set-bottom-border { % i => --
    border-bottom exch true put
} bind def

/set-right-border { % i => --
    border-right  exch true put
} bind def

/clr-bottom-border { % i => --
    border-bottom exch false put
} bind def

/clr-right-border { % i => --
    border-right  exch false put
} bind def

% print a maze row based on borders
/print-row { % -- => --
    (|) print % leftmost border
    { % for i = 0 .. N-1
        dup % need control variable twice
        border-bottom exch get {(___)} {(   )} ifelse print
        border-right  exch get {(|)  } {( )  } ifelse print
    } forall_N
    (\n) print
} bind def

/print-top {
    ( ) print
    N {(___ ) print} repeat
    (\n) print
} bind def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Circular doubly-linked list for managing sets
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/next N array def
/prev N array def

/are-in-same-set { % u v => bool
    2 dict
    begin
        /v exch def
        /u exch def
        % u.next == v && u == v.prev
        next u get  v  eq
        prev v get  u  eq
        and
    end
} bind def

/make-singleton { % u => --
    dup
    next exch dup put   % u.next = u
    prev exch dup put   % u.prev = u
} bind def

/is-singleton { % u => bool
    % a singleton set has self-loops
    dup are-in-same-set
} bind def

/init-sets {
    { make-singleton } forall_N
} bind def

/remove-from-set { % u => --
    1 dict
    begin
        /u exch def
        % u.prev.next = u.next
        prev u get  % load u.prev
        next exch   % prepare .next
        next u get  % load u.next
        put
        % u.next.prev = u.prev
        next u get
        prev exch
        prev u get
        put
        % self-links
        u make-singleton
    end
} bind def

/join-sets { % u v => --
    2 dict
    begin
        /v exch def
        /u exch def

        % u.next.prev = v.prev
        next u get  % load u.next
        prev exch   % prepare .prev
        prev v get  % load v.prev
        put
        % v.prev.next = u.next
        prev v get  % load v.prev
        next exch   % prepare .next
        next u get  % load u.next
        put

        next u v put % u.next = v
        prev v u put % v.prev = u
    end
} bind def

% debugging aid
/show-links {
    (Links:\n) print
    (prev ) print prev ==
    (next ) print next ==
} bind def

%
% Dump current state
% (the next array and state of RNG)
%
/serialize { % -- => arr int
    rrand
    next N array copy
} bind def

%
% Restore state
% (from RNG and a next array)
%
/deserialize { % arr int => --
    srand
    % store arr to next
    next copy pop
    % create back-links
    { /u exch def % for u = 0 .. N-1
        % u.next.prev = u
        next u get
        prev exch
        u put
    } forall_N
} bind def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Algorithm
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% u,v are defined
/carve-to-right { % -- => --
    u v join-sets
    u clr-right-border
} def

/carve-horizontal-passage { % proc => proc
    dup /decision exch def

    0 N 1 sub { % repeat N-1 times
        /u exch def
        /v u 1 add def
        u set-right-border
        u v are-in-same-set not {
            decision { carve-to-right } if
        } if
        v % next position
    } repeat
    set-right-border % (of last column)
} bind def

% u,v are defined
/dont-carve-down { % -- => --
    u remove-from-set
    u set-bottom-border
} def

/carve-vertical-passage { % proc => proc
    dup /decision exch def
    { /u exch def % for u = 0 .. N-1
        u clr-bottom-border
        u is-singleton not {
            decision { dont-carve-down } if
        } if
    } forall_N
} bind def

/create-row { % proc => --
    carve-horizontal-passage
    carve-vertical-passage
    pop
} bind def

/create-last-row { % -- => --
    {true} create-row
    % close last passage
    N 1 sub set-bottom-border
} bind def

% TODO
%/init-state {
%    [1 2 0 3 9 5 6 7 8 4 10 11 12 13 14 15 18 17 16 19 20 21 22 23 24 25 27 28 31 29 30 26 32 33 34 35 36]
%    1379828400
%} def


% bool ... close maze
% num  ... number of rows
/create-maze { % bool num => --
    /init-state where
    {
        pop
        /init-state cvx exec
        deserialize
        draw-init
    } {
        init-sets
        print-top draw-top
    } ifelse

    % num is TOS
    1 sub {
        {bias cointoss} create-row
        print-row draw-row
    } repeat

    % bool is TOS
    {
        % last row
        create-last-row
        print-row draw-row
    } {
        % dump info for continuation
        draw-glue-marks
        serialize ==
    } ifelse
} bind def


true num-rows create-maze

pstack % should be empty
(End\n) print

closepath
2 setlinecap
2 setlinewidth
stroke
showpage

quit