home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
FORTHCMP.ZIP
/
LIFE.4TH
< prev
next >
Wrap
Text File
|
1992-03-30
|
4KB
|
161 lines
\ Conway's game of Life
\ Copyright (C) 1985 by Thomas Almy. All rights reserved.
\ Users of ForthCMP are given permission to use or distribute this
\ program, as long as no charge is made and the credit message is maintained.
\ For IBM PC or clones with color graphics adapter only
\ Say "LIFE" to run with contents of screen.
\ Say "LIFE X" to do example.
\ Peformance has been enhanced with code words in two places
100 MSDOS
," Copyright (C) 1985 by Thomas Almy. All rights reserved."
0 1 IN/OUT
: ?TERMINAL 255 6 BDOS 0<> ;
\ DATA DEFINITIONS
80 CONSTANT C/L \ characters per line
25 EQU L/P \ lines per "page"
50 CONSTANT MAXL/P \ maximum L/P value
0 EQU C/P \ characters per page
0 EQU CRTSTART \ offset of display start
0 , ( fill )
CREATE BUFF1 C/L MAXL/P 2+ * ALLOT \ pair of generation bufs
0 , ( fill )
CREATE BUFF2 C/L MAXL/P 2+ * ALLOT
0 , ( fill )
VARIABLE FRBUF BUFF1 FRBUF ! \ pointers to buffers
VARIABLE TOBUF BUFF2 TOBUF !
2 CONSTANT ONCHAR \ Smiley face is lifeform
0 CONSTANT OFFCHAR
OFFCHAR 9 * ONCHAR OFFCHAR - 3 * + CONSTANT 3ON
OFFCHAR 9 * ONCHAR OFFCHAR - 4 * + CONSTANT 4ON
\ Create Example Lifeform
2 1 IN/OUT ( INSERT is the inverse operation of COUNT )
: INSERT ( buffer char -- buffer+1 )
OVER C! 1+ ;
2 1 IN/OUT
: MTLINES ( buffer quantity -- buffer+quantity )
C/L * 0 DO OFFCHAR INSERT LOOP ;
1 0 IN/OUT
: EXAMPLE> ( bufaddr -- )
( WE WILL FAKE IT FOR NOW )
L/P 2/ MTLINES
25 0 DO OFFCHAR INSERT LOOP
5 0 DO 5 0 DO ONCHAR INSERT LOOP OFFCHAR INSERT LOOP
25 0 DO OFFCHAR INSERT LOOP
L/P 2/ 13 - 2 + MTLINES
DROP
;
\ EXTRACT FROM DISPLAY -- MACHINE DEPENDENT
HEX
B800 CONSTANT SCREEN ( screen segment )
DECIMAL
1 0 IN/OUT
: DISPLAY> ( buffer -- )
1 MTLINES
C/P 0
DO SCREEN I 2* CRTSTART + C@L BL = IF OFFCHAR ELSE ONCHAR THEN INSERT LOOP
1 MTLINES DROP ;
\ SEND TO DISPLAY -- MACHINE DEPENDENT
0 0 IN/OUT
: INIT-DISPLAY
C/P 2 * CRTSTART + 9 CRTSTART +
DO 12 SCREEN I C!L 2 +LOOP ;
VARIABLE GEN#
0 0 IN/OUT
: SHOW-GENERATION ( -- )
?DS: GEN# @ 0
<#
7 HOLD
#
3 0 DO 7 HOLD 2DUP OR IF # ELSE BL HOLD THEN LOOP
#>
DROP SCREEN CRTSTART 8 CMOVEL
1 GEN# +! ;
1 0 IN/OUT
CODE FILL-DISPLAY ( addr - AX )
AX SI MOV ' C/P [] CX MOV
' CRTSTART [] DI MOV SCREEN # AX MOV AX ES >SEG CLD
BEGIN, BYTE LODS BYTE STOS DI INC LOOP ~ UNTIL,
RET END-CODE
1 0 IN/OUT
: >DISPLAY ( buffer -- )
C/L + FILL-DISPLAY
SHOW-GENERATION ;
\ Process at a coordinate
2 1 IN/OUT
CODE PROCESS-CHAR ( AX - source BX - dest --- AX - dest+1 )
AX SI MOV
[SI] AX MOV
C/L +[SI] AX ADD
C/L NEGATE +[SI] AX ADD
AH AL ADD
-1 +[SI] AL ADD
C/L 1- +[SI] AL ADD
C/L 1+ NEGATE +[SI] AL ADD
3ON # AL CMP <0 IF, AL AL XOR ELSE,
=0 IF, ONCHAR # AL MOV ELSE,
4ON # AL CMP =0 IF, [SI] AL MOV ELSE,
AL AL XOR
THEN, THEN, THEN,
AL [BX] MOV
BX INC
BX AX MOV RET
END-CODE
\ Process a screenfull
0 0 IN/OUT
: PROCESS-SCREEN ( -- )
TOBUF @ C/L + FRBUF @ C/L +
DUP C/P + SWAP DO I PROCESS-CHAR LOOP DROP ;
1 0 IN/OUT
: SWAP-T/B ( this makes display wrap in all directions! )
DUP C/L + DUP C/P + C/L CMOVE
DUP C/P + SWAP C/L CMOVE ;
\ Main program
: MAIN
[HEX]
40 84 C@L ?DUP IF 1+ MAXL/P MIN EQU L/P THEN
40 4E @L EQU CRTSTART \ offset of display start
[DECIMAL]
C/L L/P * EQU C/P
FRBUF @ 128 C@ IF EXAMPLE> ELSE DISPLAY> THEN
INIT-DISPLAY
TOBUF @ C/L L/P 2+ * OFFCHAR FILL
FRBUF @ >DISPLAY
BEGIN
FRBUF @ SWAP-T/B
PROCESS-SCREEN TOBUF @ >DISPLAY
FRBUF @ TOBUF @ FRBUF ! TOBUF !
?TERMINAL
UNTIL ;
INCLUDE FORTHLIB
END