Skip to content

Instantly share code, notes, and snippets.

@adumont
Last active May 9, 2022 11:21
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save adumont/5efc97e5603ceb1d75d79cfcbfc91bd7 to your computer and use it in GitHub Desktop.
Save adumont/5efc97e5603ceb1d75d79cfcbfc91bd7 to your computer and use it in GitHub Desktop.
Cellular Automaton in (my) FORTH
\ This is a FORTH program to draw Cellular Automaton
\ usage: RUN-CA ( RULE LINES -- )
\ Author: Alexandre Dumont
\ Runs in my own FORTH for 6502
\ https://github.com/adumont/hb6502/tree/main/forth
HEX
3F CONSTANT MXCOL
VARIABLE L1 MXCOL ALLOT
VARIABLE L2 MXCOL ALLOT
VARIABLE RULE
\ array with 2^0 to 2^7
CREATE POW
1 C, 2 C, 4 C, 8 C, 10 C, 20 C, 40 C, 80 C,
: 2^ POW + C@ ;
: NTHBIT 2^ AND 0= 0= 1 AND ;
: INIT-L1 MXCOL 1+ 0 DO 0 L1 I + C! LOOP 1 L1 MXCOL 1+ 2/ + C! ;
: X CHAR X EMIT ; \ changed to emit O (4F) instead of X (58)
: L1@ L1 + C@ ;
: PRT-L1 CR MXCOL 1+ 0 DO I L1@ IF X ELSE SPACE THEN LOOP ;
: getcol
>R
R@ 0= IF MXCOL ELSE R@ 1 - THEN L1@ IF 4 ELSE 0 THEN
R@ L1@ IF 2 ELSE 0 THEN OR
R@ MXCOL = IF 0 ELSE R@ 1+ THEN L1@ IF 1 ELSE 0 THEN OR
R>
DROP
;
: nextgen MXCOL 1+ 0 DO RULE @ I getcol NTHBIT L2 I + C! LOOP ;
: PRT-L2 CR MXCOL 1+ 0 DO I L2 + C@ IF X ELSE SPACE THEN LOOP ;
: L2>L1 L2 L1 MXCOL 1+ CMOVE ;
: CLEAR 20 0 DO CR LOOP ;
: RUN-CA CLEAR SWAP RULE C!
INIT-L1 PRT-L1
0 DO nextgen L2>L1 PRT-L1 LOOP CR ;
DEC
30 28 RUN-CA
75 28 RUN-CA
126 28 RUN-CA
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment