home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a079 / 1.img / FPDG.LZH / VOL2NUM0 / FOXLIFE / FOXLIFE.PRG < prev    next >
Encoding:
Text File  |  1993-02-02  |  20.1 KB  |  645 lines
  1. *  FOXLIFE.PRG  The much implemented game of Life, invented by John Conway.
  2. *  Based on anonymous C source from Internet, but modified greatly.
  3. *  First ported to FoxPro by Tom Rombouts, Oct 2, 1991
  4. *  Sixth major revision -  Feb 1, 1993.
  5. *  Possible enhancements:
  6. *     Finish "edit pattern" code
  7. *     Allow flat/circular toggle during session
  8. *     Allow saving of each generation.
  9. *     Possibly go to "one loop" calc/display method
  10. *     Add saving partial game.  Define menu at start, use
  11. * Optional command line arguments:
  12. PARAMETERS p_num_or_file, p_circular, p_char
  13. SET ESCAPE ON
  14. * Process command line arguments
  15. STORE .F. TO go_flag, file_flag
  16. DO CASE
  17.    CASE TYPE("num_or_file")=="N"
  18.       go_flag = .T. 
  19.    CASE TYPE("num_or_file")=="C"
  20.       IF FILE(num_or_file)
  21.          STORE .T. TO file_flag, go_flag
  22.       ENDIF
  23. ENDCASE
  24.  
  25. IF TYPE("p_circular")=="C"
  26.    DO CASE
  27.       CASE UPPER(p_circular)="CIRC"
  28.          p_circular = .T.     
  29.       CASE UPPER(p_circular)="FLAT"
  30.          p_circular = .F.
  31.    ENDCASE
  32. ENDIF
  33.  
  34. IF EMPTY(p_char)
  35.    p_char = CHR(2)  && Default to light smile face
  36. ENDIF
  37.  
  38. SET TALK OFF
  39. SET COMPATIBLE OFF
  40. SET SCOREBOARD OFF
  41. SET CURSOR OFF
  42.  
  43. ON ESCAPE STORE .T. TO stop_flag
  44. ON KEY LABEL F10 ACTIVATE POPUP lifeopts
  45.  
  46. g_rows = SROWS() - 1    && Top line used for menu, messages
  47. g_cols = SCOLS()
  48.  
  49. DECLARE acal[g_rows, g_cols]
  50. DECLARE adis[g_rows, g_cols]
  51. STORE 0 TO adis, acal
  52.  
  53. STORE .F. TO menu_flag, stop_flag, quit_flag
  54.  
  55. population = 0
  56. generation = 0
  57.  
  58. * Global editing vars:
  59. STORE 0 To erow, ecol
  60.  
  61. SET SYSMENU AUTOMATIC
  62.  
  63. DEFINE PAD lifemenu OF _MSYSMENU PROMPT "Fox\<Life" KEY ALT+L, ""
  64. ON PAD lifemenu OF _MSYSMENU ACTIVATE POPUP lifeopts
  65.  
  66. DEFINE POPUP lifeopts MARGIN RELATIVE SHADOW
  67. DEFINE BAR 1 OF lifeopts PROMPT "\<File"
  68. DEFINE BAR 2 OF lifeopts PROMPT "\<Edit"
  69. DEFINE BAR 3 OF lifeopts PROMPT "\<New"
  70. DEFINE BAR 4 OF lifeopts PROMPT "\<Save"
  71. DEFINE BAR 5 OF lifeopts PROMPT "\<About"
  72. DEFINE BAR 6 OF lifeopts PROMPT "\<Exit"
  73. ON SELECTION BAR 1 OF lifeopts DO FILE_GET IN FOXLIFE.PRG
  74. ON SELECTION BAR 2 OF lifeopts DO PATT_EDIT IN FOXLIFE.PRG
  75. ON SELECTION BAR 3 OF lifeopts DO INSTRUCT IN FOXLIFE.PRG
  76. ON SELECTION BAR 4 OF lifeopts DO FILE_SAVE IN FOXLIFE.PRG
  77. ON SELECTION BAR 5 OF lifeopts DO L_ABOUT IN FOXLIFE.PRG
  78. ON SELECTION BAR 6 OF lifeopts DO LIFE_EXIT IN FOXLIFE.PRG
  79.  
  80.  
  81. * Main sequence, cycle 'till two ESC chars:
  82. DO WHILE .T.    
  83.   CLEAR
  84.     IF NOT go_flag
  85.        num_or_file = INSTRUCT()
  86.     ENDIF
  87.     IF EMPTY(num_or_file)
  88.        quit_flag = .T.
  89.        EXIT
  90.     ELSE
  91.        STORE .F. TO stop_flag, quit_flag
  92.     ENDIF
  93.     IF TYPE("num_or_file")=="N"
  94.        CLEAR
  95.        DO FILL_RAND WITH num_or_file, g_rows, g_cols, p_char
  96.     ENDIF
  97.     IF TYPE("num_or_file")="C"
  98.        CLEAR
  99.        DO PATT_LOAD WITH num_or_file, g_rows, g_cols, p_char
  100.     ENDIF
  101.     DO WHILE .T.   && This simultates a do{...}while construct:
  102.     m.generation = (m.generation + 1)
  103.     acal = 0  && Zero out calculation array
  104.     IF m.p_circular
  105.        DO CAL_EDGE_CIRC WITH m.g_rows, m.g_cols
  106.     ELSE
  107.        DO CAL_EDGE_FLAT WITH m.g_rows, m.g_cols
  108.     ENDIF
  109.     DO CAL_CENTER WITH m.g_rows - 1, m.g_cols - 1
  110.     DO SHOW_EM WITH m.g_rows, m.g_cols, m.p_char
  111.     WAIT WINDOW NOWAIT "Cycle: " + LTRIM(STR(m.generation)) + ;
  112.        "  Cells: " + LTRIM(STR(m.population))
  113.     =ACOPY("acal", "adis")
  114.     IF (m.population == 0) OR stop_flag
  115.       EXIT
  116.     ENDIF
  117.   ENDDO
  118.   IF quit_flag
  119.     EXIT
  120.   ENDIF
  121. ENDDO
  122. DO PATT_SAVE WITH "lastlife.dat", m.g_rows, m.g_cols
  123.  
  124. DEACTIVATE MENU mainmenu
  125. RELEASE MENU mainmenu
  126. SET SYSMENU TO DEFAULT
  127. ON ESCAPE
  128. ON KEY LABEL F10
  129. CLEAR
  130. WAIT WINDOW NOWAIT "That's all, folks!"
  131. SET CURSOR ON
  132.  
  133.  
  134. FUNCTION INSTRUCT        && Print instructions, one screen's worth:
  135. PRIVATE user_val, scr_temp
  136. SAVE SCREEN TO scr_temp
  137. CLEAR
  138. SET CURSOR ON
  139. STORE SPACE(12) TO user_val
  140.  
  141. @ 1, 0 SAY "                The game of Life by John Conroy"
  142.  
  143. @ 3, 0 SAY "      If started with a number, a random pattern starts the game."
  144. @ 4, 0 SAY "      If started with a file name, will load game based on data "
  145. @ 5, 0 SAY "      in that file. "
  146.  
  147. @ 7, 0 SAY "      F10 will activate the menu.  Hit ESC to bail out."
  148.  
  149. @ 9, 0 SAY "      Enter number of cells or data file name, or hit CR: " ;
  150.                   GET user_val
  151.                   READ
  152. SET CURSOR OFF
  153. IF EMPTY( user_val )
  154.   RESTORE SCREEN FROM scr_temp
  155. ELSE
  156.   CLEAR
  157. ENDIF
  158. RELEASE scr_temp
  159. IF VAL(user_val) > 0
  160.    RETURN VAL(user_val)
  161. ELSE
  162.    RETURN user_val
  163. ENDIF
  164.  
  165. FUNCTION FILL_RAND
  166. * Refill display array with random values.
  167. PARAMETER number, p_rows, p_cols, p_char
  168. PRIVATE i, row, col, seed, rnum
  169. * Reset relevant globals:
  170. STORE 0 TO population, generation
  171. * Zero out display array:
  172. STORE 0 TO adis
  173. =RAND(-1)
  174. WAIT WINDOW NOWAIT "Generating random pattern...."
  175. FOR m.i = 1 TO m.number
  176.    m.rnum = RAND() * 10000
  177.    m.row = MOD(m.rnum, m.p_rows)
  178.    m.col = MOD( INT(m.rnum/m.p_rows), m.p_cols)
  179.    adis[m.row + 1, m.col + 1] = 1  && Put in a cell
  180.    population = m.population + 1
  181.    @ m.row, m.col SAY m.p_char
  182. ENDFOR  && m.number loop
  183. WAIT CLEAR
  184. RETURN 
  185.  
  186.  
  187. FUNCTION CAL_EDGE_CIRC
  188. * Re-calculate the next generation based on the display array.
  189. * Fewer loops (and more code) is done to maximize re-calc speed.
  190. PARAMETERS p_rows, p_cols
  191. PRIVATE crow, ccol, dncol, upcol, lfcol, rtcol
  192.  
  193. * Take care of the four corners, assume "circular" screen:
  194. IF NOT EMPTY(adis[ 1, 1])
  195.    STORE acal[m.p_rows, m.p_cols] + 1 TO acal[m.p_rows, m.p_cols]
  196.    STORE acal[m.p_rows, 1] + 1 TO acal[m.p_rows, 1]
  197.    STORE acal[m.p_rows, 2] + 1 TO acal[m.p_rows, 2]
  198.    STORE acal[ 1,m.p_cols] + 1 TO acal[ 1,m.p_cols]
  199.    STORE acal[ 1, 2] + 1 TO acal[ 1, 2]
  200.    STORE acal[ 2,m.p_cols] + 1 TO acal[ 2,m.p_cols]
  201.    STORE acal[ 2, 1] + 1 TO acal[ 2, 1]
  202.    STORE acal[ 2, 2] + 1 TO acal[ 2, 2]
  203. ENDIF
  204.  
  205. IF NOT EMPTY(adis[ 1, m.p_cols])
  206.    STORE acal[m.p_rows, m.p_cols - 1] + 1 TO acal[m.p_rows, m.p_cols - 1]
  207.    STORE acal[m.p_rows, m.p_cols] + 1 TO acal[m.p_rows, m.p_cols]
  208.    STORE acal[m.p_rows, 1] + 1 TO acal[m.p_rows, 1]
  209.    STORE acal[ 1, m.p_cols - 1] + 1 TO acal[ 1, m.p_cols - 1]
  210.    STORE acal[ 1, 1] + 1 TO acal[ 1, 1]
  211.    STORE acal[ 2, m.p_cols - 1] + 1 TO acal[ 2, m.p_cols - 1]
  212.    STORE acal[ 2, m.p_cols]     + 1 TO acal[ 2, m.p_cols]
  213.    STORE acal[ 2, 1]            + 1 TO acal[ 2, 1]
  214. ENDIF
  215.  
  216. IF NOT EMPTY(adis[m.p_rows, m.p_cols])
  217.    STORE acal[m.p_rows - 1, m.p_cols - 1] + 1 TO ;
  218.       acal[m.p_rows - 1, m.p_cols - 1]
  219.    STORE acal[m.p_rows - 1, m.p_cols] + 1 TO acal[m.p_rows - 1, m.p_cols]
  220.    STORE acal[m.p_rows - 1, 1] + 1 TO acal[m.p_rows - 1, 1]
  221.    STORE acal[m.p_rows, m.p_cols - 1] + 1 TO acal[m.p_rows, m.p_cols - 1]
  222.    STORE acal[m.p_rows, 1] + 1 TO acal[m.p_rows, 1]
  223.    STORE acal[ 1, m.p_cols - 1] + 1 TO acal[ 1, m.p_cols - 1]
  224.    STORE acal[ 1, m.p_cols]     + 1 TO acal[ 1, m.p_cols]
  225.    STORE acal[ 1, 1]            + 1 TO acal[ 1, 1]
  226. ENDIF
  227.  
  228. IF NOT EMPTY(adis[m.p_rows, 1])
  229.    STORE acal[m.p_rows - 1, m.p_cols] + 1 TO ;
  230.          acal[m.p_rows - 1, m.p_cols]
  231.    STORE acal[m.p_rows - 1, 1]      + 1 TO acal[m.p_rows - 1, 1]
  232.    STORE acal[m.p_rows - 1, 2] + 1 TO acal[m.p_rows - 1, 2]
  233.    STORE acal[m.p_rows, m.p_cols] + 1 TO acal[m.p_rows, m.p_cols]
  234.    STORE acal[m.p_rows, 2] + 1 TO acal[m.p_rows, 2]
  235.    STORE acal[ 1, m.p_cols] + 1 TO acal[ 1, m.p_cols]
  236.    STORE acal[ 1, 1] + 1 TO acal[ 1, 1]
  237.    STORE acal[ 1, 2] + 1 TO acal[ 1, 2]
  238. ENDIF
  239.  
  240. * Re-calc the leftmost and rightmost columns:
  241. FOR crow = 2 TO (m.p_rows - 1)
  242.    IF NOT EMPTY(adis[m.crow, 1])
  243.       STORE acal[m.crow - 1, m.p_cols] + 1 TO acal[m.crow - 1, m.p_cols]
  244.       STORE acal[m.crow - 1,  1] + 1 TO acal[m.crow - 1,  1]
  245.       STORE acal[m.crow - 1,  2] + 1 TO acal[m.crow - 1,  2]
  246.       STORE acal[m.crow, m.p_cols] + 1 TO acal[m.crow, m.p_cols]
  247.       STORE acal[m.crow,  2] + 1 TO acal[m.crow,  2]
  248.       STORE acal[m.crow + 1, m.p_cols] + 1 TO acal[m.crow + 1, m.p_cols]
  249.       STORE acal[m.crow + 1,  1] + 1 TO acal[m.crow + 1,  1]
  250.       STORE acal[m.crow + 1,  2] + 1 TO acal[m.crow + 1,  2]
  251.    ENDIF
  252.    IF NOT EMPTY(adis[m.crow, m.p_cols])
  253.       STORE acal[m.crow - 1, m.p_cols - 1] + 1 TO acal[m.crow - 1, m.p_cols - 1]
  254.       STORE acal[m.crow - 1, m.p_cols] + 1 TO acal[m.crow - 1, m.p_cols]
  255.       STORE acal[m.crow - 1,  1] + 1 TO acal[m.crow - 1,  1]
  256.       STORE acal[m.crow, m.p_cols - 1] + 1 TO acal[m.crow, m.p_cols - 1]
  257.       STORE acal[m.crow,  1] + 1 TO acal[m.crow,  1]
  258.       STORE acal[m.crow + 1, m.p_cols - 1] + 1 TO ;
  259.             acal[m.crow + 1, m.p_cols - 1]
  260.       STORE acal[m.crow + 1, m.p_cols] + 1 TO acal[m.crow + 1, m.p_cols]
  261.       STORE acal[m.crow + 1,  1] + 1 TO acal[m.crow + 1,  1]
  262.   ENDIF
  263. ENDFOR
  264.  
  265. * Re-calc the top and bottom rows:
  266. FOR ccol = 2 TO m.p_cols - 1
  267.    IF NOT EMPTY(adis[1, m.ccol])
  268.       STORE acal[m.p_rows, m.ccol - 1] + 1 TO acal[m.p_rows, m.ccol - 1]
  269.       STORE acal[m.p_rows, m.ccol    ] + 1 TO acal[m.p_rows, m.ccol    ]
  270.       STORE acal[m.p_rows, m.ccol + 1] + 1 TO acal[m.p_rows, m.ccol + 1]
  271.       STORE acal[ 1, m.ccol - 1] + 1 TO acal[ 1, m.ccol - 1]
  272.       STORE acal[ 1, m.ccol + 1] + 1 TO acal[ 1, m.ccol + 1]
  273.       STORE acal[ 2, m.ccol - 1] + 1 TO acal[ 2, m.ccol - 1]
  274.       STORE acal[ 2, m.ccol    ] + 1 TO acal[ 2, m.ccol    ]
  275.       STORE acal[ 2, m.ccol + 1] + 1 TO acal[ 2, m.ccol + 1]
  276.    ENDIF
  277.    IF NOT EMPTY(adis[m.p_rows, m.ccol])
  278.       STORE acal[m.p_rows - 1, m.ccol - 1] + 1 TO ;
  279.             acal[m.p_rows - 1, m.ccol - 1]
  280.       STORE acal[m.p_rows - 1, m.ccol    ] + 1 TO ;
  281.             acal[m.p_rows - 1, m.ccol]
  282.       STORE acal[m.p_rows - 1, m.ccol + 1] + 1 TO ;
  283.             acal[m.p_rows - 1, m.ccol + 1]
  284.       STORE acal[m.p_rows, m.ccol - 1] + 1 TO acal[m.p_rows, m.ccol - 1]
  285.       STORE acal[m.p_rows, m.ccol + 1] + 1 TO acal[m.p_rows, m.ccol + 1]
  286.       STORE acal[ 1, m.ccol - 1] + 1 TO acal[ 1, m.ccol - 1]
  287.       STORE acal[ 1, m.ccol    ] + 1 TO acal[ 1, m.ccol]
  288.       STORE acal[ 1, m.ccol + 1] + 1 TO acal[ 1, m.ccol + 1]
  289.   ENDIF
  290. ENDFOR
  291. RETURN   && CAL_EDGE_CIRC
  292.  
  293.  
  294. FUNCTION CAL_EDGE_FLAT
  295. * Re-calculate the next generation based on the display array.
  296. * Fewer loops (and more code) is done to maximize re-calc speed.
  297. PARAMETERS p_rows, p_cols
  298. PRIVATE crow, ccol, dncol, upcol, lfcol, rtcol
  299.  
  300. * Take care of the four corners, assume "flat" screen:
  301. IF NOT EMPTY(adis[ 1, 1])
  302.    STORE acal[ 1, 2] + 1 TO acal[ 1, 2]
  303.    STORE acal[ 2, 1] + 1 TO acal[ 2, 1]
  304.    STORE acal[ 2, 2] + 1 TO acal[ 2, 2]
  305. ENDIF
  306.  
  307. IF NOT EMPTY(adis[ 1, m.p_cols])
  308.    STORE acal[ 1, m.p_cols - 1] + 1 TO acal[ 1, m.p_cols - 1]
  309.    STORE acal[ 2, m.p_cols - 1] + 1 TO acal[ 2, m.p_cols - 1]
  310.    STORE acal[ 2, m.p_cols]     + 1 TO acal[ 2, m.p_cols]
  311. ENDIF
  312.  
  313. IF NOT EMPTY(adis[m.p_rows, m.p_cols])
  314.    STORE acal[m.p_rows - 1, m.p_cols - 1] + 1 TO ;
  315.       acal[m.p_rows - 1, m.p_cols - 1]
  316.    STORE acal[m.p_rows - 1, m.p_cols] + 1 TO acal[m.p_rows - 1, m.p_cols]
  317.    STORE acal[m.p_rows, m.p_cols - 1] + 1 TO acal[m.p_rows, m.p_cols - 1]
  318. ENDIF
  319.  
  320. IF NOT EMPTY(adis[m.p_rows, 1])
  321.    STORE acal[m.p_rows - 1, 1] + 1 TO acal[m.p_rows - 1, 1]
  322.    STORE acal[m.p_rows - 1, 2] + 1 TO acal[m.p_rows - 1, 2]
  323.    STORE acal[m.p_rows, 2] + 1 TO acal[m.p_rows, 2]
  324. ENDIF
  325.  
  326. * Re-calc the leftmost and rightmost columns:
  327. FOR crow = 2 TO (m.p_rows - 1)
  328.    IF NOT EMPTY(adis[m.crow, 1])
  329.       STORE acal[m.crow - 1,  1] + 1 TO acal[m.crow - 1,  1]
  330.       STORE acal[m.crow - 1,  2] + 1 TO acal[m.crow - 1,  2]
  331.       STORE acal[m.crow,  2] + 1 TO acal[m.crow,  2]
  332.       STORE acal[m.crow + 1,  1] + 1 TO acal[m.crow + 1,  1]
  333.       STORE acal[m.crow + 1,  2] + 1 TO acal[m.crow + 1,  2]
  334.    ENDIF
  335.    IF NOT EMPTY(adis[m.crow, m.p_cols])
  336.       STORE acal[m.crow - 1, m.p_cols - 1] + 1 TO acal[m.crow - 1, m.p_cols - 1]
  337.       STORE acal[m.crow - 1, m.p_cols] + 1 TO acal[m.crow - 1, m.p_cols]
  338.       STORE acal[m.crow, m.p_cols - 1] + 1 TO acal[m.crow, m.p_cols - 1]
  339.       STORE acal[m.crow + 1, m.p_cols - 1] + 1 TO ;
  340.             acal[m.crow + 1, m.p_cols - 1]
  341.       STORE acal[m.crow + 1, m.p_cols] + 1 TO acal[m.crow + 1, m.p_cols]
  342.   ENDIF
  343. ENDFOR
  344.  
  345. * Re-calc the top and bottom rows:
  346. FOR ccol = 2 TO m.p_cols - 1
  347.    IF NOT EMPTY(adis[1, m.ccol])
  348.       STORE acal[ 1, m.ccol - 1] + 1 TO acal[ 1, m.ccol - 1]
  349.       STORE acal[ 1, m.ccol + 1] + 1 TO acal[ 1, m.ccol + 1]
  350.       STORE acal[ 2, m.ccol - 1] + 1 TO acal[ 2, m.ccol - 1]
  351.       STORE acal[ 2, m.ccol    ] + 1 TO acal[ 2, m.ccol    ]
  352.       STORE acal[ 2, m.ccol + 1] + 1 TO acal[ 2, m.ccol + 1]
  353.    ENDIF
  354.    IF NOT EMPTY(adis[m.p_rows, m.ccol])
  355.       STORE acal[m.p_rows - 1, m.ccol - 1] + 1 TO ;
  356.             acal[m.p_rows - 1, m.ccol - 1]
  357.       STORE acal[m.p_rows - 1, m.ccol    ] + 1 TO ;
  358.             acal[m.p_rows - 1, m.ccol]
  359.       STORE acal[m.p_rows - 1, m.ccol + 1] + 1 TO ;
  360.             acal[m.p_rows - 1, m.ccol + 1]
  361.       STORE acal[m.p_rows, m.ccol - 1] + 1 TO acal[m.p_rows, m.ccol - 1]
  362.       STORE acal[m.p_rows, m.ccol + 1] + 1 TO acal[m.p_rows, m.ccol + 1]
  363.    ENDIF
  364. ENDFOR
  365. RETURN   && CAL_EDGE_FLAT
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376. FUNCTION CAL_EDGE_FLAT
  377. * TWR - non-circular screen!
  378. * Note: all cells off screen are considered "dead"
  379. * Take care of the four corners, non-circular screen:
  380. PARAMETERS p_rows, p_cols
  381. acal[ 1, 1] = adis[ 1, 2] + adis[ 2, 2] + adis[ 2, 1]
  382. acal[ 1,80] = adis[ 1,79] + adis[ 2,79] + adis[ 2,80]
  383. acal[24, 1] = adis[24, 2] + adis[23, 2] + adis[23, 1]
  384. acal[24,80] = adis[24,79] + adis[23,79] + adis[23,80]
  385.  
  386. * Re-calc the left column:
  387. FOR crow = 2 TO 23
  388.   uprow = (m.crow - 1)
  389.   dnrow = (m.crow + 1)
  390.   acal[m.crow, 1] = adis[m.uprow, 1] + adis[m.uprow, 2] + ;
  391.                   adis[m.crow,  2] + adis[m.dnrow, 1] + adis[m.dnrow, 2]
  392. ENDFOR
  393.  
  394. * Re-calc the right column:
  395. FOR crow = 2 TO 23
  396.   uprow = (crow - 1)
  397.   dnrow = (crow + 1)
  398.   acal[crow, 80] = adis[uprow, 79] + adis[uprow, 80] + ;
  399.                    adis[ crow, 79] + adis[dnrow, 79] + adis[dnrow, 80]
  400. ENDFOR
  401.  
  402. * Re-calc the top row:
  403. FOR ccol = 2 TO 79
  404.   lfcol = (ccol - 1)
  405.   rtcol = (ccol + 1)
  406.   acal[ 1, ccol] = adis[ 1, lfcol] + adis[ 1, rtcol] + ;
  407.                    adis[ 2, lfcol] + adis[ 2,  ccol] + adis[ 2, rtcol]
  408. ENDFOR
  409.  
  410. * Re-calc the bottom row:
  411. FOR ccol = 2 TO 79
  412.   lfcol = (ccol - 1)
  413.   rtcol = (ccol + 1)
  414.   acal[24, ccol] = adis[23, lfcol] + adis[23,  ccol] + adis[23, rtcol] + ;
  415.                    adis[24, lfcol] + adis[24, rtcol]
  416. ENDFOR
  417.  
  418. RETURN  && CAL_EDGE_FLAT
  419.  
  420.  
  421. FUNCTION CAL_CENTER
  422. * Re-calculate the non-edges (center) of the array:
  423. PARAMETERS p_rows, p_cols
  424. FOR crow = 2 TO m.p_rows
  425.   FOR ccol = 2 TO m.p_cols
  426.     IF NOT EMPTY(adis[m.crow, m.ccol])
  427.        uprow = (m.crow - 1)
  428.        dnrow = (m.crow + 1)
  429.        lfcol = (m.ccol - 1)
  430.        rtcol = (m.ccol + 1)
  431.        * Update the eight cells around it:
  432.        STORE acal[m.uprow, m.lfcol] + 1 TO acal[m.uprow, m.lfcol]
  433.        STORE acal[m.uprow, m.ccol] + 1 TO acal[m.uprow, m.ccol]
  434.        STORE acal[m.uprow, m.rtcol] + 1 TO acal[m.uprow, m.rtcol]
  435.        STORE acal[m.crow, m.lfcol] + 1 TO acal[m.crow, m.lfcol]
  436.        STORE acal[m.crow, m.rtcol] + 1 TO acal[m.crow, m.rtcol]
  437.        STORE acal[m.dnrow, m.lfcol] + 1 TO acal[m.dnrow, m.lfcol]
  438.        STORE acal[m.dnrow, m.ccol] + 1 TO acal[m.dnrow, m.ccol]
  439.        STORE acal[m.dnrow, m.rtcol] + 1 TO acal[m.dnrow, m.rtcol]
  440.     ENDIF
  441.   ENDFOR
  442. ENDFOR
  443. RETURN
  444.  
  445.  
  446. FUNCTION SHOW_EM
  447. * Determine new status and display each cell:
  448. * Assumes display starts at 1, 0
  449. PARAMETERS p_rows, p_cols, p_char
  450. STORE 0 TO population
  451. FOR crow = 1 TO m.p_rows
  452.   @ m.crow, 0  && Clear current row
  453.   FOR ccol = 1 TO m.p_cols
  454.     * Preserve living cell if 2 or 3 neighbors:
  455.     cur_cell = acal[m.crow, m.ccol]   && attempted speedup
  456.     IF cur_cell == 3
  457.       acal[m.crow, m.ccol] = 1
  458.     ELSE
  459.       IF cur_cell == 2 AND adis[m.crow, m.ccol] == 1
  460.         acal[m.crow, m.ccol] = 1
  461.       ELSE
  462.         acal[m.crow, m.ccol] = 0
  463.       ENDIF
  464.     ENDIF
  465.     IF acal[m.crow, m.ccol] > 0
  466.       m.population = (m.population + 1)
  467.       @ m.crow, (m.ccol - 1) SAY m.p_char
  468.     ENDIF
  469.   ENDFOR
  470. ENDFOR
  471.  
  472. RETURN .T.   && SHOW_EM
  473.  
  474.  
  475. FUNCTION PATT_SAVE
  476. PARAMETER savefile, p_rows, p_cols
  477. * Write out 4000 byte text file.  Overwrites file.
  478. * This uses a somewhat slow, but reliable method.
  479. PRIVATE handle, srow, scol
  480. handle = FCREATE( savefile )
  481. IF handle < 1
  482.   WAIT WINDOW "Error creating file: " + savefile
  483.   RETURN .F.
  484. ENDIF
  485. FOR srow = 1 TO p_rows
  486.   FOR scol = 1 TO p_cols
  487.     IF adis[srow, scol] > 0
  488.       =FWRITE( handle, "X" )
  489.     ELSE
  490.       =FWRITE( handle, " " )
  491.     ENDIF
  492.   ENDFOR
  493.   =FWRITE( handle, CHR(13) + CHR(10) )
  494. ENDFOR
  495. srow = FCLOSE( handle )
  496. IF NOT srow 
  497.   WAIT WINDOW "Error closing file: " + savefile
  498.   RETURN .F.
  499. ENDIF
  500. RETURN .T.
  501.  
  502.  
  503. FUNCTION FILE_GET
  504. PRIVATE newfile
  505. newfile = GETFILE("DAT", "New pattern: ")
  506. IF EMPTY(newfile)
  507.   RETURN
  508. ELSE
  509.   DO PATT_LOAD WITH newfile, g_rows, g_cols, p_char
  510. ENDIF
  511. RETURN
  512.  
  513.  
  514. FUNCTION PATT_LOAD
  515. PARAMETERS data_file, p_rows, p_cols, p_char
  516. * Load array adis[m.p_rows X m.p_cols] from file.
  517. * Space considered empty, any other char as life.
  518. PRIVATE handle, row, col, cur_line
  519. STORE 0 TO population, generation, acal, adis
  520. handle = FOPEN( data_file )  && no arg, read only, buffered
  521. IF NOT handle > 0
  522.   RETURN
  523. ENDIF
  524.  
  525. * TWR - this line may not be correct!
  526. FOR row = 1 TO m.p_rows
  527.   cur_line = FGETS( handle )
  528.   IF FEOF( handle )
  529.     EXIT
  530.   ENDIF
  531.   WAIT WINDOW NOWAIT "Reading in row " + LTRIM(STR(m.row))
  532.   IF LEFT(LTRIM(m.cur_line), 1) = "*"
  533.      row = (m.row - 1)
  534.      LOOP
  535.   ENDIF
  536.   width = MIN(LEN( cur_line ), m.p_cols)
  537.   FOR col = 1 TO width
  538.     IF SUBSTR(cur_line, col, 1) = "*"
  539.       EXIT
  540.     ENDIF
  541.     IF SUBSTR( cur_line, col, 1 ) != " "
  542.       adis[row, col] = 1
  543.       m.population = (m.population + 1)
  544.       @ row, col SAY m.p_char
  545.     ELSE
  546.       @ row, col SAY " "
  547.     ENDIF
  548.   ENDFOR
  549. ENDFOR
  550. =FCLOSE( handle )
  551. WAIT CLEAR
  552. RETURN
  553.  
  554.  
  555. FUNCTION PATT_EDIT
  556. * Simulate editing of pattern on screen
  557. * Uses globals for speed
  558. WAIT WINDOW "Pattern editing not completed - any key to continue"
  559. RETURN  && early exit
  560. PRIVATE ekey
  561. @ 24, 0 SAY "Edit mode   Arrow keys move - spacebar toggles - ESC or CR to end"
  562. CLEAR TYPEAHEAD
  563. DO WHILE .T.
  564.   ekey = INKEY(0)
  565.   DO CASE
  566.     CASE ekey == 13 OR ekey == 27  && Enter or ESC
  567.         @ erow, ecol SAY adis[ erow + 1, ecol + 1 ]
  568.       EXIT
  569.     CASE ekey == 32  && Spacebar
  570.         adis[erow + 1, ecol + 1] = IIF( adis[erow + 1, ecol + 1] > 0, ;
  571.                                         0, 1 )
  572.         @ erow, ecol SAY IIF(adis[erow + 1, ecol + 1] > 0, CHR(2), " " )   
  573.     CASE ekey ==  5  && Up arrow
  574.       IF erow > 0
  575.         erow = erow - 1
  576.         @ erow + 1, ecol SAY IIF(adis[erow + 1, ecol + 1] > 0, CHR(2), " ")
  577.         @ erow, ecol SAY "" GET (adis[erow + 1, ecol + 1])
  578.       ENDIF
  579.     CASE ekey ==  4  && Right arrow
  580.       IF ecol < 79
  581.         ecol = ecol + 1
  582.         @ erow, ecol - 1 SAY adis[ erow + 1, ecol + 1 ]
  583.         @ erow, ecol SAY "" GET adis[ erow + 1, ecol + 1 ]
  584.       ENDIF
  585.     CASE ekey == 24  && Down arrow
  586.       IF erow > 24
  587.         erow = erow + 1
  588.         @ erow - 1, ecol SAY adis[ erow + 1, ecol + 1 ]
  589.         @ erow, ecol SAY "" GET adis[ erow + 1, ecol + 1 ]
  590.       ENDIF
  591.     CASE ekey == 19  && Left arrow
  592.       IF ecol > 0
  593.         ecol = ecol - 1
  594.         @ erow, ecol - 1 SAY adis[ erow + 1, ecol + 1 ]
  595.         @ erow, ecol SAY "" GET adis[ erow + 1, ecol + 1 ]
  596.       ENDIF
  597.   ENDCASE
  598. ENDDO
  599. RETURN .T.
  600.  
  601.  
  602. FUNCTION L_ABOUT
  603. PRIVATE idaho
  604. DEFINE WINDOW about FROM 1, 20 TO 9, 55
  605. ACTIVATE WINDOW about
  606. @ 1, 1 SAY "       The game of Life         "
  607. @ 2, 1 SAY " Invented by John Conway,  1970 "
  608. @ 3, 1 SAY " FoxPro version by Tom Rombouts "
  609. @ 4, 1 SAY "                                "
  610. @ 5, 1 SAY "  Press any key to continue...  "
  611. idaho = INKEY(0)
  612. DEACTIVATE WINDOW about
  613. RELEASE WINDOW about
  614. RETURN
  615.  
  616.  
  617. FUNCTION FILE_SAVE
  618. PRIVATE savefile
  619. savefile = PUTFILE("Save game as: ", SPACE(12), "DAT")
  620. IF EMPTY( savefile )
  621.   RETURN
  622. ELSE
  623.   DO PATT_SAVE WITH savefile
  624. ENDIF
  625. RETURN
  626.  
  627.  
  628. FUNCTION LIFE_EXIT
  629. * Do clean up
  630. STORE .T. TO stop_flag, exit_flag
  631. RETURN
  632.  
  633. * EOP: FOXLIFE.PRG
  634.  
  635.  
  636. * Function used during debugging:
  637. FUNCTION SHOW_ACAL
  638. FOR x = 1 TO 24
  639.    FOR y = 1 TO 80
  640.       @ x, y - 1 SAY LTRIM(STR(acal[m.x, m.y]))   
  641.    ENDFOR
  642. ENDFOR
  643. WAIT WINDOW "Press any key..."
  644. RETURN
  645.