home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / LIFE.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  3.7 KB  |  161 lines
  1. \ Conway's game of Life
  2. \ Copyright (C) 1985 by Thomas Almy.  All rights reserved.
  3. \  Users of ForthCMP are given permission to use or distribute this
  4. \  program, as long as no charge is made and the credit message is maintained.
  5.  
  6.  
  7. \  For IBM PC or clones with color graphics adapter only
  8.  
  9. \  Say "LIFE" to run with contents of screen.
  10. \  Say "LIFE X" to do example.
  11.  
  12. \  Peformance has been enhanced with code words in two places
  13.  
  14.  
  15. 100 MSDOS
  16. ," Copyright (C) 1985 by Thomas Almy.  All rights reserved."
  17.  
  18. 0 1 IN/OUT
  19. : ?TERMINAL  255 6 BDOS 0<> ;
  20.  
  21. \ DATA DEFINITIONS
  22. 80 CONSTANT C/L        \ characters per line
  23. 25 EQU L/P        \ lines per "page"
  24. 50 CONSTANT MAXL/P    \ maximum L/P value
  25. 0  EQU C/P        \ characters per page
  26. 0  EQU CRTSTART        \ offset of display start
  27.  
  28. 0 , ( fill )
  29. CREATE BUFF1  C/L  MAXL/P 2+ *  ALLOT    \ pair of generation bufs
  30. 0 , ( fill )
  31. CREATE BUFF2  C/L  MAXL/P 2+ *  ALLOT
  32. 0 , ( fill )
  33.  
  34. VARIABLE FRBUF  BUFF1 FRBUF !        \ pointers to buffers
  35. VARIABLE TOBUF  BUFF2 TOBUF !
  36.  
  37. 2       CONSTANT ONCHAR            \ Smiley face is lifeform
  38. 0       CONSTANT OFFCHAR
  39. OFFCHAR 9 * ONCHAR OFFCHAR - 3 * + CONSTANT 3ON
  40. OFFCHAR 9 * ONCHAR OFFCHAR - 4 * + CONSTANT 4ON
  41.  
  42. \ Create Example Lifeform
  43.  
  44. 2 1 IN/OUT  ( INSERT is the inverse operation of COUNT )
  45. : INSERT   ( buffer char -- buffer+1 )
  46.     OVER C! 1+ ;
  47.  
  48. 2 1 IN/OUT
  49. : MTLINES     ( buffer quantity -- buffer+quantity )
  50.     C/L * 0 DO OFFCHAR INSERT LOOP ;
  51.  
  52. 1 0 IN/OUT
  53. : EXAMPLE> ( bufaddr -- )
  54.     ( WE WILL FAKE IT FOR NOW )
  55.     L/P 2/ MTLINES
  56.     25 0 DO OFFCHAR INSERT LOOP
  57.     5 0 DO  5 0 DO ONCHAR INSERT LOOP OFFCHAR INSERT LOOP
  58.     25 0 DO OFFCHAR INSERT LOOP
  59.     L/P 2/ 13 - 2 + MTLINES
  60.     DROP
  61. ;
  62.  
  63.  
  64. \ EXTRACT FROM DISPLAY  -- MACHINE DEPENDENT
  65. HEX
  66. B800 CONSTANT SCREEN ( screen segment )
  67. DECIMAL
  68. 1 0 IN/OUT
  69. : DISPLAY>  ( buffer -- )
  70.     1 MTLINES
  71.     C/P 0 
  72.     DO  SCREEN  I 2* CRTSTART + C@L  BL = IF OFFCHAR ELSE ONCHAR THEN INSERT  LOOP
  73.     1 MTLINES  DROP ;
  74.  
  75.  
  76. \ SEND TO DISPLAY -- MACHINE DEPENDENT
  77. 0 0 IN/OUT
  78. : INIT-DISPLAY  
  79.     C/P 2 * CRTSTART + 9 CRTSTART +
  80.     DO 12 SCREEN I C!L 2 +LOOP ;
  81.  
  82. VARIABLE GEN#
  83. 0 0 IN/OUT
  84. : SHOW-GENERATION  ( -- )
  85.     ?DS:  GEN# @ 0 
  86.         <#  
  87.         7 HOLD  
  88.         #
  89.                  3 0 DO 7 HOLD 2DUP OR IF # ELSE BL HOLD THEN LOOP 
  90.         #> 
  91.     DROP SCREEN CRTSTART 8 CMOVEL
  92.     1 GEN# +! ;
  93.  
  94. 1 0 IN/OUT
  95. CODE FILL-DISPLAY ( addr - AX )
  96.     AX SI MOV ' C/P [] CX MOV
  97.     ' CRTSTART [] DI MOV  SCREEN # AX MOV  AX ES >SEG  CLD
  98.     BEGIN,  BYTE LODS  BYTE STOS  DI INC  LOOP ~ UNTIL,
  99.     RET  END-CODE
  100.  
  101. 1 0 IN/OUT
  102. : >DISPLAY  ( buffer -- )
  103.     C/L +  FILL-DISPLAY  
  104.     SHOW-GENERATION ;
  105.  
  106.  
  107. \ Process at a coordinate
  108. 2 1 IN/OUT
  109. CODE PROCESS-CHAR  ( AX - source BX - dest --- AX - dest+1 )
  110.     AX SI MOV 
  111.     [SI] AX MOV 
  112.     C/L +[SI] AX ADD
  113.     C/L NEGATE +[SI] AX ADD  
  114.     AH AL ADD
  115.     -1 +[SI] AL ADD
  116.     C/L 1- +[SI] AL ADD
  117.     C/L 1+ NEGATE +[SI] AL ADD
  118.     3ON # AL CMP <0 IF, AL AL XOR ELSE,
  119.         =0 IF, ONCHAR # AL MOV  ELSE,
  120.             4ON # AL CMP =0 IF, [SI] AL MOV ELSE,
  121.             AL AL XOR    
  122.     THEN, THEN, THEN,
  123.     AL [BX] MOV 
  124.     BX INC  
  125.     BX AX MOV RET
  126.     END-CODE
  127.  
  128. \ Process a screenfull
  129. 0 0 IN/OUT
  130. : PROCESS-SCREEN ( -- )
  131.     TOBUF @  C/L +  FRBUF @  C/L +
  132.     DUP C/P + SWAP DO  I PROCESS-CHAR  LOOP DROP ;
  133.  
  134. 1 0 IN/OUT
  135. : SWAP-T/B  ( this makes display wrap in all directions! )
  136.     DUP C/L + DUP C/P + C/L CMOVE
  137.     DUP C/P + SWAP C/L CMOVE ;
  138.  
  139.  
  140. \ Main program
  141. : MAIN  
  142.     [HEX] 
  143.     40 84 C@L ?DUP IF 1+ MAXL/P MIN  EQU L/P THEN
  144.     40 4E @L EQU CRTSTART    \ offset of display start
  145.     [DECIMAL]
  146.     C/L L/P * EQU C/P
  147.     FRBUF @ 128 C@ IF EXAMPLE> ELSE DISPLAY> THEN
  148.     INIT-DISPLAY
  149.     TOBUF @ C/L L/P 2+ * OFFCHAR FILL
  150.     FRBUF @ >DISPLAY
  151.     BEGIN
  152.         FRBUF @ SWAP-T/B
  153.         PROCESS-SCREEN TOBUF @ >DISPLAY
  154.         FRBUF @ TOBUF @ FRBUF ! TOBUF !
  155.         ?TERMINAL 
  156.     UNTIL ;
  157.  
  158. INCLUDE FORTHLIB
  159. END
  160.  
  161.