Source code in the rexx programming language

/*REXX program runs and displays the Conway's game of life, it stops after  N  repeats. */
signal on halt                                   /*handle a  cell growth  interruptus.  */
parse arg peeps  '(' rows  cols  empty  life!  clearScreen  repeats  generations .
       rows =        p(rows               3)     /*the maximum number of cell  rows.    */
       cols =        p(cols               3)     /* "     "       "    "   "  columns.  */
        emp = pickChar(empty        'blank')     /*an empty cell character  (glyph).    */
   clearScr =        p(clearScreen        0)     /* "1"   indicates to clear the screen.*/
      life! = pickChar(life!            '☼')     /*the gylph kinda looks like an amoeba.*/
       reps =        p(repeats            2)     /*stop pgm  if there are  two  repeats.*/
generations =        p(generations      100)     /*the number of  generations  allowed. */
sw= max(linesize() - 1,  cols)                   /*usable screen width for the display. */
#reps= 0;        $.= emp                         /*the universe is new,  ··· and barren.*/
gens=abs(generations)                            /*used for a  programming  convenience.*/
x= space(peeps); upper x                         /*elide superfluous spaces; uppercase. */
if x==''         then x= "BLINKER"               /*if nothing specified,  use  BLINKER. */
if x=='BLINKER'  then x= "2,1 2,2 2,3"
if x=='OCTAGON'  then x= "1,5 1,6 2,4 2,7 3,3 3,8 4,2 4,9 5,2 5,9 6,3 6,8 7,4 7,7 8,5 8,6"
call assign.                                     /*assign the initial state of all cells*/
call showCells                                   /*show the  initial state of the cells.*/
     do life=1  for gens;      call assign@      /*construct  next  generation of cells.*/
     if generations>0 | life==gens  then call showCells    /*should cells be displayed? */
     end   /*life*/                              /* [↑]  cell colony grows, lives, dies.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
showCells: if clearScr  then 'CLS'               /*  ◄───  change 'command' for your OS.*/
           call showRows                         /*show the rows in the proper order.   */
           say right(copies('▒', sw)  life, sw)  /*show a fence between the generations.*/
           if _==''  then exit                   /*if there's no life, then stop the run*/
           if !._    then #reps= #reps + 1       /*we detected a repeated cell pattern. */
           !._= 1                                /*existence  state and compare  later. */
           if reps\==0 & #reps<=reps then return /*so far, so good,   regarding repeats.*/
           say
           say center('"Life" repeated itself' reps "times, simulation has ended.",sw,'▒')
           exit                                  /*stick a fork in it,  we're all done. */
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
$:         parse arg _row,_col;                    return $._row._col==life!
assign$:   do r=1  for rows;   do c=1  for cols;   $.r.c= @.r.c;                                    end;    end;       return
assign.:   do while x\==''; parse var x r "," c x; $.r.c=life!; rows=max(rows,r); cols=max(cols,c); end; life=0; !.=0; return
assign?:   ?=$.r.c; n=neighbors(); if ?==emp then do;if n==3 then ?=life!; end; else if n<2 | n>3 then ?=emp; @.r.c=?; return
assign@:   @.=emp;      do r=1  for rows;  do c=1  for cols;  call assign?;  end;  end;            call assign$;       return
halt:      say;         say "REXX program  (Conway's Life)  halted.";    say;      exit 0
neighbors: return $(r-1,c-1)  +  $(r-1,c)  +  $(r-1,c+1)  +  $(r,c-1)  +  $(r,c+1)  +  $(r+1,c-1)  +  $(r+1,c)  +  $(r+1,c+1)
p:         return word(arg(1), 1)
pickChar:  _=p(arg(1)); arg u .; if u=='BLANK' then _=" "; L=length(_); if L==3 then _=d2c(_); if L==2 then _=x2c(_);  return _
showRows:  _=; do r=rows by -1 for rows; z=; do c=1 for cols; z=z||$.r.c; end; z=strip(z,'T',emp); say z; _=_||z; end; return

/* REXX ---------------------------------------------------------------
* 02.08.2014 Walter Pachl
* Input is a file containing the initial pattern
* The compute area is extended when needed
*   (cells are born outside the current compute area)
* The program stops when the picture shown is the same as the first
*   or equal to the previous one
*--------------------------------------------------------------------*/
Parse Arg f
If f='' Then f='bipole'
fid=f'.in'
oid=f'.txt'; 'erase' oid
debug=0
If debug Then Do
  dbg=f'.xxx'; 'erase' dbg
  End
