home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 025.lha / ChainReaction (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-04-02  |  7KB  |  186 lines
  1. DEFINT a-z:DEFSNG r,g,b
  2. SCREEN 1,320,200,3,1:WINDOW 3,"",(0,0)-(311,186),16,1:WINDOW OUTPUT 3:COLOR 3,0
  3. DIM s(42,1),u(4,5),p(4,5),j(4,5),bx(4,5),by(4,5),n(1,5),er(528),w1(255),w2(255),rt(30),tr(30),tx(30),ty(30)
  4. FOR i=0 TO 255:w1(i)=RND*255-128:w2(i)=RND*255-128:NEXT
  5. RESTORE palettedata:FOR i=0 TO 7:READ r,g,b:PALETTE i,r,g,b:NEXT
  6.  
  7. palettedata:
  8. DATA 0,0,.7,0,0,0,.8,.8,0,.7,.7,.7,.33,.87,0,.9,.9,.9,.6,0,0,0,.6,0
  9. WIDTH 40:CLS:RANDOMIZE TIMER
  10. GOSUB InitShapes:e=0
  11. FOR i=1 TO 3:FOR j=1 TO 4:j(i,j)=4:NEXT:j(i,0)=3:j(i,5)=3:NEXT
  12. RESTORE Corners:FOR j=1 TO 4:j(0,j)=3:j(4,j)=3:READ a,b:j(a,b)=2:NEXT
  13. Corners: DATA 0,0,0,5,4,0,4,5
  14. RESTORE BombPos:FOR i=1 TO 4:FOR j=1 TO i:READ bx(i,j),by(i,j):NEXT j,i
  15. bx(4,5)=bx(4,4):by(4,5)=by(4,4)
  16. BombPos:DATA 13,9,6,9,20,9,13,5,4,15,22,15,13,3,13,17,4,9,22,9
  17. LOCATE 8,14:PRINT "CHAIN REACTION"
  18. LOCATE 12,9:PRINT "Number of players (1/2)";
  19. WHILE np<>1 AND np<>2:np=VAL(INKEY$):WEND
  20. IF np<>2 THEN
  21.   LOCATE 16,10:PRINT "Computer first (Y/N)?";
  22.   WHILE k$<>"Y" AND k$<>"N":k$=UCASE$(INKEY$):WEND
  23.   tu=ABS(k$="Y")
  24. END IF
  25. CLS:COLOR 3,1:LOCATE 1,13:PRINT "CHAIN REACTION ";
  26. GOSUB DrawGrid
  27.  
  28. MainLoop:
  29. WHILE e=0:tu=-tu+1:co=tu+6
  30.   IF np=1 AND tu=0 THEN
  31.     GOSUB Computer
  32.   ELSE
  33.     GOSUB Human
  34.     WHILE p(y,x)<>tu+1 AND p(y,x):GOSUB Human:WEND
  35.   END IF
  36.   u(y,x)=u(y,x)+1:FS(tu)=FS(tu)+1:IF p(y,x)=0 THEN p(y,x)=tu+1
  37.   GOSUB PlaceBomb
  38.   IF u(y,x)=j(y,x) THEN
  39.     CheckGrid: e=0:fg=0:FOR p=0 TO 4:FOR q=0 TO 5:y=p:x=q
  40.     IF u(y,x)>=j(y,x) AND e=0 THEN fg=1:GOSUB FullSquare
  41.     NEXT q,p:IF fg=1 AND e=0 THEN CheckGrid
  42.   END IF
  43. WEND
  44.  
  45. EndGame:
  46. COLOR 3,1:LOCATE 24,15:PRINT " GAME OVER ";:FOR i=1 TO 10000:NEXT
  47. LOCATE 24,5:PRINT " Press Salad Bar to play again. ";
  48. k$="":WHILE k$<>" ":k$=INKEY$:WEND
  49. SCREEN CLOSE 3:WINDOW CLOSE 3:RUN
  50.  
  51. Human:
  52. WHILE INKEY$<>"":WEND:x=hx(tu):y=hy(tu):dx=0:dy=0:GOSUB DrawCursor:k$=""
  53. WHILE k$<>" ":k$=INKEY$
  54.   IF k$=CHR$(28) THEN IF y>0 THEN dy=-1
  55.   IF k$=CHR$(29) THEN IF y<4 THEN dy=1
  56.   IF k$=CHR$(31) THEN IF x>0 THEN dx=-1
  57.   IF k$=CHR$(30) THEN IF x<5 THEN dx=1
  58.   IF dx<>0 OR dy<>0 THEN
  59.     co=0:GOSUB DrawCursor
  60.     x=x+dx:y=y+dy:co=tu+6:GOSUB DrawCursor
  61.     dx=0:dy=0
  62.   END IF
  63. WEND:hx(tu)=x:hy(tu)=y
  64. co=0:GOSUB DrawCursor:co=tu+6:RETURN
  65.  
  66. FullSquare:
  67. r=0:yy=32*y+15:xx=36*x+50:WAVE 0,w1:WAVE 1,w2
  68. FOR i=1 TO 4:PUT(xx+2,yy+2),er,PSET
  69.   FOR j=1 TO 4:n(1,j)=INT(RND*3)-1:NEXT
  70.   r=-r+1:k=u(y,x)+1:bn=co-6:IF k=6 THEN k=5
  71.   ON k GOSUB b0,b1,b2,b3,b4,b4
  72.   FOR m=255 TO 10 STEP-20:SOUND 100,0.1,m,0
  73.   SOUND 100,0.1,m,3:FOR n=1 TO RND*20:NEXT n,m:NEXT
  74. tx=x:ty=y:J1=0:K1=k-1:y1=32*y+15+by(1,1):x1=36*x+50+bx(1,1)
  75. IF tx>0 THEN x=tx-1:dx=-1:dy=0:GOSUB ExplodeBombs:GOSUB AddBomb
  76. IF tx<5 THEN x=tx+1:dx=1:dy=0:GOSUB ExplodeBombs:GOSUB AddBomb
  77. x=tx:IF ty>0 THEN y=ty-1:dy=-1:dx=0:GOSUB ExplodeBombs:GOSUB AddBomb
  78. IF ty<4 THEN y=ty+1:dy=1:dx=0:GOSUB ExplodeBombs:GOSUB AddBomb
  79. IF FS(0)<1 OR FS(1)<1 THEN e=1
  80. y=ty:u(y,x)=u(y,x)-j(y,x):GOSUB PlaceBomb:IF u(y,x)=0 THEN p(y,x)=0
  81. RETURN
  82.  
  83. AddBomb:
  84. IF p(y,x)<>tu+1 THEN FS(tu)=FS(tu)+u(y,x):FS(-tu+1)=FS(-tu+1)-u(y,x)
  85. p(y,x)=tu+1:u(y,x)=u(y,x)+1:GOSUB PlaceBomb:RETURN
  86.  
  87. DrawGrid:
  88. FOR y=0 TO 4:yy=32*y+16:FOR x=0 TO 5:xx=36*x+51
  89.   LINE(xx,yy)-(xx+34,yy+30),2,b
  90. NEXT x,y
  91. GET(xx+1,yy+1)-(xx+33,yy+29),er:RETURN
  92.  
  93. DrawCursor:
  94. yy=32*y+15:xx=36*x+50
  95. LINE(xx,yy)-(xx+36,yy+32),co,b
  96. LINE(xx+2,yy+2)-(xx+34,yy+30),co,b
  97. RETURN
  98.  
  99. PlaceBomb:
  100. yy=32*y+15:xx=36*x+50:r=0:bn=co-6
  101. PUT(xx+2,yy+2),er,PSET:k=u(y,x)+1:IF k=6 THEN k=5
  102. ON k GOTO b0,b1,b2,b3,b4,b4
  103. b0: RETURN
  104. b1: PUT(xx+bx(1,k-1),yy+by(1,k-1)),s(0,bn):RETURN
  105. b2: FOR j=1 TO k-1:PUT(xx+bx(2,j)+n(r,j),yy+by(2,j)+n(r,j)),s(0,bn):NEXT:RETURN
  106. b3: FOR j=1 TO k-1:PUT(xx+bx(3,j)+n(r,j),yy+by(3,j)+n(r,j)),s(0,bn):NEXT:RETURN
  107. b4: FOR j=1 TO k-1:PUT(xx+bx(4,j)+n(r,j),yy+by(4,j)+n(r,j)),s(0,bn):NEXT:RETURN
  108.  
  109. CheckNeighbor:
  110. fp=1:IF y>0 THEN IF p(y-1,x)=2 THEN ay=y-1:RETURN
  111. IF x>0 THEN IF p(y,x-1)=2 THEN ax=x-1:RETURN
  112. IF x<5 THEN IF p(y,x+1)=2 THEN ax=x+1:RETURN
  113. IF y<4 THEN IF p(y+1,x)=2 THEN ay=y+1:RETURN
  114. fp=0:RETURN
  115.  
  116. Computer:
  117. xt=0:FOR y=0 TO 4:FOR x=0 TO 5
  118. IF p(y,x)<>2 THEN xt=xt+1:ty(xt)=y:tx(xt)=x
  119. NEXT x,y
  120. LOCATE 24,15:COLOR 3,0:PRINT "Thinking...";
  121. FOR i=1 TO xt:rt(i)=0:tr(i)=0:y=ty(i):x=tx(i):GOSUB CheckNeighbor
  122. IF fg=1 AND fp AND u(y,x)>0 THEN EndComputer
  123. IF u(y,x)+1=j(y,x) THEN
  124.   IF fp=1 AND u(ay,ax)+1=j(ay,ax) THEN rt(i)=6:GOTO CheckNext
  125.   IF fp=1 THEN rt(i)=2:GOTO CheckNext
  126.   IF fp=0 THEN rt(i)=1:GOTO CheckNext
  127. END IF
  128. IF j(y,x)=2 THEN
  129.   IF fp=0 AND u(y,x)=1 THEN rt(i)=1:GOTO CheckNext
  130.   IF fp=0 AND u(y,x)=0 THEN rt(i)=4:GOTO CheckNext
  131.   IF fp=1 AND u(y,x)=1 THEN rt(i)=4:GOTO CheckNext
  132. END IF
  133. IF u(ay,ax)+1=j(ay,ax) THEN rt(i)=1:GOTO CheckNext
  134. IF u(y,x)+2>=j(y,x) THEN
  135.   IF fp=1 AND u(ay,ax)+1<j(ay,ax) THEN rt(i)=5:GOTO CheckNext
  136.   IF fp=0 THEN rt(i)=3:GOTO CheckNext
  137.   rt(i)=2:GOTO CheckNext
  138. END IF
  139. IF fp=0 THEN rt(i)=2:GOTO CheckNext
  140. rt(i)=1
  141. CheckNext: NEXT:zt=0:ab=6
  142. WHILE zt=0
  143.   FOR i=1 TO xt:IF rt(i)=ab THEN zt=zt+1:tr(zt)=i
  144.   NEXT:ab=ab-1
  145. WEND
  146. dh=INT(zt*RND)+1:hd=tr(dh):y=ty(hd):x=tx(hd)
  147. EndComputer: LOCATE 24,15:PRINT "           ";:fg=fg+1:RETURN
  148.  
  149. ExplodeBombs:
  150. J1=J1+1:xx=x1-bx(1,1):yy=y1-by(1,1):s=1087:bn=co-6
  151. WAVE 0,SIN:SOUND 660,0.5,255
  152. FOR j=1 TO 500:NEXT:SOUND 0,0,0
  153. PUT(xx+bx(K1,J1)+n(r,J1),yy+by(K1,J1)+n(r,J1)),s(0,bn)
  154. IF dy=0 THEN
  155.   X2=x1+35*dx:dx=dx*4:PUT(x1,y1),s(0,bn)
  156.   FOR i=x1 TO X2 STEP dx:s=s-40:SOUND s,1,50
  157.   PUT(i,y1),s(0,bn):PUT(i+dx,y1),s(0,bn):NEXT
  158.   PUT(xx+3,yy+3),er
  159. ELSE
  160.   Y2=y1+31*dy:dy=dy*4:PUT(x1,y1),s(0,bn)
  161.   FOR i=y1 TO Y2 STEP dy:s=s-40:SOUND s,1,50
  162.   PUT(x1,i),s(0,bn):PUT(x1,i+dy),s(0,bn):NEXT
  163.   PUT(xx+3,yy+3),er
  164. END IF
  165. RETURN
  166.  
  167. InitShapes:
  168. RESTORE RedBomb
  169. FOR j=0 TO 1:FOR i=0 TO 42
  170. READ a$:s(i,j)=VAL("&H"+a$):NEXT i,j:RETURN
  171.  
  172. RedBomb: DATA B,D,3,200,400,400,0,1800
  173. DATA 3000,1B00,A00,400,A00,1B00,0,0
  174. DATA 0,0,0,E00,2780,4FC0,E4E0,F5E0
  175. DATA FBE0,F5E0,64C0,3F80,E00,200,400,400
  176. DATA E00,3F80,7FC0,E4E0,F5E0,FBE0,F5E0,64C0
  177. DATA 3F80,E00,3F80
  178.  
  179. GreenBomb: DATA B,D,3,200,400,400,E00,3F80
  180. DATA 7FC0,FFE0,FFE0,FFE0,FFE0,7FC0,3F80,E00
  181. DATA 0,0,0,E00,2780,4FC0,E4E0,F5E0
  182. DATA FBE0,F5E0,64C0,3F80,E00,200,400,400
  183. DATA E00,3F80,7FC0,E4E0,F5E0,FBE0,F5E0,64C0
  184. DATA 3F80,E00,3F80
  185.  
  186.