home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar - Compleat Programmer
/
comprog1.d81
/
b.gosub
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-28
|
7KB
|
222 lines
1 rem maurice jones,box 324,laneville,texas 75667 march 1989
2 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13):dimi,j,su,t:goto400
3 rem ========raspberry========
4 :
5 s=54272:pokes+6,240:pokes+1,4:pokes+5,0:pokes+4,33:pokes+24,15
6 forz=1024to512step-8:pokes+1,z/256:pokes,zand255:next:pokes+4,0:return
7 :
8 rem==========fanfare=========
9 :
10 t=87:n$="251331421502421502"
11 s=54272:pokes+6,96:pokes+24,15
12 fori=1to18step3
13 pokes+1,val(mid$(n$,i,2)):pokes+4,33
14 forj=1tot*val(mid$(n$,i+2,1)):next
15 pokes+4,0:next:return
16 :
17 rem ======creates screen save
18 :
20 for i=828to972:reada:pokei,a:next:return
22 data169,000,133,251,133,253,141
23 data055,003,141,057,003,141,059
24 data003,162,000,160,000,177,251
25 data145,253,200,192,000,208,247
26 data230,252,230,254,232,224,004
27 data208,238,173,056,003,133,252
28 data173,058,003,133,254,238,059
29 data003,174,059,003,224,002,208
30 data214,096,169,004,133,252,169
31 data192,133,254,169,216,141,056
32 data003,169,196,141,058,003,076
33 data060,003,169,192,133,252,169
34 data004,133,254,169,196,141,056
35 data003,169,216,141,058,003,076
36 data060,003,169,004,133,252,169
37 data200,133,254,169,216,141,056
38 data003,169,204,141,058,003,076
39 data060,003,169,200,133,252,169
40 data004,133,254,169,204,141,056
41 data003,169,216,141,058,003,076
42 data060,003,000,000,000
47 :
48 rem==========again?==============
49 :
50 x=15:y=10:w$="[144] again? [157][157][157][157][157][157][157][157] (y/n) ":gosub66:goto62
54 :
55 rem==========any key-get a$=========
56 :
58 x=14:y=24:w$=" any key [145]":gosub66
59 :
60 rem============get a$===========
61 :
62 geta$:ifa$=""then 62:return
63 :
64 rem=======print at=============
65 :
66 poke783,peek(783)and254:poke782,x:poke781,y:sys65520:printw$
68 poke783,peek(783)or1:return
106 :
107 rem===dim,define,once only stuff===
109 :
111 nc=52:dims(nc),d$(14),va$(13),c(3),b(3,52):z9=0
112 fori=0to3:reads$(i):readco$(i):next
113 fori=0to12:readva$(i):next
114 fori=1to5:readch$(i):next
115 data"[216]","[144]","[218]","","[211]","","[193]","[144]", 2,3,4,5,6,7,8,9,10,j,q,k,a
116 data"1","2","3","h","q",
119 c$="[176][192][192][192][192][174][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221]"
120 c$=c$+ "[157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][173][192][192][192][192][189]"+"[145][145][145][145][145][157][157][157][157][157]"
121 b$=c$+"[166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166]"
122 bl$=" [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157]"
123 bl$=bl$+" [157][157][157][157][157][157] [157][157][157][157][157][157] "
125 rem========shuffle & deal======
126 :
127 forj=0tonc-1:s(j)=j:next
128 forj=otonc-2:j%=j+int(rnd(0)*(nc-j)):temp=s(j):s(j)=s(j%):s(j%)=temp:next
129 fori=0to47:b(1,i+1)=s(i):next:fori=1to4:b(2,i)=s(i+47):next
130 c(1)=48:c(2)=4:c(3)=0:return
137 :
138 rem ======suits,values,graphics===
139 :
140 w$=c$+co$(fns(b(i,j)))+va$(fnv(b(i,j)))+s$(fns(b(i,j)))
146 if c(i)=0thenw$=bl$
148 goto66
157 :
158 rem=======print board=======
159 :
160 y=5:x=33:w$=bl$:forj=1to9:gosub66:x=x-4:next
162 y=5:x=1:i=2: a=1:ifc(2)>9thena=c(2)-8
164 for j=atoc(2):gosub140:x=x+4:next:cp=x:return
167 :
168 rem ======top of waste=========
169 :
170 y=13:x=12:i=3:j=c(3):gosub140:return
187 :
188 rem=====restore deck========
189 :
190 fori=c(3)to1step-1:c(1)=c(1)+1:b(1,c(1))=b(3,i):next:c(3)=0
192 gosub170:fori=1to100:next:y=13:x=3:w$=b$:gosub66:return
207 :
208 rem======get choice ======
209 :
210 geta$:if a$=""then210
212 for i=1to5:ifa$=right$(ch$(i),1)then216
214 next:goto210
216 return
219 :
220 rem=====help screen=====
222 print"[147] [164][175][185][162] marathon sol [162][185][175][164]"
224 print:print:print"the object of the game is to play all "
226 print"of the cards to the waste pile. cards "
228 print"are dealt from the deck to the table, "
230 print"one at a time."
232 print:print"only the top four cards on the table"
234 print"are considered in playing to the waste"
236 print"pile. if the top card and the fourth "
238 print"card are of the same suit, the two "
240 print"cards between them can be played to "
242 print"the waste pile. if they are of the"
244 print"same value, all four may be played to"
246 print"the waste pile. "
248 print:print"you may play through the deck as many"
250 print"times as you like. one time through"
252 print"is the short game. when the deck is "
254 print"used up, the deal option will cause"
256 print"the waste pile to be turned over."
260 sys886:z9=1:return
297 :
298 rem=====erase four========
299 :
300 y=5:x=cp-12: fori=1to3:w$=bl$:gosub66:x=x+4:next:return
397 :
398 rem========start of program=======
399 :
400 z9=0:poke53280,1:poke53281,1:printchr$(8);chr$(142):print"[147][144]"
401 print" [164][175][185][162] marathon sol [162][185][175][164]"
402 print:print" by
403 [153]:[153]" maurice jones
404 print:print: print"even as we speak, the subroutine at"
405 print"line 20 is poking in fender tucker's"
407 print"screen switching routine."
409 print:print"when the 'any key' prompt appears at"
411 print"the bottom, please hit a key to proceed"
413 print"to the next screen."
415 gosub20:rem==load screen switch====
417 gosub58
419 print"[144][147]"
423 print:print"now the subroutine at 111 is breaking"
425 print"out and shuffling a new deck of cards."
427 print:print"when the game screen appears, type 'h'"
429 print "for instructions."
431 print:print"when the 'any key' prompt appears at"
433 print"the bottom, please hit a key to proceed"
435 print"to the next screen."
445 :
446 gosub 111: rem== deal============
447 :
450 gosub 58:goto460
454 print"[147] a moment, please . . .":gosub128
457 :
458 rem =====playing board=============
459 :
460 print"[147] [164][175][185][162] marathon sol [162][185][175][164]"
470 y=13:x=3:w$=b$:gosub66:x=12:w$=b$:gosub66:y=21:x=4:w$="[144]deck":gosub66
474 x=13:w$="waste":gosub66
480 y=15:x=25:w$="1-play two":gosub66:y=16:w$="2-play four":gosub66
484 y=17:w$="3-deal card":gosub66:y=20:w$="h-help":gosub66:y=21:w$="q-quit"
488 gosub66
492 y=5:x=1:i=2: forj=1to4:gosub140:x=x+4:next:cp=x
496 gosub 170
500 x=14:y=24:w$=" choice? [145]":gosub66:gosub210:onigoto520,560,600,990,995
517 :
518 rem=====play two=========
519 :
520 ifc(2)<4then522
521 iffns(b(2,c(2)-3))=fns(b(2,c(2)))then 524
522 gosub5:goto500
524 c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-2)
526 c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-1):b(2,c(2)-2)=b(2,c(2)):c(2)=c(2)-2
530 gosub300:x=x-12:i=2:j=c(2):gosub140:cp=x+4: gosub170:ifcp<16thengosub160
534 goto500
557 :
558 rem =======play four=======
559 :
560 ifc(2)<4then522
566 iffnv(b(2,c(2)))=fnv(b(2,c(2)-3))then572
568 gosub5:goto500
572 fori=0to3:c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-3+i):next:c(2)=c(2)-4
574 gosub160:gosub170:goto500
597 :
598 rem=========deal card=========
599 :
600 x=14:y=24:w$=" [145]":gosub66
601 ifc(1)=1then610
602 ifc(1)>0then608
604 ifc(3)=0then700
606 gosub190
608 c(2)=c(2)+1:b(2,c(2))=b(1,c(1)):c(1)=c(1)-1:gosub160:goto500
610 y=13:x=3:w$=bl$:gosub66:goto608
700 x=12:y=6:w$=" sorry, you [157][157][157][157][157][157][157][157][157][157][157][157][157][157] have lost [146]":gosub66
702 gosub50:goto995
797 :
798 rem========win screen============
799 :
800 w$=bl$:x=34:y=7:gosub66:gosub10:gosub127:w$=" you win!!! "
802 x=3:y=1:fori=1to22:gosub66:x=x+1:y=y+1:next:goto995
987 :
988 rem========display help screen====
989 :
990 sys928:if z9=0thengosub222
991 sys907:gosub58:sys949:goto500
992 :
993 rem=====play again?=======
994 :
995 gosub50:ifa$="n"then60000
997 if a$="y"then454
999 gosub 62:goto995
60000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
60010 if er<>63 then print"[147]":end
60020 a$="hello