( CAM 5.1 IBM-PC USERS SOFTWARE 04/17/84 ) ( Initialization ) EX"INIT" START STEPPING : TASK ; 7 SCR ! K ( System messages ) empty stack dictionary full has incorrect address mode is redefined is undefined disk address out of range stack overflow disk error BASE must be DECIMAL missing decimal point PC/FORTH 2.0 Laboratory Microsystems ( System messages ) compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary illegal dimension in array definition negative array index array index too large ( 8086 Assembler messages ) 16 bit register not allowed 8 bit register not allowed address out of range immediate data value not allowed missing source register missing destination register illegal operation illegal operand instruction not implemented illegal destination register illegal source register illegal condition code register mismatch destination address missing ( Packard's LIFE experiment ) FORGET TASK : TASK ; : RULE0 LRULE CENTER1 XOR ; : RULE1 EAST CENTER XOR WEST XOR ; : Packard's.experiment ". ['] RULE0 1 0 TAB! ['] RULE1 5 0 TAB! 1 TO P0# 1 TO P1# ; : f9 & ; .( LIFE on plane 0, horizontal sum-mod-two on plane 1. ) CR .( Attached to key f9 ) CR ( DONAHUE ) FORGET TASK : TASK ; : FOO NORTH SOUTH EAST WEST CENTER + + + + ; : BAR N.EAST N.WEST S.EAST S.WEST CENTER1 + + + + ; : BECH FOO BAR < IF 0 ELSE 1 THEN ; : BAZ FOO BAR + 3 < IF 1 ELSE NORTH SOUTH CENTER CENTER1 AND AN D AND THEN ; : RULE BECH BAZ XOR ; f1 ( Ordering, Nucl, Perc. ) FORGET TASK : TASK ; : 8SUM NORTH SOUTH + WEST + EAST + N.WEST + N.EAST + S.WEST + S.EAST + ; : H35678 8SUM DUP 4 > SWAP 3 = OR ; : >3/9 8SUM CENTER + 3 > ; : >4/9 8SUM CENTER + 4 > ; : M46789 8SUM CENTER + DUP 5 > SWAP 4 = OR ; : Ordering ". ['] M46789 1 0 TAB! Echo 1 TO P0# 1 TO P1# ; : f6 & ; .( Ordering ) : Nucleation ". ['] >3/9 1 0 TAB! Echo 1 TO P0# 1 TO P1# ; : f8 & ; .( Nucleation ) : Percolation ". ['] >4/9 1 0 TAB! Echo 1 TO P0# 1 TO P1# ; : f10 & ; .( Percolation ) : Circular.growth ". ['] H35678 1 0 TAB! Echo 1 TO P0# 1 TO P1# ; : f4 & ; .( Circular growth ) CR ( Gerard's >3/9 ) FORGET TASK : TASK ; ( NERDS ) FORGET TASK : TASK ; : RULE NORTH SOUTH + WEST + EAST + CENTER + DUP 5 = SWAP 0= OR NOT CENTER1 XOR ; f1 ( SCRAMBLE ) FORGET TASK : TASK ; : 1XOR 1 XOR ; : RULE NORTH 1XOR EAST 1XOR + SOUTH 1XOR + WEST + DUP 1 = SWAP 2 = OR CENTER1 XOR ; f1 ( SUM 5 NEIGHBOURS ) FORGET TASK : TASK ; : 0STD! 1 TO P0# 1 0 TAB! ; ( cfa.rule --) CASE: 5SUM 0 1 0 1 0 1 ; : MOD2 NORTH SOUTH + WEST + EAST + CENTER + 5SUM ; : Sum.mod.2 ". ['] MOD2 0STD! ; : f8 & ; .( Sum mod 2 ) CR : MOD2C N.WEST N.EAST + S.WEST + S.EAST + CENTER + 5SUM ; : Sum.mod.2.corners ". ['] MOD2C 0STD! ; : f10 & ; .( Sum mod 2 corners ) CR ( H3 ) FORGET TASK : TASK ; : RULE NORTH SOUTH EAST WEST N.EAST S.WEST + + + + + 3 = CENTER1 XOR ; ( CHEQUER ) FORGET TASK : TASK ; : RULE N.WEST S.WEST N.EAST S.EAST CENTER OR OR OR OR ; ( or9 ) FORGET TASK : TASK ; : RULE CENTER NORTH SOUTH EAST WEST N.WEST N.EAST S.WEST S.EAST OR OR OR OR OR OR OR OR ; ( SAME8 ) FORGET TASK : TASK ; : RULE NORTH SOUTH EAST WEST N.EAST N.WEST S.EAST S.WEST + + + + + + + DUP 8 = SWAP 0 = OR CENTER1 XOR ; ( BB WITH BOUNDARIES ) FORGET TASK : TASK ; HEX 13 0 DECIMAL NUMARG 2! -1 NUMFLG ! 4 0 TAB>BUF : BBUG CENTER1 IF CENTER NOT ELSE KBUF X@ + C@ THEN ; ' BBUG 4 0 TAB! f9 ( ) FORGET TASK : TASK ; : DIS ' >BODY DUP 60 + SWAP DO I @ >NAME .NAME 2 +LOOP ; ( X2 ) FORGET TASK : TASK ; : RULE N.EAST N.WEST S.EAST S.WEST + + + 2 = CENTER1 XOR ; ( SECOND ORDER ) FORGET TASK : TASK ; ( f7 ." Alt-Order " P0# 2 XOR TO P0# ) 1 0 TAB>BUF : RULE X@ KBUF + C@ CENTER1 XOR ; ( ALLBUTNS ) FORGET TASK : TASK ; : RULE N.EAST N.WEST S.EAST S.WEST EAST WEST + + + + + 3 = CENTER1 XOR ; ( ) FORGET TASK : TASK ; ( BBM-BOTH PLANES) FORGET TASK : TASK ; 0 == C0 1 == X0 2 == Y0 3 == Z0 4 == T0 9 == C1 6 == X1 7 == Y1 8 == Z1 : Init.phase ". 0 TO PH# ; : & ; : RULE0.TAB! LIT" RULE0" FIND IF ROT ROT TAB! ELSE DROP ." No RULE0 defined" 2DROP THEN ; : RULE1.TAB! LIT" RULE1" FIND IF ROT ROT TAB! ELSE DROP ." No RULE1 defined" 2DROP THEN ; : BBM01 0 TO P0# 0 TO P1# 4 0 RULE0.TAB! 7 0 RULE1.TAB! ; : RAND1 C1 X1 Y1 Z1 XOR XOR XOR ; : KC1 C1 Z1 = X1 Y1 = AND ; : KC0 C0 Z0 = X0 Y0 = AND ; ( SOLID2 ) 24 LOAD : S0 C0 X0 Y0 Z0 + + + ; : S1 C1 X1 Y1 Z1 + + + ; : K0 S0 0= S1 3 = AND ; : K1 S0 4 = S1 1 = AND ; : RULE0 Z0 KC0 IF DROP X0 THEN K0 IF DROP 1 THEN K1 IF DROP 0 THEN ; : RULE1 C1 K0 K1 OR IF DROP 1 Z1 - THEN ; BBM01 ( SOLID1 ) 24 LOAD : KK C0 C1 + 1 = Z0 C0 = Z1 C1 = X0 Y0 + 1 = X1 Y1 + 1 = AND AND AND AND ; : RULE0 Z0 KC0 IF DROP X0 THEN KK IF DROP C1 THEN ; : RULE1 C1 KK IF DROP C0 THEN ; BBM01 ( STAGNO) : S9 CENTER NORTH SOUTH WEST EAST + + + + N.WEST N.EAST S.WEST S.EAST + + + + ; : RULE 1 CENTER1 - S9 DUP 9 - * 0= IF DROP CENTER1 THEN ; ( A-BOMB) 24 LOAD : KN C0 X0 Y0 Z0 + + + C1 X1 Y1 Z1 + + + * 0> ; : KC C0 C1 * X0 X1 * Y0 Y1 * Z0 Z1 * + + + 0> ; : EXPL X1 Y1 + X1 Y1 * - ; : RULE0 C0 KN IF DROP 0 THEN KC IF DROP 0 THEN C0 C1 * 1 = IF DROP 1 THEN ; : RULE1 Z1 KN IF DROP EXPL THEN KC IF DROP 0 THEN C0 C1 * 1 = IF DROP 1 THEN ; BBM01 ( PUCCIO1) 24 LOAD : K7 C0 C1 * X0 X1 * Y0 Y1 * Z0 Z1 * + + + 0<> ; : K71 C0 C1 X0 1 X1 Y0 Y1 Z0 Z1 + + + + + * * * 1 = ; : K72 X0 X1 Z0 1 C0 C1 Y0 Y1 Z1 + + + + + * * * 1 = ; : K73 Z0 Z1 Y0 1 Y1 C0 C1 X0 X1 + + + + + * * * 1 = ; : K74 Y0 Y1 C0 1 C1 X0 X1 Z0 Z1 + + + + + * * * 1 = ; : K81 X0 X1 Y0 1 C0 C1 Z0 Z1 Y1 + + + + + * * * 1 = ; : K82 Z0 Z1 C0 1 X0 X1 Y0 Y1 C1 + + + + + * * * 1 = ; : K83 Y0 Y1 X0 1 Z0 Z1 C0 C1 X1 + + + + + * * * 1 = ; : K84 C0 C1 Z0 1 Y0 Y1 X0 X1 Z1 + + + + + * * * 1 = ; --> : RULE0 Y1 ( X1 Z1 + Z1 Y1 + Y1 C1 + * * 1 = IF DROP C1 THEN ) K7 IF DROP Z0 THEN K71 IF DROP 0 THEN K72 IF DROP 1 THEN K73 IF DROP 0 THEN K74 IF DROP 1 THEN K81 IF DROP 0 THEN K82 IF DROP 1 THEN K83 IF DROP 1 THEN K84 IF DROP 0 THEN ; : RULE1 X0 ( X0 Y0 + Z0 Y0 + Y0 C0 + * * 1 = IF DROP C0 THEN ) K7 IF DROP Z1 THEN K71 IF DROP 0 THEN K72 IF DROP 1 THEN K73 IF DROP 0 THEN K74 IF DROP 0 THEN K81 IF DROP 0 THEN K82 IF DROP 0 THEN K83 IF DROP 1 THEN K84 IF DROP 0 THEN ; BBM01 ( PUCCIO 3) 24 LOAD : KS C0 Z1 1 + + C1 Z1 1 + + X0 Y1 1 + + X1 Y0 1 + + * * * 3 = C0 C1 1 + + X0 X1 1 + + Y0 Y1 1 + + Z0 Z1 1 + + * * * 3 = OR ; : RULE0 X1 X0 Z0 + Z0 Y0 + Y0 C0 + * * 1 = IF DROP C1 THEN KS IF DROP Z0 THEN ; : RULE1 Y0 X1 Z1 + Z1 Y1 + Y1 C1 + * * 1 = IF DROP C0 THEN KS IF DROP Z1 THEN ; BBM01 ( GASHV: horizontal/vertical gas with collisions) 24 LOAD ( rotate right/left depending on time phase; do collisions) : RULE0 KC0 IF C0 ELSE T0 0= IF Y0 ELSE X0 THEN THEN ; ( echo) : RULE1 CENTER ; BBM01 ( DIFFUSION: on P0, driven by noise on P1) 24 LOAD ( rotate right/left depending on noise) : RULE0 T0 RAND1 XOR 0= IF Y0 ELSE X0 THEN ; ( diagonal gas, w/collisions) : RULE1 KC1 IF X1 ELSE Z1 THEN ; BBM01 ( GASHV.RG: red/green H/V gas with collisions) 24 LOAD ( rotate right/left depending on time phase; do collisions) : RULE0 KC0 IF C0 ELSE T0 0= IF Y0 ELSE X0 THEN THEN ; ( echo) : RULE1 KC0 IF C1 ELSE T0 0= IF Y1 ELSE X1 THEN THEN ; BBM01 ( DOUBLE GAS etoile on P0 and P1) 24 LOAD : KK C0 X0 Y0 Z0 + + + 1+ C1 X1 Y1 Z1 + + + 1+ * 5 = ; ( rotate right/left w/collisions ) : RULE0 KC0 IF C0 ELSE T0 0= IF Y0 ELSE X0 THEN THEN KK IF DROP C1 THEN ; ( diagonal gas, w/collisions) : RULE1 KC1 IF X1 ELSE Z1 THEN KK IF DROP C0 THEN ; BBM01 ( CASEN ) FORGET TASK : TASK ; : NSUM NORTH SOUTH EAST WEST N.WEST N.EAST S.WEST S.EAST CENTER + + + + + + + + ; : CASEN NSUM 0 = IF 0 ELSE NSUM 1 = IF 0 ELSE NSUM 2 = IF 1 ELSE NSUM 3 = IF 0 ELSE NSUM 4 = IF 0 ELSE NSUM 5 = IF 0 ELSE NSUM 6 = IF 0 ELSE NSUM 7 = IF 0 ELSE NSUM 8 = IF 0 ELSE NSUM 9 = IF 0 ELSE THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN ; ( BRAIN ) 36 LOAD : CENTERS CENTER1 2 * CENTER + ; : FEEP CENTERS 0 = IF 1 ELSE CENTERS 1 = IF 0 ELSE CENTERS 2 = IF 0 ELSE CENTERS 3 = IF 0 ELSE THEN THEN THEN THEN ; : RULE CASEN FEEP AND ; f1 ( READY ) FORGET TASK : TASK ; : CENTERS CENTER1 2 * CENTER + ; : READY CENTERS 0 = IF 1 ELSE CENTERS 1 = IF 0 ELSE CENTERS 2 = IF 0 ELSE CENTERS 3 = IF 0 ELSE THEN THEN THEN THEN ; ( GREENBURG ) 38 LOAD : RULE CENTER NORTH SOUTH WEST EAST OR OR OR OR READY AND ; f1 ( RUGS ) FORGET TASK : TASK ; : RULE NORTH SOUTH EAST WEST CENTER XOR XOR XOR XOR ; f1 ( TRIANGLES! ) 38 LOAD : ZINES NORTH WEST EAST SOUTH XOR XOR XOR ; : RULE READY ZINES NORTH XOR AND ; f1 ( NSUM ) FORGET TASK : TASK ; : NSUM NORTH SOUTH EAST WEST N.WEST N.EAST S.WEST S.EAST CENTER + + + + + + + + ; : FROB NSUM 0 = IF 0 ELSE NSUM 1 = IF NORTH ELSE NSUM 2 = IF 0 ELSE NSUM 3 = IF 0 ELSE NSUM 4 = IF SOUTH ELSE NSUM 5 = IF 0 ELSE NSUM 6 = IF 1 ELSE NSUM 7 = IF 1 ELSE NSUM 8 = IF 1 ELSE NSUM 9 = IF 1 ELSE THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN ; ( BOUNCE ) 42 LOAD : ZING FROB CENTER1 XOR 1 = IF 1 ELSE 0 THEN ; : RULE ZING ; f1 ( TRAFFIC ) FORGET TASK : TASK ; : ZING N.EAST S.EAST N.WEST S.WEST CENTER + + + + ; : ZOING NORTH SOUTH EAST WEST XOR XOR XOR ; : EH ZING 2 > IF ZOING ELSE 1 THEN ; : RULE EH ; f1 ( STRIPES ) FORGET TASK : TASK ; : ZOT S.WEST S.EAST CENTER + + ; : ZING ZOT 2 < IF 1 ELSE 0 THEN ; : RULE ZING ; f1 ( VAGINAL DISCHARGE ) FORGET TASK : TASK ; : ZING N.EAST S.EAST N.WEST S.WEST CENTER + + + + ; : ZOING NORTH SOUTH EAST WEST XOR XOR XOR ; : EH ZING ZOING XOR IF ZING ELSE 0 THEN ; : RULE EH ; f1 ( SERIF ) FORGET TASK : TASK ; : SERIF CENTER IF 1 ELSE NORTH SOUTH EAST WEST N.EAST N.WEST S.EAST S.WEST + + + + + + + 7 - IF 0 ELSE NORTH IF N.EAST N.WEST XOR ELSE SOUTH IF S.EAST S.WEST XOR ELSE EAST IF N.EAST S.EAST XOR ELSE WEST IF N.WEST S.WEST XOR ELSE WEST THEN THEN THEN THEN THEN THEN ; : RULE SERIF ; f1 ( DOT ) FORGET TASK HEX CREATE MASKS 1 C, 2 C, 4 C, 8 C, 10 C, BL C, 40 C, 80 C, : DOT ( VAL X Y PLANE --- ) PLANE DUP >R READ REQ ( VAL X Y ) 2* 2* 2* 2* 2* ( VAL X Y*32 ) OVER 2/ 2/ 2/ + ( VAL X Y*32+X/8 ) DUP >R CUR! ( VAL X ) 7 AND MASKS + C@ ( VAL MASK ) SWAP IF DATA@ OR ELSE NOT DATA@ AND THEN R> R> WRITE CUR! DATA! REL ; --> ( NOT DOT ) HEX VARIABLE CURX VARIABLE CURY 50 CURY ! : DOTCHAR ( CHAR --- ) 7F AND DUP 0D = IF 0 CURX ! ELSE DUP 0A = IF 1 CURY +! ELSE BL = 0= CURX @ CURY @ 0 DOT 1 CURX +! THEN THEN ; --> ( NOT NOT DOT ) HEX HANDLE INFILE INFILE FILENAME UFONT.AST : OPEN-FONT INFILE OPEN-FILE-R/O ABORT" CAN'T OPEN FILE!" ; CREATE INFILEBUF 10 ALLOT : TYI ( --- CHAR ) INFILE 1 INFILEBUF READ-FILE IF INFILE CLOSE-FILE DROP 1 ABORT" OOP ACK!" THEN DROP INFILEBUF C@ ; --> ( NOT NOT NOT DOT ) : SHOW-FONT OPEN-FONT BEGIN TYI DUP DUP EMIT DUP . DOTCHAR ?TERMINAL UNTIL INFILE CLOSE-FILE ; : OOPS INFILE CLOSE-FILE ; --> ( ASD ) HEX : LOAD-FONT 2 BASE ! OPEN-FONT 80 0 DO CR CR ." -------- " I EMIT CR BEGIN TYI 0C = UNTIL CR 4 0 DO BEGIN TYI 0A = UNTIL LOOP 5 0 DO 0 3 0 DO TYI DUP EMIT BL - IF 88 + THEN 2/ LOOP DUP 100 + . CR C, TYI TYI 2DROP LOOP ?TERMINAL IF LEAVE THEN LOOP INFILE CLOSE-FILE DECIMAL ; --> ( KDXJFUWERSDG ) CREATE FONT LOAD-FONT --> ( TYO ) HEX VARIABLE CUR-ADDR 80 CUR-ADDR ! VARIABLE TEXT-PLANE 0 PLANE TEXT-PLANE ! --> ( TYO ) HEX : DO-LINE ( ODD? ADDR LINE --- ODD? NEXT-ADDR ) OVER CUR! TEXT-PLANE @ READ ( ODD? ADDR LINE ) 2 PICK IF 0F0 AND ELSE 0F AND THEN DATA@ XOR OVER CUR! TEXT-PLANE @ WRITE DATA! ( ODD? ADDR ) 20 + ; --> ( TYO ) HEX : TYO ( CHAR --- ) CUR-ADDR @ DUP 1 AND SWAP 2/ ( CHAR ODD? ADDR ) ROT 5 * FONT + ( ODD? ADDR >FONT ) DUP 5 + SWAP REQ DO I C@ DO-LINE LOOP REL 2DROP CUR-ADDR @ 1+ DUP 7F AND 0= IF 140 + THEN 1FFF AND CUR-ADDR ! ; --> ( IT WORKS! ) HEX : TEST BEGIN KEY DUP 0D - WHILE TYO REPEAT DROP ; : f7 ." Enter text: " NUMFLG @ IF NUMARG 2@ DROP ELSE 0 THEN PLANE TEXT-PLANE ! TEST ; : TASK ;