home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1990 / USERJA90.MSA / LISTINGS_GRIDDLE.BAS < prev    next >
BASIC Source File  |  1989-10-26  |  2KB  |  107 lines
  1. REM Griddles
  2. REM By R.A.Waddilove
  3. REM HiSoft Basic
  4.  
  5. DEFINT a-z
  6.  
  7. PALETTE 0,&H000
  8. PALETTE 1,&H077
  9. PALETTE 2,&H007
  10. PALETTE 3,&H777
  11. PALETTE 4,&H770
  12. PALETTE 5,&H700
  13. PALETTE 6,&H070
  14. PALETTE 7,&H707
  15.  
  16. MOUSE -1
  17.  
  18. DIM s(15,15),b(15,15)
  19.  
  20. WINDOW FULLW 2
  21.  
  22. DO
  23.     GOSUB init:
  24.     gen=0
  25.     DO
  26.         CLEARW 2
  27.         FOR y=0 TO 150 STEP 64
  28.             FOR x=0 TO 250 STEP 62
  29.                 GOSUB prints
  30.                 GOSUB nextgen
  31.                 gen=gen+1
  32.             NEXT
  33.         NEXT
  34.         COLOR 3
  35.         GOTOXY 0,21
  36.         PRINT "More? (Y/N)";
  37.         GOSUB readkey
  38.     LOOP UNTIL k$="N" OR k$="n"
  39.     GOTOXY 0,21
  40.     PRINT "New grid? (Y/N)";
  41.     GOSUB readkey
  42. LOOP UNTIL k$="N" OR k$="n"
  43. MOUSE 0
  44. SYSTEM
  45.  
  46. REM ------ Read the keyboard --------
  47. readkey:
  48. DO
  49.     k$=INKEY$
  50. LOOP UNTIL k$<>""
  51. RETURN
  52.  
  53. REM --------- Initialise ------------
  54. init:
  55. DO
  56.     CLEARW 2
  57.     COLOR 4
  58.     PRINT "Griddles..."
  59.     PRINT "============"
  60.     PRINT
  61.     COLOR 1
  62.     INPUT "Grid size (4-12)";m
  63.     PRINT
  64.     INPUT "Number of colours (2-8)";c
  65. LOOP UNTIL (m>3 AND m<13) AND (c>1 AND c<9)
  66. FOR i=0 TO 15
  67.     FOR j=0 TO 15
  68.         s(i,j)=0
  69.     NEXT
  70. NEXT
  71. FOR i=1 TO m
  72.     FOR j=1 TO m
  73.         s(i,j)=1
  74.     NEXT
  75. NEXT
  76. RETURN
  77.  
  78. REM --- Calculate next generation ---
  79. nextgen:
  80. FOR i=1 TO m
  81.     FOR j=1 TO m
  82.         color 0,s(i,j),0,8,2
  83.         bar x+i*4+2*(12-m),y+j*4+2*(12-m),2,2
  84.         t=0
  85.         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)
  86.         b(i,j)=t MOD c
  87.     NEXT
  88. NEXT
  89. FOR i=1 TO m
  90.     FOR j=1 TO m
  91.         s(i,j)=b(i,j)
  92.     NEXT
  93. NEXT
  94. RETURN
  95.  
  96. REM --- Print colours/generation ----
  97. prints:
  98. k$=STR$(c)+":"+STR$(gen)
  99. DO
  100.     i=INSTR(k$," ")
  101.     IF i THEN k$=LEFT$(k$,i-1)+MID$(k$,i+1)
  102. LOOP UNTIL i=0
  103. COLOR 4
  104. GOTOXY 1+7*x/62,6+7*y/64
  105. PRINT k$
  106. RETURN
  107.