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