home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / Prgs / games / life.lha / Life.b < prev    next >
Text File  |  1994-12-26  |  10KB  |  461 lines
  1. {*
  2. ** John Conway's Game of Life, written in ACE BASIC.
  3. **
  4. ** Author: David J Benn
  5. **   Date: 24th-26th December 1994
  6. **
  7. ** Future enhancements: Circular world option; speed increase;
  8. **            Life projects (shell and Wb args);
  9. **            variable grid size.
  10. **
  11. ** Try evolving the following pattern anywhere on the Life grid:
  12. **
  13. **    x
  14. **     x
  15. **     xxx
  16. **
  17. ** Try also loading and evolving the file "GliderGun.pat".
  18. *}
  19.  
  20. DEFINT a-z
  21.  
  22. STRING version SIZE 26
  23. version = "$VER: Life 1.0 (26.12.94)"
  24.  
  25. {*
  26. ** General constants.
  27. *}
  28. CONST true     = -1&
  29. CONST false     = 0&
  30. CONST null    = 0&
  31. CONST scrWidth    = 640
  32. CONST scrHeight    = 200
  33.     
  34. {*
  35. ** Life constants.
  36. *}
  37. CONST maxX     = 40
  38. CONST maxY     = 15
  39. CONST cellX    = 14&
  40. CONST cellY    = 7&
  41. CONST dead     = 0&
  42. CONST alive     = 1&
  43.  
  44. {*
  45. ** Color constants.
  46. *}
  47. CONST black    = 0
  48. CONST white    = 1
  49. CONST red    = 2
  50. CONST green    = 3
  51. CONST blue    = 4
  52.  
  53. {*
  54. ** Menu constants.
  55. *}
  56. CONST sDisable    = 0
  57. CONST sEnable    = 1
  58. CONST sCheck    = 2
  59.  
  60. CONST mProject    = 1
  61. CONST iProject    = 0
  62. CONST iLoad    = 1
  63. CONST iStore    = 2
  64. CONST iModify    = 3
  65. CONST iGenerate    = 4
  66. CONST iRandom    = 5
  67. CONST iClear    = 6
  68. CONST iSep1.1    = 7
  69. CONST iAbout    = 8
  70. CONST iQuit    = 9
  71.  
  72. {*
  73. ** Global variable declarations.
  74. *}
  75. '..Main and auxillary life matrices.
  76. DIM L(maxX,maxY), X(maxX,maxY)
  77.  
  78. '..Modes.
  79. Modifying = true
  80. Generating = false
  81.  
  82. '..Other globals.
  83. GenCount = 0
  84. Changed = false
  85. xOff = (scrWidth - (maxX*cellX + 3*cellX)) \ 2
  86. yOff = (scrHeight - (maxY*cellY + 5*cellY)) \ 2
  87.  
  88. {*
  89. ** Enable event trapping.
  90. *}
  91. ON MENU GOSUB handle_menu
  92. MENU ON
  93.  
  94. {*
  95. ** Library function declarations.
  96. *}
  97. CONST leave = -1&
  98. LIBRARY "intuition.library"
  99. DECLARE FUNCTION SetWindowTitles(wdw&,wdw_title$,scr_title$) LIBRARY intuition
  100.  
  101. {*
  102. ** Subprogram definitions.
  103. *}
  104. SUB SetupMenus
  105.   MENU mProject,iProject,sEnable,    "Project"
  106.   MENU mProject,iLoad,sEnable,        "  Load..."
  107.   MENU mProject,iStore,sEnable,        "  Store..."
  108.   MENU mProject,iModify,sEnable,    "  Modify Grid Contents",     "M"
  109.   MENU mProject,iGenerate,sEnable,    "  Evolve Life Pattern",    "E"
  110.   MENU mProject,iRandom,sEnable,    "  Create Random Pattern",    "R"
  111.   MENU mProject,iClear,sEnable,        "  Clear Grid",            "C"
  112.   MENU mProject,iSep1.1,sDisable,    "------------------------------"
  113.   MENU mProject,iAbout,sEnable,        "  About..."
  114.   MENU mProject,iQuit,sEnable,        "  Quit",            "Q"
  115. END SUB
  116.  
  117. SUB SetMode(SHORTINT Mode)
  118. SHARED Modifying, Generating
  119.   IF Mode = iModify THEN
  120.     Modifying = true
  121.     MENU mProject,iModify,sCheck 
  122.     Generating = false
  123.     MENU mProject,iGenerate,sEnable    
  124.     EXIT SUB
  125.   END IF
  126.   IF Mode = iGenerate THEN
  127.       Generating = true 
  128.     MENU mProject,iGenerate,sCheck    
  129.     Modifying = false            
  130.     MENU mProject,iModify,sEnable 
  131.     EXIT SUB
  132.   END IF
  133. END SUB
  134.  
  135. SUB DrawGridLines
  136. SHARED xOff, yOff
  137.   COLOR blue
  138.   '..Vertical lines.
  139.   FOR i=1 TO maxX+1
  140.     LINE (i*cellX+xOff,cellY+yOff)-(i*cellX+xOff,maxY*cellY+cellY+yOff)
  141.   NEXT
  142.   '..Horizontal lines.
  143.   FOR i=1 TO maxY+1
  144.     LINE (cellX+xOff,i*cellY+yOff)-(maxX*cellX+cellX+xOff,i*cellY+yOff)
  145.   NEXT
  146. END SUB
  147.  
  148. SUB ShowGenCount
  149. SHARED GenCount
  150. STRING wdwTitle SIZE 81
  151.   wdwTitle = "The Game of Life"+SPACE$(17)+"Generation:"+STR$(GenCount)    
  152.   SetWindowTitles(WINDOW(7),wdwTitle,leave)
  153. END SUB
  154.  
  155. SUB ClearGrid
  156. SHARED X, L
  157. SHARED GenCount, Changed
  158. SHARED xOff, yOff
  159.   MENU mProject,iProject,sDisable
  160.   FOR i=1 TO maxX
  161.     FOR j=1 TO maxY
  162.       X(i,j) = dead
  163.       L(i,j) = dead
  164.       LINE (i*cellX+1+xOff,j*cellY+1+yOff)- ~
  165.        (i*cellX+(cellX-1)+xOff,j*cellY+(cellY-1)+yOff),black,bf
  166.     NEXT j
  167.   NEXT i
  168.   Changed = false
  169.   GenCount = 0
  170.   ShowGenCount
  171.   MENU mProject,iProject,sEnable
  172. END SUB
  173.  
  174. SUB Msg(STRING theMsg)
  175.   SetWindowTitles(WINDOW(7),"The Game of Life",leave)
  176.   MSGBOX theMsg, "Continue"
  177.   ShowGenCount
  178. END SUB
  179.  
  180. SUB LoadPattern
  181. SHARED X, L
  182. SHARED GenCount
  183. SHARED Changed
  184. SHARED xOff, yOff
  185. STRING theFile SIZE 80
  186.   theFile = FILEBOX$("Load Life Pattern...")
  187.   IF theFile = "" THEN
  188.     Msg("No file selected.")
  189.   ELSE
  190.     OPEN "I",#1,theFile
  191.     IF HANDLE(1) = null THEN
  192.       Msg("Unable to open "+theFile+".")
  193.     ELSE
  194.       IF EOF(1) THEN
  195.     Msg(theFile+" is empty!")
  196.        CLOSE #1
  197.       ELSE
  198.           INPUT #1,x$
  199.           IF x$ <> "#LIFE PATTERN#" THEN
  200.       Msg("Incorrect file format.")
  201.          CLOSE #1
  202.         ELSE
  203.           ClearGrid
  204.           GenCount = 0
  205.           ShowGenCount
  206.       Changed = true
  207.       IF EOF(1) THEN 
  208.         Msg("Unexpected end of file.")
  209.       ELSE        
  210.         INPUT #1,columns,rows
  211.         WHILE NOT EOF(1)
  212.           INPUT #1,a,b
  213.           IF a >= 1 AND a <= columns AND b >= 1 AND b <= rows THEN
  214.             X(a,b) = alive : L(a,b) = alive
  215.             LINE (a*cellX+1+xOff,b*cellY+1+yOff)- ~
  216.                     (a*cellX+(cellX-1)+xOff,b*cellY+(cellY-1)+yOff),red,bf
  217.           ELSE
  218.             Msg("Invalid Coordinate: ("+STR$(a)+","+STR$(b)+" )")
  219.           END IF
  220.         WEND
  221.         CLOSE #1
  222.               Msg(theFile+" loaded.")
  223.       END IF
  224.     END IF
  225.       END IF
  226.     END IF
  227.   END IF
  228. END SUB
  229.  
  230. SUB StorePattern
  231. SHARED L
  232. STRING theFile SIZE 80
  233.   theFile = FILEBOX$("Store Life Pattern...")
  234.   IF theFile = "" THEN
  235.     Msg("No file selected.")
  236.   ELSE
  237.     OPEN "O",#1,theFile
  238.     IF HANDLE(1) = null THEN
  239.       Msg("Unable to open "+theFile+".")
  240.     ELSE
  241.       WRITE #1,"#LIFE PATTERN#"
  242.       WRITE #1,maxX,maxY
  243.       FOR i=1 TO maxX
  244.         FOR j=1 TO maxY
  245.       IF L(i,j) = alive THEN WRITE #1,i,j
  246.         NEXT j
  247.       NEXT i
  248.       CLOSE #1
  249.       SetWindowTitles(WINDOW(7),"The Game of Life",leave)
  250.       Msg("Pattern stored in "+theFile+".")
  251.       ShowGenCount
  252.     END IF
  253.   END IF
  254. END SUB
  255.  
  256. SUB ModifyGrid
  257. SHARED X, L
  258. SHARED Modifying, Generating
  259. SHARED GenCount
  260. SHARED xOff, yOff
  261.  
  262.  GenCount = 0
  263.  ShowGenCount
  264.  
  265.   WHILE Modifying
  266.     '..Await left mouse button press.
  267.     WHILE Modifying AND NOT MOUSE(0):SLEEP:WEND
  268.     IF Modifying THEN
  269.       mouseX = MOUSE(1) - xOff
  270.       mouseY = MOUSE(2) - yOff
  271.       IF mouseX > cellX AND mouseX < maxX*cellX+cellX AND ~
  272.          mouseY > cellY AND mouseY < maxY*cellY+cellY THEN
  273.         i = mouseX\cellX
  274.         j = mouseY\cellY
  275.         IF X(i,j) = dead THEN
  276.       L(i,j) = alive
  277.       X(i,j) = alive
  278.       LINE (i*cellX+1+xOff,j*cellY+1+yOff)- ~
  279.            (i*cellX+(cellX-1)+xOff,j*cellY+(cellY-1)+yOff),red,bf
  280.         ELSE
  281.       L(i,j) = dead
  282.       X(i,j) = dead
  283.       LINE (i*cellX+1+xOff,j*cellY+1+yOff)- ~
  284.            (i*cellX+(cellX-1)+xOff,j*cellY+(cellY-1)+yOff),black,bf
  285.         END IF
  286.       END IF
  287.       '..Await left mouse button release.
  288.       WHILE Modifying AND MOUSE(0):SLEEP:WEND
  289.     END IF
  290.   WEND
  291. END SUB
  292.  
  293. SUB GenerateLife
  294. SHARED X, L
  295. SHARED Generating
  296. SHARED GenCount, Changed
  297. SHARED xOff, yOff
  298.  
  299.  REPEAT
  300.   Changed = false
  301.  
  302.   i=1
  303.   WHILE i <= maxX
  304.     j=1
  305.     WHILE j <= maxY
  306.  
  307.       '..Reset neighbour counter.
  308.       s = 0
  309.  
  310.       '..Compute effect of 8 neighbours.
  311.       '..Ignore cells that are off the grid.
  312.       IF i-1 >= 1 AND j-1 >= 1 THEN s = s+L(i-1,j-1)
  313.       IF i+1 <= maxX AND j+1 <= maxY THEN s = s+L(i+1,j+1)
  314.       IF i-1 >= 1 AND j+1 <= maxY THEN s = s+L(i-1,j+1)
  315.       IF i+1 <= maxX AND j-1 >= 1 THEN s = s+L(i+1,j-1)
  316.       IF i-1 >= 1 THEN s = s+L(i-1,j)
  317.       IF j-1 >= 1 THEN s = s+L(i,j-1)
  318.       IF i+1 <= maxX THEN s = s+L(i+1,j)
  319.       IF j+1 <= maxY THEN s = s+L(i,j+1)
  320.  
  321.       '..Determine life/death status of cell.
  322.       IF L(i,j) = alive THEN
  323.     IF s <> 2 AND s <> 3 THEN
  324.       X(i,j) = dead
  325.       Changed = true
  326.     END IF
  327.       ELSE
  328.     IF s = 3 THEN
  329.       X(i,j) = alive
  330.       Changed = true
  331.      END IF
  332.       END IF  
  333.  
  334.       ++j
  335.     WEND
  336.  
  337.     ++i
  338.   WEND
  339.  
  340.   '..Don't allow pattern to be modified/stored until
  341.   '..the Life matrix is in a consistent state.
  342.   MENU mProject,iModify,sDisable
  343.   MENU mProject,iStore,sDisable
  344.  
  345.   '..Refresh main life matrix and display 
  346.   '..current generation.
  347.   FOR i=1 TO maxX
  348.     FOR j=1 TO maxY
  349.       L(i,j) = X(i,j)
  350.       IF L(i,j) = alive THEN colr = red ELSE colr = black 
  351.       LINE (i*cellX+1+xOff,j*cellY+1+yOff)- ~
  352.        (i*cellX+(cellX-1)+xOff,j*cellY+(cellY-1)+yOff),colr,bf
  353.     NEXT j 
  354.   NEXT i
  355.  
  356.   '..Increment generation counter.
  357.   IF Changed THEN
  358.     ++GenCount 
  359.     ShowGenCount
  360.   END IF
  361.  
  362.   '..Allow pattern to be modified/stored now that
  363.   '..the Life matrix is in a consistent state.
  364.   MENU mProject,iModify,sEnable
  365.   MENU mProject,iStore,sEnable
  366.  UNTIL NOT Generating OR NOT Changed
  367.  
  368.  '..Switch generation mode off.
  369.  MENU mProject,iGenerate,sEnable
  370.  Generating = false
  371. END SUB
  372.  
  373. SUB RandomPattern
  374. SHARED X, L
  375. SHARED GenCount, Changed
  376. SHARED xOff, yOff
  377.   MENU mProject,iProject,sDisable
  378.   FOR i=1 TO maxX
  379.     FOR j=1 TO maxY
  380.       IF RND <= .1 THEN status = alive ELSE status = dead
  381.       X(i,j) = status
  382.       L(i,j) = status
  383.       IF L(i,j) = alive THEN colr = red ELSE colr = black 
  384.       LINE (i*cellX+1+xOff,j*cellY+1+yOff)- ~
  385.        (i*cellX+(cellX-1)+xOff,j*cellY+(cellY-1)+yOff),colr,bf
  386.     NEXT j
  387.   NEXT i
  388.   Changed = true
  389.   GenCount = 0
  390.   ShowGenCount
  391.   MENU mProject,iProject,sEnable
  392. END SUB
  393.  
  394. SUB AboutLife
  395.   SetWindowTitles(WINDOW(7),"Life - written in ACE BASIC",leave)
  396.   MsgBox "Version 1.0 by David Benn, 12/94", "Continue"
  397.   ShowGenCount
  398. END SUB
  399.  
  400. {*
  401. ** Main.
  402. *}
  403. RANDOMIZE TIMER
  404. SCREEN 1,scrWidth,scrHeight,3,2
  405. WINDOW 1,"",(0,0)-(scrWidth,scrHeight),0,1
  406. PALETTE black,0,0,0
  407. PALETTE white,1,1,1
  408. PALETTE red,1,0,0
  409. PALETTE green,0,1,0
  410. PALETTE blue,0,0,1
  411. SetupMenus
  412. ClearGrid
  413. DrawGridLines
  414. SetMode(iModify)
  415. ModifyGrid
  416. HavingFun = true
  417. WHILE HavingFun
  418.   SLEEP
  419. WEND
  420. END
  421.  
  422. {*
  423. ** Event handlers.
  424. *}
  425. handle_menu:
  426.   theMenu = MENU(0)
  427.   theItem = MENU(1)
  428.   IF theMenu = mProject THEN
  429.     CASE
  430.       theItem = iLoad        : LoadPattern
  431.  
  432.       theItem = iStore        : StorePattern
  433.  
  434.       theItem = iModify     : IF NOT Modifying THEN
  435.                 SetMode(iModify)
  436.                 ModifyGrid
  437.                       ELSE
  438.                 Modifying = false            
  439.                 MENU mProject,iModify,sEnable
  440.                       END IF
  441.  
  442.       theItem = iGenerate   : IF NOT Generating THEN
  443.                 SetMode(iGenerate)
  444.                 GenerateLife
  445.                       ELSE
  446.                 Generating = false
  447.                 MENU mProject,iGenerate,sEnable
  448.                       END IF
  449.  
  450.  
  451.       theItem = iRandom        : RandomPattern
  452.  
  453.       theItem = iClear         : ClearGrid
  454.  
  455.       theItem = iAbout        : AboutLife
  456.  
  457.       theItem = iQuit         : WINDOW CLOSE 1:SCREEN CLOSE 1:STOP
  458.     END CASE
  459.   END IF
  460. RETURN
  461.