;
; IPL version of "Conway's Game of Life"
; Requires extra.ipl, (hp)screen.ipl, mkword.ipl
; 7/7/07  quick hack 20x20 cell version, no boring detect
; 8/1/07  20x37 arrays, if pattern stabilizes repeats random start
; 8/11/07 added pattern edit mode... pattern must stabilize before
; editor is recalled, removed ttyscan stuff.. set SR bit to halt
; 8/21/07 - if ttyscan/get exists, uses for space stop
; otherwise uses SR bit.. exits to edit mode. then press Q to quit
; Last mod 8/25/07 - bugfix, randomize rnd
; 
; block 0 = states (ascii 32 or 79 dec)
; block 1 = new counts
; block 2 = old counts to reference
; all arrays 38 words guard, 740 words cells, 38 words guard.
;
; Uses locations 110-121
; 110 - current population count
; 111 - last population count
; 112 - population before that
; 113 - number of times "boring" in a row (177777=exit flag)
; 114 - flag to make "or" comparison
; Pattern deemed "boring" if loc 110 = 111 or 110 = 112 for 10 cycles
; 115 - generation count
; 116 - flag for edit mode
; 117 - for edit
; 120 - address of TTYSCAN (or 0)
; 121 - address of TTYGET (or 0)
;
"LIFE" MKWORD ;requires mkword word
DECIMAL VARIABLE COFFSET 8
COFFSET DUP -38 PUT
INC DUP -37 PUT
INC DUP -36 PUT
INC DUP -1 PUT
INC DUP 1 PUT
INC DUP 36 PUT
INC DUP 37 PUT
INC 38 PUT
; COFFSET is set in immediate mode, must remain intact
;
OCTAL DEFINE INCCELLS
;increment surrounding counts around location in block 1
#0 7 +DO ;loop thru all COFFSET values
 DUP COFFSET INDEX ADD GET ADD ;new offset
 DUP #1 BGET INC ;get and increment value
 SWAP #1 BPUT ;write back
+LOOP
DROP ;index
110 DUP GET INC PUT ;increment population
END
;
OCTAL DEFINE DECCELLS
;decrement surrounding counts around location in block 1
#0 7 +DO ;loop thru all COFFSET values
 DUP COFFSET INDEX ADD GET ADD ;new offset
 DUP #1 BGET DEC ;get and decrement value
 SWAP #1 BPUT ;write back
+LOOP
DROP ;index
110 DUP GET DEC PUT ;decrement population
END
;
OCTAL DEFINE SHOWCELLS
;display current generation...
#0 23 +DO ;20 lines
 INDEX DUP INC INC 3 POS ;position cursor (keep index)
 #0 44 +DO ;37 columns
  DUP 45 MUL INDEX ADD 46 ADD ;point to array offset
  #0 BGET PCHR 40 PCHR ;print it and a space
 +LOOP
 DROP ;prev index
+LOOP
END
;
OCTAL DEFINE MAIN
"*** Conway's Game of Life ***" $PRINT CRLF
116 ;location of edit/random flag
"Edit starting pattern? " $PRINT CHRIN CRLF
131 SUB IFZ #1 ELSE #0 ENDIF PUT ;set flag to 1 if edit else 0
CLS "." $PRINT 113 55 $CREATE $PRINT "." $PRINT CRLF
#1 24 +DO "|" $PRINT 113 40 $CREATE $PRINT "|" $PRINT CRLF +LOOP
"`" $PRINT 113 55 $CREATE $PRINT "'" $PRINT
117 605 PUT ;default edit location.. X=18 Y=9
#0 ZEROBLOCK #1 ZEROBLOCK ;clear arrays
110 115 +DO INDEX #0 PUT +LOOP ;zero zp vars up to gen.count
120 "TTYSCAN" $DEFADR PUT ;get address of TTYSCAN (0 if not present)
121 "TTYGET" $DEFADR PUT  ;get address of TTYGET (or 0)
120 GET IFZ 121 #0 PUT ENDIF
121 GET IFZ 120 #0 PUT ENDIF  ;both must exist
116 GET IFZ ;if random mode, randomize...
 #0 ;to use for +DO loop
 #0 ;to sum zp
 2 1777 +DO INDEX GET ADD +LOOP ;add up all of zp
 377 AND ;reduce to a number between 0 and 255
 +DO RND DROP +LOOP ;call 1 to 256 RNDs
