Wireworld: Difference between revisions

111 bytes removed ,  7 years ago
→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, elided a non-used function.
No edit summary
(→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, elided a non-used function.)
Line 4,598:
 
=={{header|REXX}}==
<lang rexx>/*REXX program displays a wire world Cartesian grid of four─state cells. */
signal on halt /*handle any cell growth interruptus. */
parse arg iFID . '(' generations rows cols bare head tail wire clearScreen reps
if iFID=='' then iFID= "WIREWORLD.TXT" /*should default input file be used? */
blank bla = 'BLANK' /*the "name" for a blank. */
generations = p(generations 100 ) /*number generations that are allowed. */
rows = p(rows 3 ) /*the number of cell rows. */
cols = p(cols 3 ) /* " " " " columns. */
bare = pickChar(bare blankbla ) /*an empty cell character. */
clearScreen = p(clearScreen 0 ) /*1 means to clear the screen. */
head = pickChar(head 'H' ) /*pick the character for the head. */
tail = pickChar(wiretail . 't' ) /* " " " " " wiretail. */
wire = pickChar(wire . ) /* " " " " " wire. */
reps = p(reps 2 ) /*stop program if there are 2 repeats.*/
fents=max(cols, linesize() - 1,cols) /*the fence width used after displaying*/
#reps=0; $.=bare /*at start, universe is new and barren.*/
gens=abs(generations) /*use for convenience (and short name).*/
/* [↓] read the input file. */
do r=1 while lines(iFID)\==0 /*keep reading until the End─Of─File. */
q=strip(linein(iFID), 'T'); L=length(q) /*get singlea line from the input file.; get len.*/
_cols=lengthmax(qcols, L) /*obtaincalculate themaximum lengthnumber of this (input)columns. row*/
cols=max(cols, _) do c=1 for L; $.r.c=substr(q, c, 1); end /*c*/ /*calculateassign the maximum number ofrow colscells.*/
do c=1 for _; $.r.c=substr(q, c, 1); end /*assign the row cells.*/
end /*r*/
rows=r-1 /*adjust the row number (from DO loop).*/
life=0; !.=0; call showCells /*display initial state of the cells. */
/*watch cells evolve, 4 possible states*/
do life=1 for gens; @.=bare /*perform for the number of generations*/
 
do r=1 for rows /*process each of the rows. */
do c=1 for cols; ?=$.r.c; ??=? /* " " " " columns. */
Line 4,631 ⟶ 4,630:
when ?==head then ??=tail
when ?==tail then ??=wire
when ?==wire then do; n#=hood(); if n#==1 | n#==2 then ??=head; end
otherwise nop
end /*select*/
Line 4,644 ⟶ 4,643:
halt: if life-1\==gens then say 'The ~~~Wireworld~~~ program was interrupted.'
done: exit /*stick a fork in it, we are all done.*/
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
$: parse arg _row,_col; return return ($._row._col==head)
assign$: do r=1 for rows; do c=1 for _cols; $.r.c=substr(q, @.r.c, 1); end; end; /*assign the row cells.*/return
hood: 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) /*pick the 1st word in list.*/
pickChar: _=p(arg(1));L=length(_);if translate(_)==blankbla then _=' ';if length(_)L==3 then _=d2c(_);if length(_)L==2 then _=x2c(_);return _
showRows: _=; do r=1 for rows; z=; do c=1 for cols; z=z || $.r.c; end; z=strip(z,'T'); say z; _=_ || z; end; return</lang>
/*──────────────────────────────────────────────────────────────────────────────────────*/
showCells: if clearScreen then 'CLS' /*◄──change this for the OS.*/
call showRows /*show rows in proper order.*/
say right( copies('═', fents)life, fents) /*display a bunch of cells. */
if _=='' then signal done then signal done /*No life? Then stop run. */
if !._ then #reps=#reps+1 then #reps=#reps+1 /*detected repeated pattern.*/
!._=1 /*it is's now existence state. */
if reps\==0 & #reps<=reps then return /*so far, so good, no reps. */
say '"Wireworld" repeated itself' reps "times, program is stopping."
signal done /*exitjump program,to wethis pgm'res done"exit". */</lang>
/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
$: parse arg _row,_col; return ($._row._col==head)
assign$: do r=1 for rows; do c=1 for cols; $.r.c=@.r.c; end; end; return
err: say; say center(' error! ',max(40,linesize()%2),"*"); say; do j=1 for arg(); say arg(j); say; end; say; exit 13
hood: 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));if translate(_)==blank then _=' ';if length(_)==3 then _=d2c(_);if length(_)==2 then _=x2c(_);return _
showRows: _=; do r=1 for rows; z=; do c=1 for cols; z=z || $.r.c; end; z=strip(z,'T'); say z; _=_ || z; end; return</lang>
Programming note: &nbsp; the &nbsp; '''hood''' &nbsp; subroutine (above) could be optimized for speed by setting some short-circuit values &nbsp; <code>('''r-1''', '''c-1''', '''r+1''', and '''c+1''') </code> &nbsp; and using those values in the subsequent expressions.