home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1992 August / 1992-08.d64 / pyramid.prg (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1992-01-01  |  7.3 KB  |  193 lines
  1. 0 rem pyramid * v3.92 * robert b. cook
  2. 100 gosub332:gosub294:gosub244
  3. 102 sc=0:pk=1:mx=83:my=236:xc=0:yc=6:y1=6:syssp,0,mx,my:pokeso,1
  4. 104 js=peek(56320)and31:ifjs=31then104
  5. 106 ifjs=15andxc=-2andyc=0then210
  6. 108 ifjs=15thengosub122:iflo=0then210
  7. 110 ifjs=27thenmx=mx-16-(mx=51)*16
  8. 112 ifjs=23thenmx=mx+16+(mx=307)*16
  9. 114 ifjs=30thenmy=my-24-(my=92)*24
  10. 116 ifjs=29thenmy=my+24+(my=236)*24
  11. 118 syssp,0,mx,my:goto104
  12. 120 :: card ::
  13. 122 xc=(mx-83)/16:yc=(my-92)/24
  14. 124 ifxc<0orxc>12then172
  15. 126 iflo(xc,yc)=-1thenreturn
  16. 128 ifyc=6then134
  17. 130 t1=lo(xc-1,yc+1):t2=lo(xc+1,yc+1)
  18. 132 if(t1>-1ort2>-1)andpk=1then228
  19. 134 ifgm=1then158
  20. 136 ifpk=2then142
  21. 138 t=va(lo(xc,yc)):syssp,1,mx-32,my-8:x1=xc:y1=yc:pokeso,3:gosub236
  22. 140 pk=2:goto168
  23. 142 ifxc=x1andyc=y1thenpokeso,1:pk=1:goto168
  24. 144 ifyc=6then148
  25. 146 if(t1>-1andt2>-1)or((t1>-1ort2>-1)and(yc+1>y1orabs(xc-x1)<>1))then228
  26. 148 ift+va(lo(xc,yc))<>9then228
  27. 150 c1=asc(cc$(lo(x1,y1))):c2=asc(cc$(lo(xc,yc)))
  28. 152 lo(x1,y1)=-1:lo(xc,yc)=-1:pokeso,1
  29. 154 syspa,x1*2+6,y1*3+4,ec$:syspa,xc*2+6,yc*3+4,ec$
  30. 156 lo=lo-2:pk=1:gosub200:goto168
  31. 158 t=abs(va(lo(xc,yc))-va(ds(ds))):ift<>1andt<>9then228
  32. 160 c1=asc(cc$(lo(xc,yc))):c2=asc(cc$(ds(ds)))
  33. 162 syspa,34,10,cc$(lo(xc,yc))th$cd$(lo(xc,yc))bh$
  34. 164 syspa,xc*2+6,yc*3+4,ec$
  35. 166 lo=lo-1:ds=ds+1:ds(ds)=lo(xc,yc):lo(xc,yc)=-1:gosub200
  36. 168 wait56320,31,15:return
  37. 170 :: deck/discard ::
  38. 172 on-(xc=-2andyc=2)-(xc=14andyc=2andgm=2)*2goto174,182:return
  39. 174 ifdk<0then228
  40. 176 syspa,34,10,cc$(dk(dk))th$cd$(dk(dk))bh$
  41. 178 syspa,4,13,""dk"[157] ":ds=ds+1:ds(ds)=dk(dk):dk=dk-1
  42. 180 pk=1:pokeso,1:goto168
  43. 182 ifds<0then228
  44. 184 ifpk=1ort+va(ds(ds))<>9then228
  45. 186 c1=asc(cc$(lo(x1,y1))):c2=asc(cc$(ds(ds)))
  46. 188 lo(x1,y1)=-1:pokeso,1:ds=ds-1:pk=1
  47. 190 syspa,x1*2+6,y1*3+4,ec$
  48. 192 ifds<0thensyspa,34,10,"[158]"th$" [146]"bh$:goto196
  49. 194 syspa,34,10,cc$(ds(ds))th$cd$(ds(ds))bh$
  50. 196 lo=lo-1:gosub200:goto168
  51. 198 :: score ::
  52. 200 gosub222:t=-(c1=c2)*25
  53. 202 sc=sc+(7-y1)*(75+t):sc=sc+(7-yc)*(75+t)*-(xc<14)-(xc=14)*225
  54. 204 syspa,34,5,""sc:iftthengosub240:forl=0to1:gosub234:gosub236:next
  55. 206 return
  56. 208 :: quit ::
  57. 210 pokeso,0:iflo=0thensc=sc+1500:gosub204:forl=0to999:next
  58. 212 gosub280:syspa,15,10,"[158]score"sc
  59. 214 ifsc>hs(gm)thenhs(gm)=sc:forl=0to5:gosub234:gosub236:next
  60. 216 syspa,12,14,"[158]high score "hs(gm)
  61. 218 gosub318:gosub244:goto102
  62. 220 :: bing ::
  63. 222 pokeat,10:pokesr,73:pokewv,17:pokehf,50:pokelf,0
  64. 224 fori=0to333:next:pokewv,16:return
  65. 226 :: buzz ::
  66. 228 pokehf,5:pokeat,0:pokesr,240:pokewv,33
  67. 230 fori=0to249:next:pokewv,32:return
  68. 232 :: beep ::
  69. 234 pokesr,240:pokehf,50:pokelf,35:goto238
  70. 236 pokesr,225:pokehf,33:pokelf,33
  71. 238 pokeat,0:pokewv,17
  72. 240 fori=0to99:next:pokewv,16:return
  73. 242 :: shuffle/deal ::
  74. 244 r=rnd(-ti):gosub280
  75. 246 syspa,11,6,"[158]shuffling the cards":gosub236
  76. 248 forl=0to99
  77. 250 r1=int(rnd(1)*49):r2=int(rnd(1)*49)
  78. 252 t=dk(r1):dk(r1)=dk(r2):dk(r2)=t
  79. 254 next
  80. 256 forl=0to6:fork=0to12:lo(k,l)=-1:next:next
  81. 258 lo=28:dk=49:poke781,6:sys59903
  82. 260 forl=0to6:print"":fork=0tol
  83. 262 syspa,18-l*2+k*4,l*3+4,cc$(dk(dk))th$cd$(dk(dk))bh$
  84. 264 lo(6-l+k*2,l)=dk(dk):dk=dk-1
  85. 266 next:next
  86. 268 syspa,2,4,""th$""bh$"[157] [146][145]uit":syspa,29,5,"[158]score 000"
  87. 270 syspa,2,10,"[158]"th$" [146]"bh$tab(34)cc$(dk(dk))th$cd$(dk(dk))bh$
  88. 272 ds=0:ds(ds)=dk(dk):dk=dk-1
  89. 274 print"deck"dk+1tab(32)"discard"
  90. 276 return
  91. 278 :: screen ::
  92. 280 poke53280,0:poke53281,0
  93. 282 t$=mid$("[193][194]+",gm,1)
  94. 284 print"[147]"tab(8)"[155][@\[@\[@\[@\[@\[@\[@\[149][@\"
  95. 286 printtab(8)"[155]=<>=,>=/>=->=:>=.>=;>[149]="t$">"
  96. 288 printtab(8)"[155]]*^]*^]*^]*^]*^]*^]*^[149]]*^"
  97. 290 return
  98. 292 :: options ::
  99. 294 gm=3:gosub280
  100. 296 syspa,3,5,"[158]pyramid1 [159][192] play cards from the field"
  101. 298 print"to the discard pile? field card must be"
  102. 300 print"one number higher or lower than discard?";
  103. 302 print"a 0 or 9 may be played on each other?"
  104. 304 syspa,3,10,"[158]pyramid9 [159][192] choose 2 field cards or a"
  105. 306 print"discard and field card that total nine?"
  106. 308 print"choosen card must have no card below it"
  107. 310 print"unless first card uncovers second card?"
  108. 312 print"    draw from deck when out of moves?"
  109. 314 print"[156]    match colors for bonus points?"
  110. 316 print"[158]    use joystick port2?"
  111. 318 syspa,5,23,"[159]pyramid1[159][192][192][192]pyramid9[159][192][192][192]q[159]uit"
  112. 320 poke198,0:wait198,1:getg$:forl=1to3:ifg$<>mid$("19q[209]",l,1)thennext:goto320
  113. 322 gm=l:ifgm<3thenreturn
  114. 324 print"[147]":poke53270,200:poke53272,23:poke1,119:poke781,0:poke782,0
  115. 326 poke88,221:poke89,28:poke90,187:poke91,28
  116. 328 end:game
  117. 330 :: init ::
  118. 332 print"[147]"
  119. 334 poke56334,0:poke1,51
  120. 336 poke781,9:poke782,1:poke88,0:poke89,64:poke90,0:poke91,216
  121. 338 sys41964:poke1,55:poke56334,1:poke53272,30
  122. 340 poke53272,(peek(53272)and240)or14
  123. 342 poke53270,peek(53270)or16
  124. 344 poke2040,13:poke2041,14:poke53287,1:poke53288,1
  125. 346 poke53276,1:poke53283,9:poke53285,10:poke53277,2:poke53271,2
  126. 348 dim cd$(49),cc$(49),va(49),dk(49),ds(49),lo(12,6),hs(2)
  127. 350 lf=54272:hf=54273:wv=54276:at=54277:sr=54278:vl=54296:pokevl,15
  128. 352 sp=49152:pa=49234:so=53269:pokeso,0
  129. 354 forl=0to49:dk(l)=l:next
  130. 356 forl=0to9
  131. 358 readt$:cd$(l)=t$:cd$(l+10)=t$:cd$(l+20)=t$:cd$(l+30)=t$:cd$(l+40)=t$
  132. 360 next
  133. 362 forl=0to40step10:readt$:fork=0to9:cc$(l+k)=t$:va(l+k)=k:next:next
  134. 364 th$="[@\[157][157][157]=":bh$=">[157][157][157]]*^[145][145]":ec$="[146]   [157][157][157]   [157][157][157]   "
  135. 366 forl=14336to14871:readk:pokel,k:next
  136. 368 forl=832to959:readk:pokel,k:next
  137. 370 forl=49152to49267:readk:pokel,k:next
  138. 372 return
  139. 374 :: cards ::
  140. 376 data +,!,_,#,$,%,&,',(,)
  141. 378 data "[150]","[154]","[153]","[152]","[151]"
  142. 380 :: characters ::
  143. 382 data 0,255,255,255,255,255,255,255,0,124,230,254,230,230,230,0
  144. 384 data 0,252,230,252,230,230,252,0,0,124,230,224,224,230,124,0
  145. 386 data 0,248,236,230,230,236,248,0,0,254,224,248,224,224,254,0
  146. 388 data 0,254,224,248,224,224,224,0,0,124,224,238,230,230,124,0
  147. 390 data 0,230,230,254,230,230,230,0,0,124,56,56,56,56,124,0
  148. 392 data 0,62,28,28,28,220,120,0,0,236,248,240,248,236,230,0
  149. 394 data 0,224,224,224,224,224,254,0,0,227,247,255,235,227,227,0
  150. 396 data 0,230,246,254,238,230,230,0,0,124,230,230,230,230,124,0
  151. 398 data 0,252,230,230,252,224,224,0,0,124,230,230,230,124,14,0
  152. 400 data 0,252,230,230,252,238,230,0,0,126,224,124,14,238,124,0
  153. 402 data 0,254,56,56,56,56,56,0,0,230,230,230,230,230,124,0
  154. 404 data 0,230,230,230,230,124,56,0,0,227,227,235,255,247,227,0
  155. 406 data 0,198,238,124,124,238,198,0,0,230,230,124,56,56,56,0
  156. 408 data 0,254,28,56,112,224,254,0,0,15,63,63,63,63,63,63
  157. 410 data 0,240,252,252,252,252,252,252,63,63,63,63,63,63,15,0
  158. 412 data 252,252,252,252,252,252,240,0,215,125,253,245,215,95,127,85
  159. 414 data 0,0,0,0,0,0,0,0,247,215,247,247,247,247,247,213
  160. 416 data 102,102,102,0,0,0,0,0,215,125,253,215,253,253,125,215
  161. 418 data 245,221,125,125,85,253,253,253,85,127,127,87,253,253,125,215
  162. 420 data 215,125,127,87,125,125,125,215,85,125,253,247,223,223,223,223
  163. 422 data 215,125,125,215,125,125,125,215,215,125,125,125,213,253,125,215
  164. 424 data 255,255,255,255,255,255,255,0,215,125,125,117,93,125,125,215
  165. 426 data 190,190,190,170,235,235,235,235,235,170,174,174,170,174,174,174
  166. 428 data 170,235,235,235,235,235,235,170,171,170,174,174,171,174,174,174
  167. 430 data 0,124,230,238,246,230,124,0,0,56,248,56,56,56,254,0
  168. 432 data 0,124,206,28,112,224,254,0,0,124,206,28,14,206,124,0
  169. 434 data 0,30,62,110,255,14,14,0,0,254,224,252,14,206,124,0
  170. 436 data 0,124,224,252,230,230,124,0,0,254,206,28,56,56,56,0
  171. 438 data 0,124,230,124,230,230,124,0,0,124,206,206,126,14,124,0
  172. 440 data 190,170,170,170,170,190,190,190,171,170,174,174,174,174,170,171
  173. 442 data 171,174,174,174,171,175,175,175,63,63,63,63,63,63,63,63
  174. 444 data 252,252,252,252,252,252,252,252,0,0,0,0,0,28,28,0
  175. 446 data 0,0,0,126,126,0,0,0,235,171,235,235,235,235,235,170
  176. 448 data 235,186,186,186,234,250,186,235
  177. 450 :: sprites ::
  178. 452 data 170,170,128,149,85,128,149,106,128,149,106,128,149,90,0,149
  179. 454 data 86,128,153,85,160,154,85,104,154,149,90,170,165,90,168,169
  180. 456 data 106,0,42,168,0,10,160,0,2,128,0,0,0,0,0,0
  181. 458 data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  182. 460 data 0,7,240,0,12,24,0,8,8,0,8,8,0,8,8,0,8,8,0,8,8
  183. 462 data 0,8,8,0,12,24,0,7,240,0,0,0,0,0,0,0,0,0,0,0,0
  184. 464 data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  185. 466 :: ml routines ::
  186. 468 data 32,253,174,32,158,183,224,8,176,67,138,10,133,250,56,169
  187. 470 data 0,42,202,16,252,133,251,32,253,174,32,138,173,32,247,183
  188. 472 data 201,1,240,14,176,39,169,255,69,251,45,16,208,141,16,208
  189. 474 data 144,8,173,16,208,5,251,141,16,208,166,250,152,157,0,208
  190. 476 data 32,253,174,32,158,183,138,166,250,157,1,208,96,162,14,76,58,164
  191. 478 data 32,253,174,32,158,183,134,2,224,40,176,239,32,253,174,32
  192. 480  data 158,183,224,25,176,229,164,2,24,32,240,255,32,253,174,76,164,170
  193.