ml=0
l.=''
Do ri=3 By 1 While lines(fid)>0
  l.ri='  'linein(fid)
  ml=max(ml,length(strip(l.ri,'T')))
  End
ml=ml+2
ri=ri+1
yy=ri
If debug Then
  say 'ml='ml 'yy='yy
yb=1
a.=' '
b.=' '
m.=''
x.=''
Parse Value 1 ml 1 yy With xmi xma ymi yma
Parse Value '999 0' With xmin xmax
Parse Value '999 0' With ymin ymax

Do y=1 To yy
  z=yy-y-1
  l=l.z
  Do x=1 By 1 While l<>''
    Parse Var l c +1 l
    If c='*' Then Do
      a.x.z='*'
      End
    End
  End
Call show
Do step=1 To 60
  Call store
  If step>1 & is_equal(step,1) Then Leave
  If step>1 & is_equal(step,step-1) Then Leave
    Call show_neighbors
  Do y=yma To ymi By -1
    ol=format(x,2)' '
    Do x=xmi To xma
      neighbors=neighbors(x,y)
      If a.x.y=' ' Then Do             /* dead cell                  */
        If neighbors=3 Then Do
          b.x.y='*'                    /*  gets life                 */
          mmo=xmi xma ymi yma
          xmi=min(xmi,x-1)
          xma=max(xma,x+1)
          ymi=min(ymi,y-1)
          yma=max(yma,y+1)
          mm=xmi xma ymi yma
          If mm<>mmo Then
            Call debug mmo '->' mm
          End
        Else                           /* life cell                  */
          b.x.y=' '                    /*  remains dead              */

        End
      Else Do                          /* life cell                  */
        If neighbors=2 |,
           neighbors=3 Then b.x.y='*'  /*  remains life              */
                       Else b.x.y=' '  /*  dies                      */
        End
      End
    End
  /* b. is the new state and is now copied to a.                     */
  Do y=yma To ymi By -1
    Do x=xmi To xma
      a.x.y=b.x.y
      End
    End
  End
/* Output name and all states                                        */
Call lineout oid,' 'f
st=' +'                                /* top and bottom border      */
sb=' +'                                /* top and bottom border      */
Do s=1 To step
  st=st||'-'right(s,2,'-')||copies('-',xmax-xmin)'+'
  sb=sb||copies('-',xmax-xmin+3)'+'
  End
Call lineout oid,st                    /* top border                 */
Do y=ymin To ymax
  ol=''
  Do s=1 To step
    ol=ol '|' substr(m.s.y,xmin,xmax-xmin+1)
    End
  Call lineout oid,ol '|'
  End
Call lineout oid,sb                    /* bottom border              */
Call lineout oid
'type' oid
If debug Then Do
  Say 'original area' 1 ml '/' 1 yy
  Say 'compute area ' xmi xma '/' ymi yma
  End
Exit

set: Parse Arg x,y
     a.x.y='*'
     Return

neighbors: Procedure Expose a. debug
  Parse Arg x,y
  neighbors=0
  do xa=x-1 to x+1
    do ya=y-1 to y+1
      If xa<>x | ya<>y then
        If a.xa.ya='*' Then
          neighbors=neighbors+1
      End
    End
  Return neighbors

store:
/* store current state (a.) in lines m.step.*                        */
Do y=yy To 1 By -1
  ol=''
  Do x=1 To ml
    z=a.x.y
    ol=ol||z
    End
  x.step.y=ol
  If ol<>'' then Do
    ymin=min(ymin,y)
    ymax=max(ymax,y)
    p=pos('*',ol)
    q=length(strip(ol,'T'))
    If p>0 Then
      xmin=min(xmin,p)
    xmax=max(xmax,q)
    End
  m.step.y=ol
  Call debug '====>' right(step,2) y ol  xmin xmax
  End
Return

is_equal:
/* test ist state a.b is equal to state a.a                          */
  Parse Arg a,b
  Do y=yy To 1 By -1
    If x.b.y<>x.a.y Then
      Return 0
    End
  Return 1

show: Procedure Expose dbg a. yy ml debug
Do y=1 To yy
  ol='>'
  Do x=1 To ml
    ol=ol||a.x.y
    End
  Call debug ol
  End
Return

show_neighbors: Procedure Expose a. xmi xma ymi yma dbg debug
  Do y=yma To ymi By -1
    ol=format(y,2)' '

    Do x=xmi To xma
      ol=ol||neighbors(x,y)
      End
    Call debug ol
    End
  Return

debug:
  If debug Then
    Return lineout(dbg,arg(1))
  Else
    Return