home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 3: The Continuation / 17-Bit_The_Continuation_Disc.iso / files / nz14.dms / nz14.adf / Quarters.Game < prev    next >
Text File  |  1993-12-03  |  6KB  |  272 lines
  1.  
  2. 'QUARTERS
  3. 'By Jerry Lancaster
  4. 'This program is based on a listing published in 
  5. 'Computing with the Amstrad CPC'
  6. 'September 1987
  7. 'Converted to the Amiga by Rex Moir
  8.  
  9. CLEAR,25000:CLEAR,50000&
  10. DEFINT a-z
  11. DIM dom(70),sc(2),gs(4),ts(4),dx(2),dy(2),d(130)
  12. dx(1)=35:dy(1)=20:dx(2)=275:dy(2)=20
  13. SCREEN 1,320,256,3,1
  14. WINDOW 2,,(0,0)-(311,242),0,1 
  15. PALETTE 0,.1,.7,.7
  16. PALETTE 1,1,0,0
  17. PALETTE 2,0,.8,.4
  18. PALETTE 3,.1,.25,.9
  19. PALETTE 4,1,.8,0
  20. PALETTE 5,.9,.9,.9
  21. PALETTE 6,.1,.1,.5
  22. PALETTE 7,.6,0,.6
  23. COLOR 7,0
  24.  
  25. Title:
  26. LINE (1,1)-(310,249),,b
  27. LINE (1,1)-(310,249)
  28. LINE (1,249)-(310,1)
  29. PAINT(150,3),1,7
  30. PAINT(150,240),2,7 
  31. PAINT(10,120),3,7
  32. PAINT(300,120),4,7
  33.  
  34. LOCATE 5,16:PRINT "QUARTERS" 
  35. LOCATE 26,16:PRINT "QUARTERS"
  36. LOCATE 16,3:PRINT "QUARTERS"
  37. LOCATE 16,30:PRINT "QUARTERS"
  38.  
  39. Dominoes:
  40. RESTORE DomData
  41. FOR i=1 TO 70:READ dom(i):NEXT
  42. FOR i=1 TO 70:s=INT(RND*70)+1:z=dom(i):dom(i)=dom(s):dom(s)=z:NEXT
  43. DomData:
  44. DATA 1432,2222,3333,4444,1112,1113,1114
  45. DATA 2221,2223,2224,3331,3332,3334,1342
  46. DATA 4441,4442,4443,1122,1133,1144,1423
  47. DATA 2233,2244,3344,1212,1313,1414,1111
  48. DATA 2323,2424,3434,1123,1132,1124,4142
  49. DATA 1142,1134,1143,2213,2231,2214,4143
  50. DATA 2241,2234,2243,3314,3341,3324,4243
  51. DATA 3342,3312,3321,4412,4421,4413,1234
  52. DATA 4431,4423,4432,1213,1214,1314,1243
  53. DATA 2123,2124,2324,3132,3134,3234,1324
  54.  
  55. Choices:
  56. WINDOW 3,,(93,75)-(218,166),0,1:WINDOW OUTPUT 3
  57. PRINT :PRINT 
  58. PRINT :PRINT "1 - One Player "
  59. PRINT :PRINT "2 - Two Players"
  60. PRINT :PRINT "3 -  Against"
  61. PRINT  "  the Computer"
  62. PRINT :PRINT "4 - Instructions"
  63. WHILE (ch$<"1" OR ch$>"4"):ch$=INKEY$:WEND
  64. c=VAL(ch$):ch$=""
  65. WINDOW CLOSE 3
  66. CLS
  67. IF c=4 THEN GOSUB Instructions:GOTO Choices
  68.  
  69.  
  70. DrawBoard:
  71. LINE (30,15)-(70,45),,b
  72. IF c>1 THEN LINE (270,15)-(310,45),,b
  73. LINE (50,60)-(290,240),,b
  74. FOR i=80 TO 220 STEP 20
  75. LINE (50,i)-(290,i)
  76. NEXT
  77. FOR i=80 TO 260 STEP 30
  78. LINE  (i,60)-(i,240)
  79. NEXT
  80. COLOR 5,6
  81. LINE (10,82)-STEP(18,18),,b:PAINT (12,85),6,5
  82. LOCATE 12,3:PRINT "R"
  83. LINE (10,122)-STEP(18,18),,b:PAINT (12,125),6,5
  84. LOCATE 17,3:PRINT "D"
  85. LINE (10,162)-STEP(18,18),,b:PAINT (12,165),6,5
  86. LOCATE 22,3:PRINT "S"
  87. LINE (10,202)-STEP(18,18),,b:PAINT (12,205),6,5
  88. LOCATE 27,3:PRINT "Q"
  89.  
  90. Play:
  91. p=1:q=2:u=0:sc(1)=0:sc(2)=0:COLOR 7,0:GOSUB PrintScore
  92. WHILE u<70
  93. GOSUB NewDom
  94. x=dx(p):y=dy(p)
  95. GOSUB PrintDom
  96. IF p=2 AND c=3 THEN 
  97.   GOSUB CompMove
  98. ELSE
  99.   GOSUB Move
  100. END IF
  101. GOSUB PrintScore
  102. IF c<>1 THEN SWAP p,q
  103. WEND
  104.  
  105. EndGame:
  106. WINDOW 3,,(51,59)-(289,239),0,1:WINDOW OUTPUT 3
  107. LOCATE 5,12:PRINT "GAME OVER"
  108. IF c=1 THEN
  109.   IF sc(1)>hs THEN hs=sc(1)
  110.   LOCATE 9,7:PRINT "HIGHEST SCORE IS ";hs
  111.   LOCATE 11,7:PRINT "YOUR SCORE WAS   ";sc(1)
  112. ELSE
  113.   IF sc(1)>sc(2) THEN gs(1)=gs(1)+1
  114.   IF sc(2)>sc(1) THEN gs(2)=gs(2)+1
  115.   ts(1)=ts(1)+sc(1)
  116.   ts(2)=ts(2)+sc(2)
  117.   FOR i=1 TO 2
  118.   LOCATE 8+i*2,3:PRINT "PLAYER  ";i;"HAS WON";gs(i);"GAMES"
  119.   LOCATE 9+i*2,3:PRINT "SCORING ";ts(i);" TOTAL POINTS"
  120.   PRINT
  121.   NEXT
  122. END IF
  123. LOCATE 16,8:PRINT "CLICK LEFT MOUSE"
  124. LOCATE 17,8:PRINT "FOR ANOTHER GAME"
  125. WHILE MOUSE(0)<>0:WEND 
  126. WHILE MOUSE(0)=0:WEND
  127. WINDOW CLOSE 3
  128. CLS:GOTO Dominoes
  129.  
  130. NewDom:
  131. u=u+1:n=dom(u)
  132. SplitCode:
  133. n4=n MOD 10:n3=(INT(n/10))MOD 10:n2=(INT(n/100))MOD 10
  134. n1=INT(n/1000)
  135. RETURN
  136.  
  137. PrintDom:
  138. LINE (x,y)-(x+30,y+20),,b
  139. LINE (x,y)-(x+30,y+20)
  140. LINE (x,y+20)-(x+30,y)
  141. PAINT(x+1,y+10),n1,7
  142. PAINT(x+15,y+1),n2,7 
  143. PAINT(x+25,y+10),n3,7
  144. PAINT(x+15,y+15),n4,7
  145. RETURN
  146.  
  147. DelDom:
  148. m=n:n=0
  149. GOSUB SplitCode
  150. x=dx(p):y=dy(p)
  151. GOSUB PrintDom:n=m:RETURN
  152.  
  153. RotDom:
  154. n=(n MOD 1000)*10 + n/1000
  155. GOSUB SplitCode
  156. RETURN
  157.  
  158. CheckValid:
  159. sum=0
  160. IF POINT (x-1,y+10)=0 OR POINT (x-1,y+10)=n1 THEN sum=sum+1
  161. IF POINT (x+15,y-1)=0 OR POINT (x+15,y-1)=n2 THEN sum=sum+1
  162. IF POINT (x+31,y+10)=0 OR POINT (x+31,y+10)=n3 THEN sum=sum+1
  163. IF POINT (x+15,y+21)=0 OR POINT (x+15,y+21)=n4 THEN sum=sum+1
  164. RETURN
  165.  
  166. UpdateScore:
  167. score=0
  168. IF POINT (x-1,y+10)=n1 THEN score=score+1
  169. IF POINT (x+15,y-1)=n2 THEN score=score+1
  170. IF POINT (x+31,y+10)=n3 THEN score=score+1
  171. IF POINT (x+15,y+21)=n4 THEN score=score+1
  172. IF score=0 THEN RETURN
  173. score=2*score-1
  174. FOR a=1 TO score:SOUND 130.81*a,a,90:NEXT a
  175. sc(p)=sc(p)+score
  176. RETURN
  177.  
  178. PrintScore:
  179. v=(u+1)/2:w=u/2
  180. IF c=1 THEN v=u:w=u:sc(2)=sc(1)
  181. LOCATE 3,15:PRINT v;" TURNS ";w
  182. LOCATE 5,15:PRINT sc(1);" SCORE ";sc(2)
  183. RETURN
  184.  
  185. Move:
  186. WHILE MOUSE(0)>-1:WEND
  187. x=MOUSE(3):y=MOUSE(4)
  188. IF y<60 THEN Move
  189. IF x<50 THEN Options
  190. WHILE MOUSE(0)<0:WEND
  191. x=INT((MOUSE(5)-20)/30)*30+20
  192. y=INT((MOUSE(6)-40)/20)*20+40
  193. full=POINT(x+1,y+1):IF full THEN Move
  194. GOSUB CheckValid
  195. IF sum=4 THEN
  196.   GET (dx(p),dy(p))-(dx(p)+30,dy(p)+20),d
  197.   PUT (x,y),d,PSET
  198.   GOSUB UpdateScore
  199.   GOSUB DelDom
  200. ELSE 
  201.   SOUND 493.88,3,90:SOUND 440,2,90:SOUND 392,1,90
  202.   GOTO Move
  203. END IF
  204. RETURN
  205.  
  206. CompMove:
  207. x=20:y=60
  208. valid=0:WHILE valid<>1
  209. NextDom:
  210. x=x+30
  211. IF x>260 THEN y=y+20:x=50
  212. IF y>220 THEN valid=1:SOUND 493.88,3,90:SOUND 440,2,90:SOUND 392,1,90:RETURN
  213. full=POINT(x+1,y+1):IF full THEN NextDom
  214. rot=0:WHILE rot<4
  215. GOSUB CheckValid
  216. IF sum<4 THEN
  217.   GOSUB RotDom:rot=rot+1
  218. ELSE
  219.   rot=4:valid=1
  220. END IF
  221. WEND
  222. WEND
  223. GOSUB PrintDom
  224. GOSUB UpdateScore
  225. cc=x:cy=y:GOSUB DelDom:x=cx:y=cy
  226. RETURN
  227.  
  228. Options:
  229. IF x<10 OR x>28 GOTO Move
  230. y=INT(y-2)/20
  231. IF y=4 THEN GOSUB RotDom:x=dx(p):y=dy(p):GOSUB PrintDom:GOTO Move
  232. IF y=6 THEN DelDom
  233. IF y=8 THEN CLS:hs=0:gs(1)=0:gs(2)=0:ts(1)=0:ts(2)=0:GOTO Title
  234. IF y=10 THEN WINDOW CLOSE 2:SCREEN CLOSE 1:STOP
  235. GOTO Move
  236.  
  237. Instructions:
  238. PRINT 
  239. PRINT "  QUARTERS is played on a 9 X 8 grid."
  240. PRINT 
  241. PRINT "  The tile to be played is displayed"
  242. PRINT "  above the board and can be rotated"
  243. PRINT "  by clicking in the R box."
  244. PRINT
  245. PRINT "  To place the tile, click in the"
  246. PRINT "  desired location."
  247. PRINT 
  248. PRINT "  If it is impossible to play"
  249. PRINT "  click in the D box."
  250. PRINT 
  251. PRINT "  Click in the S box to start a new"
  252. PRINT "  game and click Q to finish."
  253. PRINT 
  254. PRINT "  You score every time you place a"
  255. PRINT "  on the board, gaining more points"
  256. PRINT "  if you match more than one edge"
  257. PRINT "  with neighbouring tiles."
  258. PRINT 
  259. PRINT "  There are three ways to play:"
  260. PRINT "      - solo,"
  261. PRINT "      - against another person, or"
  262. PRINT "      - against the computer."
  263. PRINT 
  264. PRINT "  The game ends when all 70 tiles"
  265. PRINT "  have been used."
  266. PRINT    
  267. PRINT  "     Click Mouse to continue."
  268. WHILE MOUSE(0)=0:WEND
  269. CLS
  270. RETURN
  271.  
  272.