ENDIF
DO ;until program terminates
 116 GET IFZ ;if random mode
  #0 ZEROBLOCK #1 ZEROBLOCK ;clear arrays
  110 115 +DO INDEX #0 PUT +LOOP ;zero zp vars up to gen.count
  ;generate random start as ascii and counts in new counts...
  46 1411 +DO ;loop thru all cells
   RND IF<0  ;if to be "on"
    110 DUP GET INC PUT ;increment population
    INDEX INCCELLS ;increment surrounding counts in block 1
    117 INDEX #0 BPUT ;write ascii 79 to block 0
   ELSE
    40 INDEX #0 BPUT ;write space to block 0
   ENDIF
  +LOOP
 ELSE ;edit mode...
  113 #0 PUT ;reset boring counter
  115 #0 PUT ;clear generation count
  27 #1 POS ;position to end of screen
  ;change zero'd array loc's to spaces...
  46 1411 +DO ;loop thru all cells
   INDEX #0 BGET IFZ ;if zero
    40 INDEX #0 BPUT ;change to space
   ENDIF
  +LOOP
  "2468) Move  Space) Change state  Enter) Generate  Q) Quit" $PRINT
  22 40 $CREATE $PRINT
  DO ;until enter gets pressed
   ;position cursor to edit location...
   ;T=(117) - 46 (38 dec)
   ;Y=T/45 (37 dec)
   ;X=T-Y*45
   ;Cursor X = X * 2 + 3
   ;Cursor Y = Y + 2
   117 GET 46 SUB DUP 45 DIV ;stack = T, Y
   OVER OVER 45 MUL SUB ;stack = T, Y, X
   2 MUL 3 ADD ;change X to cursor X
   SWAP INC INC SWAP ;change Y to cursor Y
   POS DROP ;position, drop T
   CHRIN ;get a keystroke
   DUP 15 SUB IFNZ ;if not a CR
    10 PCHR 117 GET #0 BGET PCHR ;restore char erased by keystroke
   ENDIF
   CASE ;on key...
   = 62 ;2, down
     117 DUP GET 45 ADD PUT ;add 37 dec to location 117
     1411 ;max location
     117 GET SUB IF<0 ;if past
      117 DUP GET 1344 SUB PUT ;wrap to top
     ENDIF
     #0 ;don't exit loop
   = 64 ;4, left
     117 DUP GET DEC PUT ;subract 1
     117 GET 46 SUB IF<0 ;if too low
      117 DUP GET 1344 ADD PUT ;wrap to end
     ENDIF
     #0 ;don't exit loop
   = 66 ;6, right
     117 DUP GET INC PUT ;add 1
     1411 ;max location
     117 GET SUB IF<0 ;if past
      117 DUP GET 1344 SUB PUT ;wrap to top
     ENDIF
     #0 ;don't exit loop
   = 70 ;8, up
     117 DUP GET 45 SUB PUT ;subtract 37 dec to location 117
     117 GET 46 SUB IF<0 ;if too low
      117 DUP GET 1344 ADD PUT ;wrap to end
     ENDIF
     #0 ;don't exit loop
   = 40 ;space, change state
     117 GET #0 BGET 40 SUB IFZ ;if space then
      117 DUP 10 PCHR PCHR ;ascii O
      117 GET #0 BPUT ;change to live cell
      117 GET INCCELLS ;increment counts
     ELSE
      40 DUP 10 PCHR PCHR ;ascii space
      117 GET #0 BPUT ;change to dead cell
      117 GET DECCELLS ;decrement counts
     ENDIF
     #0 ;don't exit loop
   = 15 ;enter, generate
     #1 ;exit loop and generate
   = 121 ;Q, quit
     113 177777 PUT ;signify intention
     #1 ;exit loop and quit
   DEFAULT #0 ;invalid key do nothing
   ENDCASE
  UNTIL ;enter is pressed
  27 #1 POS 113 40 $CREATE $PRINT ;erase menu
 ENDIF
 113 GET 177777 SUB IFNZ ;if not a quit action
  120 GET IFZ #0 S>SR ENDIF ;if no TTYSCAN reset switch registers
  DO  ;until boring
   SHOWCELLS ;display current generation
   27 #1 POS ;set cursor to end of screen
   ;print generation count, inc generation count
   "Generation: " $PRINT
   115 DUP GET DUP DECIMAL PNUM OCTAL INC PUT
   "     " $PRINT 27 67 POS 
   120 GET DUP IFNZ ;if ttyscan exists
    "(press space to stop) " $PRINT 
    EXECUTE ;run ttyscan
   ELSE
    DROP " (set SR bit to stop) " $PRINT
   ENDIF
   ;rotate population counts...
   112 111 GET PUT 111 110 GET PUT
   ;copy newcounts block 1 to oldcounts block 2...
   #0 1457 +DO INDEX #1 BGET INDEX 2 BPUT +LOOP
   ;generate life in ascii and newcounts, using ascii/oldcounts
   46 1411 +DO
    ;rules are...
    ;if count < 2 or count > 3 then next state = off
    ;if count = 2 then retains previous state
    ;if count = 3 then state = on regardless of prev state
    ;if state switches off to on, increment surrounding counts
    ;if state switches on to off, decrement surrounding counts
    INDEX #0 BGET ;push previous state
    INDEX 2 BGET ;push previous count
    CASE ;on count
    = 3 117 ;if 3 then "on"
    = 2 DUP ;if 2 assumes prev state
    DEFAULT 40 ;otherwise "off"
    ENDCASE
    OVER OVER SUB IFNZ ;if state changed then
     DUP INDEX #0 BPUT ;update cell array
     DUP 117 SUB IFZ
      INDEX INCCELLS ;if turning on increment
     ELSE
      INDEX DECCELLS ;if turning off decrement
     ENDIF
    ENDIF
    DROP DROP ;oldstate newstate
   +LOOP
   ;check for exit conditions
   121 GET DUP IFNZ ;if ttyget exists
    EXECUTE ;run it
   ELSE DROP SR>S ENDIF ;otherwize get switches
   ;stop to the edit screen, which has a Quit
   DUP IFNZ ;if user stop requested
    113 12 PUT ;set repeat counter to magic value (10 dec)
    116 #1 PUT ;select edit mode
   ELSE ;check for "boring" population fluctuation
    114 #0 PUT ;reset hit flag
    110 GET 111 GET SUB IFZ 114 #1 PUT ENDIF ;if pop <> prev
    110 GET 112 GET SUB IFZ 114 #1 PUT ENDIF ;and <> before that
    114 GET IFZ 113 #0 PUT ELSE              ;reset boring counter
     113 DUP GET INC PUT                     ;otherwise increment
     113 GET 12 SUB IFZ ;if repeat count reaches 10 dec
      DROP #1 ;exit generation loop and repeat
     ENDIF
    ENDIF
   ENDIF
  UNTIL ;generation loop exits
  SHOWCELLS ;display final generation
 ENDIF
 ;check for boring repeat
 113 GET 12 SUB
UNTIL ;not a repeat, user exited
27 #1 POS 113 40 $CREATE $PRINT
26 #1 POS ;set cursor to end of screen - 1 for crlf
END
ENDWORD
;
CONSOLE