home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GAS / GAS02.ZIP / LIFE2.BAS < prev    next >
BASIC Source File  |  1984-12-19  |  9KB  |  189 lines
  1. 1 '   LIFE = The game of LIFE by John Conway - a simulation
  2. 2 '    This version by John Sigle        2/21/83
  3. 50  ' Initialization
  4. 51     DEFINT A-Z
  5. 52     C=0:R=0:CUR=0:NXT=1:NN=0:CR=0:RN=0       'Mention early for efficiency
  6. 53     NROWS=21:NCOLS=78
  7. 55     DIM G(NROWS+1,NCOLS+1,1)
  8. 58     DIM CLIST(1,1500,1), LLEN(1)
  9. 60     DIM CH$(1):CH$(0)="X" : CH$(1)="O"
  10. 70     KEY OFF
  11. 100 ' Present instructions
  12. 101    GOSUB 1000
  13. 151 ' Clear screen and draw box
  14. 152    GOSUB 2500
  15. 200 ' Get and display new pattern from player
  16. 202    GOSUB 2000
  17. 250 ' Begin or continue evolution
  18. 255     LOCATE 24,1 : PRINT SPACE$(79);
  19. 256     LOCATE 24,1 : COLOR 0,7:PRINT " RUN mode ";:COLOR 7,0
  20. 260     LOCATE 25,1 : PRINT SPACE$(79);
  21. 261     LOCATE 25,1 : COLOR 15:PRINT " E";:COLOR 7:PRINT"=Edit, ";:COLOR 15:PRINT"space";:COLOR 7:PRINT"=Pause, ";:COLOR 15:PRINT"C";:COLOR 7:PRINT"=Continue, ";:COLOR 15:PRINT"Q";:COLOR 7:PRINT"=Quit";
  22. 300 ' Repeat until key is pressed
  23. 350 '   Calculate and display next generation
  24. 352      GOSUB 4000
  25. 375 '   Advance to new generation
  26. 376      SWAP CUR,NXT
  27. 378      SOUND 700,.1 : FOR K=1 TO 2000 : NEXT K
  28. 380 '   Check for key pressed
  29. 385      C$=INKEY$:IF C$="" THEN GOTO 300
  30. 500 ' What did player press?
  31. 501    IF C$="E" OR C$="e" THEN GOTO 200
  32. 502    IF C$="Q" OR C$="q" THEN CLS:    GOTO 65000
  33. 503    IF C$="C" OR C$="c" THEN GOTO 250
  34. 504    IF C$=" " THEN C$=INPUT$(1):GOTO 501
  35. 505    GOTO 385
  36. 1000 ' Routine to present instructions
  37. 1006 CLS :PRINT
  38. 1008 PRINT "                               L  I  F  E"
  39. 1009 PRINT
  40. 1010 PRINT "   The original game of life was invented by mathematician John Conway."
  41. 1011 PRINT " The idea is to initialize the screen with a pattern of bacteria "
  42. 1112 PRINT " in 'EDIT' mode.  The 'RUN' mode then brings life to the colony."
  43. 1114 PRINT " The population increases and decreases according to fixed rules "
  44. 1116 PRINT " which affect the birth and death of individual bacterium. "
  45. 1118 PRINT " A rectangular grid (2-dimensional matrix) will be shown on the screen."
  46. 1120 PRINT " Each cell in the grid can contain a bacterium or be empty.  Each cell"
  47. 1122 PRINT " has 8 neighbors except that cells on the boundry have less than 8 "
  48. 1124 PRINT " neighbors.  The existance of cells from one generation to the next"
  49. 1126 PRINT " is determined by the following rules:"
  50. 1128 PRINT:PRINT "  1.  A bacteria with 2 or 3 neighbors survives from one generation to "
  51. 1130 PRINT "      the next.  A bacterium with fewer neighbors dies of isolation."
  52. 1132 PRINT "      One with more neighbors dies of overcrowding."
  53. 1134 PRINT:PRINT "  2.  An empty cell spawns a bacteria if it has exactly three "
  54. 1136 PRINT "      neighboring cells which contain bacteria."
  55. 1150 PRINT:PRINT
  56. 1152 PRINT "   Press the spacebar to continue";:ANS$=INPUT$(1)
  57. 1154 CLS : PRINT:PRINT
  58. 1170 PRINT " In EDIT mode the following commands are available:"
  59. 1172 PRINT : PRINT
  60. 1174 PRINT "  ";CHR$(24);CHR$(25);CHR$(26);CHR$(27);"         to move the cursor"
  61. 1176 PRINT "  M            to Mark a cell as having a bacterium"
  62. 1178 PRINT "  space        to erase a mark from a cell"
  63. 1180 PRINT "  R            to enter the RUN mode (i.e. start the evolutionary process)"
  64. 1182 PRINT "  C            to Clear the grid in order to create a new pattern"
  65. 1184 PRINT "  Q            to Quit the game of LIFE"
  66. 1186 PRINT : PRINT
  67. 1188 PRINT" In RUN mode the following commands are available:"
  68. 1190 PRINT
  69. 1192 PRINT "  E            to enter the EDIT mode to create or change the pattern"
  70. 1194 PRINT "  space        to pause"
  71. 1196 PRINT "  C            to Continue the execution after a pause"
  72. 1198 PRINT "  Q            to Quit the game of LIFE"
  73. 1199 PRINT : PRINT "The EDIT, pause and Quit commands take effect only at the end of a cycle."
  74. 1204 PRINT : PRINT "Press spacebar to continue";:ANS$=INPUT$(1)  : RETURN
  75. 2000 ' Routine to get and display a pattern
  76. 2010 '  Print instructions on line 25
  77. 2011     LOCATE 24,1 : PRINT SPACE$(79);
  78. 2012     LOCATE 24,1 : COLOR 0,7 :PRINT " EDIT mode ";:COLOR 7,0
  79. 2013     LOCATE 25,1 : PRINT SPACE$(79);
  80. 2014     LOCATE 25,1 : PRINT "Use ";:COLOR 15:PRINT CHR$(24);CHR$(25);CHR$(26);    CHR$(27);:COLOR 7:PRINT" to move cursor, ";
  81. 2015 COLOR 15:PRINT"M";:COLOR 7:PRINT"=mark, ";:COLOR 15:PRINT"space";:COLOR 7:PRINT"=erase, ";:COLOR 15:PRINT"R";:COLOR 7:PRINT "=Run, ";:COLOR 15:PRINT"C";:  COLOR 7:PRINT"=Clear screen, ";:COLOR 15:PRINT"Q";:COLOR 7:PRINT "=quit";
  82. 2016     DEF SEG=0:POKE 1052,PEEK(1050):DEF SEG
  83. 2020 '  Initialize cursor
  84. 2022     RN=11:CN=39:LOCATE RN+1,CN+1,1
  85. 2030 '  Top of input loop
  86. 2031     C$=INKEY$:IF C$="" THEN 2031
  87. 2032     IF LEN(C$)=2 THEN GOTO 2040
  88. 2033      IF C$="M" OR C$="m" THEN GOSUB 2080:GOTO 2031
  89. 2034      IF C$=" " THEN GOSUB 2070:GOTO 2031
  90. 2035      IF C$="R" OR C$="r" THEN RETURN
  91. 2036      IF C$="C" OR C$="c" THEN GOSUB 2110:GOTO 2031
  92. 2038      IF C$="Q" OR C$="q" THEN GOTO 65000
  93. 2039      GOTO 2031
  94. 2040     CC=ASC(RIGHT$(C$,1))                   'Two char. code
  95. 2041      IF CC=72 THEN GOSUB 2050:GOTO 2031
  96. 2042      IF CC=75 THEN GOSUB 2055:GOTO 2031
  97. 2043      IF CC=77 THEN GOSUB 2060:GOTO 2031
  98. 2044      IF CC=80 THEN GOSUB 2065:GOTO 2031
  99. 2045      GOTO 2031
  100. 2050 '  Up arrow
  101. 2051     IF RN>1 THEN RN=RN-1:LOCATE RN+1,CN+1,1
  102. 2052     RETURN
  103. 2055 '  Left arrow
  104. 2056     IF CN>1 THEN CN=CN-1:LOCATE RN+1,CN+1,1
  105. 2057     RETURN
  106. 2060 '  Right arrow
  107. 2061     IF CN<NCOLS THEN CN=CN+1:LOCATE RN+1,CN+1,1
  108. 2062     RETURN
  109. 2065 '  Down arrow
  110. 2066     IF RN<NROWS THEN RN=RN+1:LOCATE RN+1,CN+1,1
  111. 2067     RETURN
  112. 2070 '  Spacebar = erase
  113. 2071     IF G(RN,CN,CUR)=0 THEN RETURN
  114. 2072     FOR K=LLEN(CUR) TO 1 STEP -1
  115. 2073       IF CLIST(0,K,CUR)=RN AND CLIST(1,K,CUR)=CN THEN GOTO 2075
  116. 2074     NEXT K  :  STOP
  117. 2075     FOR J=K TO LLEN(CUR)-1
  118. 2076      CLIST(0,J,CUR)=CLIST(0,J+1,CUR):CLIST(1,J,CUR)=CLIST(1,J+1,CUR)
  119. 2077     NEXT
  120. 2078     G(RN,CN,CUR)=0:PRINT " ";:LOCATE RN+1,CN+1,1  : RETURN
  121. 2080 '  Any letter
  122. 2081     IF G(RN,CN,CUR)=1 THEN RETURN
  123. 2082     G(RN,CN,CUR)=1
  124. 2084     LLEN(CUR)=LLEN(CUR)+1
  125. 2086     CLIST(0,LLEN(CUR),CUR)=RN:CLIST(1,LLEN(CUR),CUR)=CN
  126. 2087     LOCATE RN+1,CN+1,1:PRINT CH$(CUR);:LOCATE RN+1,CN+1,1
  127. 2089     RETURN
  128. 2110 '  Routine to clear screen
  129. 2112     FOR K=1 TO LLEN(CUR)
  130. 2114        RN=CLIST(0,K,CUR):CN=CLIST(1,K,CUR):G(RN,CN,CUR)=0
  131. 2115        LOCATE RN+1,CN+1:PRINT " ";
  132. 2116     NEXT K
  133. 2118     LLEN(CUR)=0
  134. 2119     RETURN
  135. 2500 ' Routine to clear screen and print box
  136. 2502    CLS
  137. 2504    PRINT CHR$(218);
  138. 2506    FOR K=1 TO NCOLS:PRINT CHR$(196);:NEXT:PRINT CHR$(191);
  139. 2508    FOR K=2 TO NROWS+1:LOCATE K,NCOLS+2:PRINT CHR$(179);:NEXT
  140. 2510    FOR K=2 TO NROWS+1:LOCATE K,1:PRINT CHR$(179);:NEXT
  141. 2512    LOCATE NROWS+2,1:PRINT CHR$(192);
  142. 2514    FOR K=1 TO NCOLS:PRINT CHR$(196);:NEXT:PRINT CHR$(217);
  143. 2599    RETURN
  144. 4000 '^ Routine to calculate and display next generation
  145. 4001     LOCATE ,,0
  146. 4002 '  Zero out last generation
  147. 4004     FOR K=1 TO LLEN(NXT)
  148. 4006        RN=CLIST(0,K,NXT):CN=CLIST(1,K,NXT):G(RN,CN,NXT)=0
  149. 4007     NEXT K
  150. 4008     LLEN(NXT)=0 :LL=0
  151. 4010 '  Repeat for each cell on the current CLIST
  152. 4012     FOR K=1 TO LLEN(CUR)
  153. 4020 '    Determine if it lives, put it on list and display it.
  154. 4022       RN=CLIST(0,K,CUR):CN=CLIST(1,K,CUR)
  155. 4023       R=RN:C=CN:GOSUB 4100    ' Count its neighbors
  156. 4025       IF NN=2 OR NN=3 THEN GOTO 4030
  157. 4026 '       Cell dies
  158. 4027         G(RN,CN,NXT)=0:LOCATE RN+1,CN+1:PRINT " ";
  159. 4029         GOTO 4040
  160. 4030 '       Cell lives
  161. 4031         LL=LL+1:CLIST(0,LL,NXT)=RN:CLIST(1,LL,NXT)=CN:G(RN,CN,NXT)=1
  162. 4032         LOCATE RN+1,CN+1 : PRINT CH$(NXT);
  163. 4040 '    Consider each of its neighbors
  164. 4041       R=RN-1:C=CN:GOSUB 4200
  165. 4042       R=RN-1:C=CN+1:GOSUB 4200
  166. 4043       R=RN:C=CN+1:GOSUB 4200
  167. 4044       R=RN+1:C=CN+1:GOSUB 4200
  168. 4045       R=RN+1:C=CN:GOSUB 4200
  169. 4046       R=RN+1:C=CN-1:GOSUB 4200
  170. 4047       R=RN:C=CN-1:GOSUB 4200
  171. 4048       R=RN-1:C=CN-1:GOSUB 4200
  172. 4060     NEXT K
  173. 4062     LLEN(NXT)=LL
  174. 4099    RETURN
  175. 4100 ' Routine to count current neighbors of cell at r,c
  176. 4102    NN=G(R-1,C,CUR)+G(R-1,C+1,CUR)+G(R,C+1,CUR)+G(R+1,C+1,CUR)+                        G(R+1,C,CUR)+G(R+1,C-1,CUR)+G(R,C-1,CUR)+G(R-1,C-1,CUR) :RETURN
  177. 4200 ' Routine to analyze and manipulate a neighbor of cell at rn,cn
  178. 4203    IF G(R,C,CUR)=1 THEN RETURN  'Cell is currently alive
  179. 4211    IF R=0 OR R>NROWS OR C=0 OR C>NCOLS THEN RETURN 'Cell on border
  180. 4213    IF G(R,C,NXT)=1 THEN RETURN  'Cell already added
  181. 4221    GOSUB 4100  'Count its neighbors
  182. 4230 '  if nn=3 then cell becomes alive
  183. 4231     IF NN=3 THEN                                                                       LL=LL+1:CLIST(0,LL,NXT)=R:CLIST(1,LL,NXT)=C:G(R,C,NXT)=1 :                      LOCATE R+1,C+1:PRINT CH$(NXT);
  184. 4299    RETURN
  185. 65000 ' Return to Magazette
  186. 65001 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT "  Press ESC key to continue ";:ANS$=INPUT$(1):IF ASC(ANS$)<>27 THEN 65001
  187. 65002 IF ADDR.%<>0 THEN RUN DRIVE$+":"+"START"
  188. 65005 END
  189.