Source code in the rexx programming language

/*REXX program generates and displays a  rectangular  solvable maze  (of any size).     */
parse arg rows cols seed .                       /*allow user to specify the maze size. */
if rows='' | rows==','  then rows= 19            /*No rows given?  Then use the default.*/
if cols='' | cols==','  then cols= 19            /* " cols   "  ?    "   "   "     "    */
if datatype(seed, 'W')  then call random ,,seed  /*use a random  seed for repeatability.*/
ht=0;                        @.=0                /*HT= # rows in grid;  @.: default cell*/
call makeRow  '┌'copies("~┬", cols - 1)'~┐'      /*construct the top edge of the maze.  */
                                                 /* [↓]  construct the maze's grid.     */
      do    r=1  for rows;   _=;     __=;      hp= "|";              hj= '├'
         do c=1  for cols;   _= _ || hp'1';    __= __ || hj"~";      hj= '┼';      hp= "│"
         end   /*c*/
                        call makeRow  _'│'       /*construct the right edge of the cells*/
      if r\==rows  then call makeRow __'┤'       /*    "      "    "     "   "  "  maze.*/
      end      /*r*/                             /* [↑]  construct the maze's grid.     */

call makeRow  '└'copies("~┴",  cols - 1)'~┘'     /*construct the bottom edge of the maze*/
r!= random(1, rows) *2;     c!= random(1, cols) *2;      @.r!.c!= 0   /*choose 1st cell.*/
                                                 /* [↓]  traipse through the maze.      */
  do forever;    n= hood(r!, c!);    if n==0  then if \fCell()  then leave  /*¬freecell?*/
  call ?;        @._r._c= 0                      /*get the (next) maze direction to go. */
  ro= r!;        co= c!;     r!= _r;    c!= _c   /*save original maze cell coordinates. */
  ?.zr= ?.zr % 2;            ?.zc= ?.zc % 2      /*get the maze row and cell directions.*/
  rw= ro + ?.zr;             cw= co + ?.zc       /*calculate the next row and column.   */
  @.rw.cw= .                                     /*mark the maze cell as being visited. */
  end   /*forever*/
                                                 /* [↓]  display maze to the terminal.  */
         do     r=1  for ht;            _=
             do c=1  for cols*2 + 1;    _= _ || @.r.c;    end  /*c*/
         if \(r//2)  then _= translate(_, '\', .)                   /*trans to backslash*/
         @.r= _                                                     /*save the row in @.*/
         end   /*r*/

      do #=1  for ht;           _= @.#           /*display the maze to the terminal.    */
      call makeNice                              /*prettify cell corners and dead─ends. */
      _=  changestr( 1 ,  _   , 111     )        /*──────these four ────────────────────*/
      _=  changestr( 0 ,  _   , 000     )        /*───────── statements are ────────────*/
      _=  changestr( . ,  _   , "   "   )        /*────────────── used for preserving ──*/
      _=  changestr('~',  _   , "───"   )        /*────────────────── the aspect ratio. */
      say translate( _ , '─│' , "═|\10" )        /*make it presentable for the screen.  */
      end   /*#*/
  exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:       parse arg _r,_c;     return  @._r._c    /*a fast way to reference a maze cell. */
makeRow: parse arg z; ht= ht+1;  do c=1  for length(z); @.ht.c=substr(z,c,1);  end; return
hood:    parse arg rh,ch;     return  @(rh+2,ch)  + @(rh-2,ch)  + @(rh,ch-2)  + @(rh,ch+2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
?:         do forever;  ?.= 0;   ?= random(1, 4);     if ?==1  then ?.zc= -2     /*north*/
                                                      if ?==2  then ?.zr=  2     /* east*/
                                                      if ?==3  then ?.zc=  2     /*south*/
                                                      if ?==4  then ?.zr= -2     /* west*/
           _r= r! + ?.zr;       _c= c! + ?.zc;        if @._r._c == 1    then return
           end   /*forever*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
fCell:     do     r=1  for rows;                rr= r + r
               do c=1  for cols;                         cc= c + c
               if hood(rr,cc)==1  then do;  r!= rr;  c!= cc;   @.r!.c!= 0;  return 1;  end
               end   /*c*/                       /* [↑]  r! and c!  are used by invoker.*/
           end       /*r*/;       return 0
/*──────────────────────────────────────────────────────────────────────────────────────*/
makeNice: width= length(_);     old= # - 1;     new= # + 1;     old_= @.old;   new_= @.new
          if left(_, 2)=='├.'  then _= translate(_, "|", '├')
          if right(_,2)=='.┤'  then _= translate(_, "|", '┤')

             do  k=1  for  width  while #==1;         z= substr(_, k, 1) /*maze top row.*/
             if z\=='┬'                  then iterate
             if substr(new_, k, 1)=='\'  then _= overlay("═", _, k)
             end   /*k*/

             do  k=1  for  width  while #==ht;        z= substr(_, k, 1) /*maze bot row.*/
             if z\=='┴'                  then iterate
             if substr(old_, k, 1)=='\'  then _= overlay("═", _, k)
             end   /*k*/

             do  k=3  to  width-2  by 2  while #//2;  z= substr(_, k, 1) /*maze mid rows*/
             if z\=='┼'   then iterate
             le= substr(_   , k-1, 1)
             ri= substr(_   , k+1, 1)
             up= substr(old_, k  , 1)
             dw= substr(new_, k  , 1)
                    select
                    when le== .  & ri== .  & up=='│' & dw=="│"  then _= overlay('|', _, k)
                    when le=='~' & ri=="~" & up=='\' & dw=="\"  then _= overlay('═', _, k)
                    when le=='~' & ri=="~" & up=='\' & dw=="│"  then _= overlay('┬', _, k)
                    when le=='~' & ri=="~" & up=='│' & dw=="\"  then _= overlay('┴', _, k)
                    when le=='~' & ri== .  & up=='\' & dw=="\"  then _= overlay('═', _, k)
                    when le== .  & ri=="~" & up=='\' & dw=="\"  then _= overlay('═', _, k)
                    when le== .  & ri== .  & up=='│' & dw=="\"  then _= overlay('|', _, k)
                    when le== .  & ri== .  & up=='\' & dw=="│"  then _= overlay('|', _, k)
                    when le== .  & ri=="~" & up=='\' & dw=="│"  then _= overlay('┌', _, k)
                    when le== .  & ri=="~" & up=='│' & dw=="\"  then _= overlay('└', _, k)
                    when le=='~' & ri== .  & up=='\' & dw=="│"  then _= overlay('┐', _, k)
                    when le=='~' & ri== .  & up=='│' & dw=="\"  then _= overlay('┘', _, k)
                    when le=='~' & ri== .  & up=='│' & dw=="│"  then _= overlay('┤', _, k)
                    when le== .  & ri=="~" & up=='│' & dw=="│"  then _= overlay('├', _, k)
                    otherwise   nop
                    end   /*select*/
             end          /*k*/;                   return


/*REXX program  generates and displays  a  rectangular  solvable maze  (of any size).   */
parse arg rows cols seed .                       /*allow user to specify the maze size. */
if rows='' | rows==","  then rows= 19            /*No rows given?  Then use the default.*/
if cols='' | cols==","  then cols= 19            /* " cols   "  ?    "   "   "     "    */
if datatype(seed, 'W')  then call random ,,seed  /*use a random  seed for repeatability.*/
ht=0;                        @.=0                /*HT= # rows in grid;  @.: default cell*/
call makeRow '┌'copies("─┬", cols-1)'─┐'         /*construct the  top edge  of the maze.*/

      do    r=1  for rows;   _=;     __=;      hp= "|";              hj= '├'
         do c=1  for cols;   _= _ || hp'1';    __= __ || hj"─";      hj= '┼';      hp= "│"
         end   /*c*/
                        call makeRow  _'│'       /*construct the right edge of the cells*/
      if r\==rows  then call makeRow __'┤'       /*    "      "    "     "   "  "  maze.*/
      end      /*r*/                             /* [↑]  construct the maze's grid.     */

call makeRow '└'copies("─┴", cols-1)'─┘'         /*construct the bottom edge of the maze*/
r!= random(1, rows)*2;    c!= random(1, cols)*2;     @.r!.c!= 0   /*choose the 1st cell.*/
                                                 /* [↓]  traipse through the maze.      */
  do forever;        n= hood(r!, c!)             /*number of free maze cells.           */
  if n==0  then if \fCell()  then leave          /*if no free maze cells left, then done*/
  call ?;            @._r._c= 0                  /*get the (next) maze direction to go. */
  ro= r!;            co= c!;    r!= _r;   c!= _c /*save the original cell coordinates.  */
  ?.zr= ?.zr % 2;    ?.zc= ?.zc % 2              /*get the maze row and cell directions.*/
  rw= ro + ?.zr;     cw= co + ?.zc               /*calculate the next maze row and col. */
  @.rw.cw=.                                      /*mark the maze cell as being visited. */
  end   /*forever*/
                                                 /* [↓]  display maze to the terminal.  */
         do     r=1  for ht;           _=
             do c=1  for cols*2 + 1;   _= _ || @.r.c;   end  /*c*/
         if \(r//2)  then _= translate(_, '\',.) /*translate a  period  to a  backslash.*/
         _=  changestr( 1 ,  _  , 111   )        /*──────these four ────────────────────*/
         _=  changestr( 0 ,  _  , 000   )        /*───────── statements are ────────────*/
         _=  changestr( . ,  _  , "   " )        /*────────────── used for preserving ──*/
         _=  changestr('─',  _  , "───" )        /*────────────────── the aspect ratio. */
         say translate( _ , '│' , "|\10")        /*make it presentable for the screen.  */
         end   /*r*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
@:       parse arg _r,_c;     return  @._r._c    /*a fast way to reference a maze cell. */
makeRow: parse arg z; ht= ht+1;  do c=1  for length(z); @.ht.c=substr(z,c,1);  end; return
hood:    parse arg rh,ch;     return  @(rh+2,ch)  + @(rh-2,ch)  + @(rh,ch-2)  + @(rh,ch+2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
?:         do forever;  ?.= 0;   ?= random(1, 4);     if ?==1  then ?.zc= -2     /*north*/
                                                      if ?==2  then ?.zr=  2     /* east*/
                                                      if ?==3  then ?.zc=  2     /*south*/
                                                      if ?==4  then ?.zr= -2     /* west*/
           _r= r! + ?.zr;       _c= c! + ?.zc;        if @._r._c == 1    then return
           end   /*forever*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
fCell:     do     r=1  for rows;                rr= r + r
               do c=1  for cols;                         cc= c + c
               if hood(rr,cc)==1  then do;  r!= rr;  c!= cc;   @.r!.c!= 0;  return 1;  end
               end   /*c*/                       /* [↑]  r! and c!  are used by invoker.*/
           end       /*r*/;       return 0


/* REXX ***************************************************************
* 04.09.2013 Walter Pachl
**********************************************************************/
Parse Arg imax jmax seed
If imax='' Then imax=10
If jmax='' Then jmax=15
If seed='' Then seed=4711
c='123456789'||,
  'abcdefghijklmnopqrstuvwxyz'||,
  translate('abcdefghijklmnopqrstuvwxyz')
c=copies(c,10)
call random 1,10,seed
id=2*imax+1                         /* vertical dimension of a.i.j   */
jd=2*jmax+1                         /* horizontal dimension of a.i.j */
a.=1                                   /* mark all borders present   */
p.='.'                                 /* Initialize all grid points */
pl.=0                                  /* path list                  */
ii=random(1,imax)                      /* find a start position      */
jj=random(1,jmax)
p=1                                    /* first position             */
na=1                                   /* number of points used      */
Do si=1 To 1000                        /* Do Forever - see Leave     */
  /* Say 'loop' si na                     show progress              */
  Call path ii,jj                /* compute a path starting at ii/jj */
  If na=imax*jmax Then                 /* all points used            */
    Leave                              /* we are done                */
  Parse Value select_next() With ii jj /* get a new start from a path*/
  End

/***************
Do i=1 To imax
  ol=''
  Do j=1 To jmax
    ol=ol||p.i.j
    End
    Say ol
  End
Say ' '
***************/
Call show
/***********************
Do pi=1 To imax*jmax
  Say right(pi,3) pos.pi
  End
***********************/
Exit

path: Procedure Expose p. np. p pl. c a. na imax jmax id jd pos.
/**********************************************************************
* compute a path starting from point (ii,jj)
**********************************************************************/
  Parse Arg ii,jj
  p.ii.jj='1'
  pos.p=ii jj
  Do pp=1 to 50                /* compute a path of maximum length 50*/
    neighbors=neighbors(ii,jj)         /* number of free neighbors   */
    Select
      When neighbors=1 Then            /* just one                   */
        Call advance 1,ii,jj           /* go for it                  */
      When neighbors>0 Then Do         /* more Than 1                */
        ch=random(1,neighbors)         /* choose one possibility     */
        Call advance ch,ii,jj          /* and go for that            */
        End
      Otherwise                        /* none available             */
        Leave
      End
    End
  Return

neighbors: Procedure Expose p. np.  imax jmax neighbors pl.
/**********************************************************************
* count the number of free neighbors of point (i,j)
**********************************************************************/
  Parse Arg i,j
  neighbors=0
  in=i-1; If in>0     Then Call check in,j
  in=i+1; If in<=imax Then Call check in,j
  jn=j-1; If jn>0     Then Call check i,jn
  jn=j+1; If jn<=jmax Then Call check i,jn
  Return neighbors

check: Procedure Expose p. imax jmax np. neighbors pl.
/**********************************************************************
* check if point (i,j) is free and note it as possible successor
**********************************************************************/
  Parse Arg i,j
  If p.i.j='.' Then Do                 /* point is free              */
    neighbors=neighbors+1              /* number of free neighbors   */
    np.neighbors=i j                   /* note it as possible choice */
    End
  Return

advance: Procedure Expose p pos. np. p. c ii jj a. na pl. pos.
/**********************************************************************
* move to the next point of the current path
**********************************************************************/
  Parse Arg ch,pii,pjj
  Parse Var np.ch ii jj
  p=p+1                                /* position number            */
  pos.p=ii jj                          /* note its coordinates       */
  p.ii.jj=substr(c,p,1)                /* mark the point as used     */
  ai=pii+ii                            /* vertical border position   */
  aj=pjj+jj                            /* horizontal border position */
  a.ai.aj=0                            /* tear the border down       */
  na=na+1                              /* number of used positions   */
  z=pl.0+1                             /* add the point to the list  */
  pl.z=ii jj                           /* of follow-up start pos.    */
  pl.0=z
  Return

show: Procedure Expose id jd a.  na
/*********************************************************************
* Show the resulting maze
*********************************************************************/
  say 'mgg 6 18 4711'
  say 'show na='na
  Do i=1 To id
    ol=''
    Do j=1 To jd
      If i//2=1 Then Do                /* odd lines                 */
        If a.i.j=1 Then Do             /* border to be drawn        */
          If j//2=0 Then
            ol=ol||'---'               /* draw the border           */
          Else
            ol=ol'+'
          End
        Else Do                        /* border was torn down      */
          If j//2=0 Then
            ol=ol||'   '               /* blanks instead of border  */
          Else
            ol=ol||'+'
          End
        End
      Else Do                          /* even line                 */
        If a.i.j=1 Then Do
          If j//2=0 Then               /* even column               */
            ol=ol||'   '               /* moving space              */
          Else                         /* odd column                */
            ol=ol||'|'                 /* draw the border           */
          End
        Else                           /* border was torn down      */
          ol=ol||' '                   /* blank instead of border   */
        End
      End
    Select
      When i=6 Then ol=overlay('A',ol,11)
      When i=8 Then ol=overlay('B',ol, 3)
      Otherwise Nop
      End
    Say ol format(i,2)
    End
  Return

select_next: Procedure Expose p. pl. imax jmax
/*********************************************************************
* look for a point to start the nnext path
*********************************************************************/
  Do Until neighbors>0                 /* loop until one is found   */
    n=pl.0                             /* number of points recorded */
    s=random(1,n)                      /* pick a random index       */
    Parse Var pl.s is js               /* its coordinates           */
    neighbors=neighbors(is,js)         /* count free neighbors      */
    If neighbors=0 Then Do             /* if there is none          */
      pl.s=pl.n                        /* remove this point         */
      pl.0=pl.0-1
      End
    End
  Return is js                         /* return the new start point*/