home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1990 / USERJA90.MSA / LISTINGS_BGRIDDLE.BAS < prev    next >
BASIC Source File  |  1989-10-26  |  2KB  |  111 lines
  1. REM 2D Life
  2. REM By R.A.Waddilove
  3. REM HiSoft Basic
  4.  
  5. LIBRARY "XBIOS"
  6. DEFINT a-z
  7.  
  8. res=FNgetrez%
  9.  
  10. PALETTE 0,&H000
  11. PALETTE 1,&H077
  12. PALETTE 2,&H007
  13. PALETTE 3,&H777
  14. PALETTE 4,&H770
  15. PALETTE 5,&H700
  16. PALETTE 6,&H070
  17. PALETTE 7,&H770
  18. PALETTE 8,&H707
  19.  
  20. MOUSE -1
  21.  
  22. IF res=2 THEN size=4 ELSE size=2
  23.  
  24. DIM s(40,40),b(40,40)
  25. DIM x(50),y(40)
  26. scr$=STRING$(33000,0)
  27.  
  28. screen2&=256+SADD(scr$) AND &HFFFFFF00
  29. screen1&=FNphysbase&
  30.  
  31. WINDOW FULLW 2
  32.  
  33. DO
  34. DO
  35.     CLEARW 2
  36.     COLOR 1
  37.     PRINT "Griddles..."
  38.     PRINT "============"
  39.     PRINT
  40.     INPUT "Grid size (5-40)";m:m=m-1
  41.     PRINT
  42.     INPUT "Number of colours (2-8)";c
  43. LOOP UNTIL (m>3 AND m<40) AND (c>1 AND c<9)
  44. CLEARW 2
  45. FOR i=0 TO 40
  46. IF res THEN
  47.     x(i)=320-(size+2)*m/2+i*(size+2) : y(i)=200-(size+2)*m/2+i*(size+2)
  48. ELSE
  49.     x(i)=160-(size+2)*m/2+i*(size+2) : y(i)=100-(size+2)*m/2+i*(size+2)
  50. END IF
  51. NEXT
  52. ' Initialise array to 1st colour
  53. FOR i=0 TO m
  54. FOR j=0 TO m
  55. s(i,j)=1
  56. NEXT
  57. NEXT
  58.  
  59. flag=0
  60. gen=0
  61. DO
  62. GOSUB flip
  63. FOR i=0 TO m
  64. FOR j=0 TO m
  65. IF res THEN COLOR 0,1,0,2*s(i,j),2 ELSE color 0,s(i,j),0,8,2
  66. bar x(i),y(j),size,size
  67. t=0
  68. IF i>0 AND j>0 AND i<m and j<m THEN
  69.     t=s(i-1,j)+s(i+1,j)+s(i,j-1)+s(i,j+1)+s(i-1,j-1)+s(i+1,j-1)+s(i-1,j+1)+s(i+1,j+1)
  70. ELSE
  71.     GOSUB count
  72. END IF
  73. b(i,j)=t MOD c
  74. NEXT
  75. NEXT
  76.  
  77. FOR i=0 TO m
  78. FOR j=0 TO m
  79. s(i,j)=b(i,j)
  80. NEXT
  81. NEXT
  82.  
  83. COLOR 4:GOTOXY 8,0:?"Griddle generation:";gen
  84. COLOR 1:GOTOXY 3,21:?"Press S to stop, Space to restart";
  85. gen=gen+1
  86.  
  87. k$=INKEY$
  88. LOOP UNTIL k$<>""
  89. CLEARW 2 : GOSUB flip : CLEARW 2
  90. SETSCREEN screen1&,screen1&,-1
  91. LOOP UNTIL k$="S" OR k$="s"
  92. MOUSE 0
  93. SYSTEM
  94.  
  95. count:
  96. IF i>0 THEN t=t+s(i-1,j) : IF j>0 THEN t=t+s(i-1,j-1)
  97. IF i<m THEN t=t+s(i+1,j) : IF j>0 THEN t=t+s(i+1,j-1)
  98. IF j>0 THEN t=t+s(i,j-1)
  99. IF j<m THEN t=t+s(i,j+1) : IF i>0 THEN t=t+s(i-1,j+1)
  100. IF i<m AND j<m THEN t=t+s(i+1,j+1)
  101. RETURN
  102.  
  103. flip:
  104. flag=flag XOR 1
  105. IF flag THEN
  106.     SETSCREEN screen2&,screen1&,-1
  107. ELSE
  108.     SETSCREEN screen1&,screen2&,-1
  109. END IF
  110. RETURN
  111.