home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 92
/
092.d81
/
klondike
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
8KB
|
247 lines
1 rem copyright 1991 by maurice jones
4 dimi,x,y,t2,fr,a$,bk$,bl$,ca,ch$,do,f,fc,fs,fv,j,jj,j%,k,k1,m,re,s$,s1,s2,s3
5 dimt,tc,te,ts,tv,v,va,z7,z9,s4,su,va$,vb$:ns=13:nc=52
6 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13)
8 jj=-1:dims(nc),x(12),y(12):fori=0tonc-1:s(i)=i:next:printchr$(142)
9 poke53272,31:poke198,0
10 goto500
19 rem choice
20 gosub62
21 fori=1tolen(ch$):ifa$=mid$(ch$,i,1)thenreturn
22 next: goto20
25 rem charge
26 a$="251331421502421502"
27 t=87:pokef+6,96:pokef+24,15
28 fori=1to18step3
29 pokef+1,val(mid$(a$,i,2)):pokef+4,33
30 forj=1tot*val(mid$(a$,i+2,1)):next
31 pokef+4,0:next:return
34 rem pick up
35 iffr=1then52
36 x=x(fr):y=24:gosub66:fori=1to17:print" [145][157][157][157][157]";:next
38 iffr=2orc(fr+10)=0then42
40 x=x(fr):y=y(fr):gosub66:print"[145]";bk$
42 return
44 rem turn down card
45 do=10+fr:ifc(do)=0orfr=2orfr=1then52
47 ifc(do)<>1 then49
48 x=x(fr):y=y(fr):gosub66:print"[145] ";
49 b(fr,1)=b(do,c(do)):c(fr)=1:c(do)=c(do)-1:i=fr:gosub200
52 return
58 x=10:y=24:gosub66:print"[151] please press a key [145][145][145]"
62 geta$:ifa$=""then70:return
66 poke211,x:poke214,y:sys58732:return
69 rem multitask
70 ifjj=nc-2thenjj=-1
71 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto62
79 rem play to tab
80 x=x(t2):y=24:gosub66:fori=1to17:print" [145][157][157][157][157]";:next
81 k=1: if c(t2)>7then90
82 k1=c(t2):i=t2:c(t2)=1:gosub200
84 ifk=k1then98
86 k=k+1:i=(t2):c(t2)=k:print"";:gosub202
88 goto84
90 gosub35
91 k1=c(t2):i=t2:c(t2)=1:gosub200:k=k1-6
92 ifk=k1thenreturn
94 k=k+1:c(t2)=k:print"";:gosub202
96 goto92
98 return
110 rem start up
111 dimva$(13),c(18),b(18,24),vb$(13),d(24):f=54272:fori=ftof+78:pokei,0:next
112 cr$="[216][203][202][201][200][199][198][197][196]&[195][194][217]":cs$="[204][215][214][213][212][211][210][209][208]'[207][206][205]"
115 s$(0)="[162]":s$(1)="[173]":s$(2)="[192]":s$(3)="[193]":co$(0)="[144]":co$(1)="":co$(2)=""
116 co$(3)="[144]":s1$(0)="[161]":s1$(1)="[218]":s1$(2)="[223]":s1$(3)="[176]"
119 fori=0to12:va$(i)=mid$(cr$,i+1,1):vb$(i)=mid$(cs$,i+1,1):next
120 ch$="12345678 fqschnb"
121 x=5:fori=2to8:x(i)=x:y(i)=8:x=x+5:next:x=16:fori=9to12:x(i)=x:y(i)=0:x=x+6
122 next:x(0)=0:y(0)=12:x(1)=0:y(1)=19
124 bk$="!##$[157][157][157][157]@[170][171]%[157][157][157][157]@[170][171]%[157][157][157][157]@[170][171]%[157][157][157][157]\++*[157][157][157][157][145][145][145][145][145]"
125 bl$=" [157][157][157][157] [157][157][157][157] [157][157][157][157] [157][157][157][157] [157][157][157][157][145][145][145][145][145]"
129 return
130 rem shuffle
131 ifjj=nc-2thenreturn
132 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp
133 ifjj<>nc-2then131
134 return
179 rem reprint from pile
180 k=1: if c(fr)>7then190
182 k1=c(fr):i=fr:c(fr)=1:gosub200
184 ifk=k1then198
186 k=k+1:i=(fr):c(fr)=k:print"";:gosub202
188 goto184
190 gosub35
191 k1=c(fr):i=fr:c(fr)=1:gosub200:k=k1-6
192 ifk=k1thenreturn
194 k=k+1:c(fr)=k:print"";:gosub202
196 goto192
198 return
199 rem print card or erase
200 x=x(i):y=y(i):gosub66
202 ca=b(i,c(i)):su=fns(ca):va=fnv(ca)
204 pokef+24,6:pokef+5,128:pokef+4,129:fort=1to50:next:pokef+4,128:pokef+5,0
206 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128
208 ifc(i)<>0then220
214 rem erase card
216 printbl$;:return
220 printco$(su);va$(va);"[179][179][177][157][157][157][157]";s$(su);"[166][167][174][157][157][157][157][163][170][171][174][157][157][157][157][163][168][169]";s1$(su);
222 print"[157][157][157][157][180][178][178]";vb$(va);"[145][145][145][145][145][157][157][157][157]";:return
249 rem print back
250 x=x(i):y=y(i):gosub66
251 ifz8=1then258
252 pokef+24,6:pokef+5,128:pokef+4,129:fort=1to50:next:pokef+4,128:pokef+5,0
254 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128:ifz9=1then return
258 printbk$:return
500 bg=1:poke53280,bg:poke53281,bg:print"[147]"
501 fori=0to4:print"[144] ":next
502 print"[145][145][145][145][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
503 print"[221] k l o n d i k e 1 9 9 2 [255]"
504 print"[173][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][189]"
505 print"[151] a maurice jones solitaire":gosub111:gosub131:gosub26
506 print"[147]":fori=1to18:c(i)=0:next:re=1
507 print"[144]klondike 1992":print:print" h-help f f f f"
508 print" deal 1[157]2 3 4 5 6 7 8"
510 print" 1"
514 k=0:fori=2to8:b(i,1)=s(k):k=k+1:c(i)=1: next:fori=2to8:gosub200
516 form=i+1to8:y=7:x=x(m):gosub66:gosub252:next:z9=1:next
517 fori=3to8:forj=1toi-2:c(i+10)=j:b(i+10,j)=s(k):k=k+1:next:next
518 fori=1to24:d(i)=s(k):k=k+1:next:c(0)=24
520 i=0:z9=0:gosub250:x=0:y=10:gosub66
522 x=0:y=10:gosub66:print"[156]from[157][157][157][157]";:gosub20
529 onigoto660,700,700,700,700,700,700,700,600,522,900,1100,1200,1300,870,1400
537 rem to pile
538 x=0:y=10:gosub66:print"[156] to [157][157][157][157]";:gosub20
545 onigoto522,710,710,710,710,710,710,710,600,780,900,1100,1200,1300,870
599 rem turn card
600 ifc(0)=0andc(1)=0then522
601 ifc(0)=0then640
602 c(1)=c(1)+1:b(1,c(1))=d(c(0)):c(0)=c(0)-1:i=1:ifc(0)=0then 610
604 i=1:gosub200:goto522
610 i=0:gosub200:goto604
640 re=re+1:x=5:y=4:gosub66:print"[156]";re
650 x=c(1):fori=1tox:d(x)=b(1,i):x=x-1:next:c(0)=c(1):c(1)=0:i=1:gosub200
652 z8=1:i=0:gosub250:z8=0:goto522
660 ifc(i)=0then522
662 iffnv(b(i,c(i)))<>0then700
664 fc=b(1,c(1)):c(1)=c(1)-1:gosub200:i=12-fns(fc):c(i)=1:b(i,1)=fc:gosub200
668 goto522
699 rem from pile
700 ifc(i)=0then522
702 fr=i:iffnv(b(i,c(i)))<>0then708
704 fc=b(i,c(i)):gosub35:i=12-fns(fc):c(i)=1:c(fr)=c(fr)-1:b(i,1)=fc:gosub200
706 gosub45:goto522
708 fr=i:fc=b(i,1):fs=fns(fc):fv=fnv(fc):goto538
709 rem play to tab
710 t2=i:tc=b(i,c(i)):ts=fns(tc):tv=fnv(tc):iffr<>1then740
712 fc=b(fr,c(fr)):fv=fnv(fc):fs=fns(fc):ifc(t2)<>0then722
716 iffv<>12then522
718 c(1)=c(1)-1:i=1:gosub200:c(t2)=1:b(t2,1)=fc:i=t2:gosub200:goto522
722 ifco$(fs)=co$(ts)orfv+1<>tvthen522
724 c(1)=c(1)-1:i=1:gosub200:c(t2)=c(t2)+1:b(t2,c(t2))=fc:gosub80:goto522
739 rem tab to tab
740 ifc(t2)<>0then754
744 iffv<>12then522
746 ifc(t2)>7then756
748 gosub35:fori=1toc(fr):c(t2)=c(t2)+1:b(t2,c(t2))=b(fr,i):next:c(fr)=0
750 gosub80:gosub45:goto522
751 ifc(t2)>7thengosub35:gosub90:gosub45:goto522
752 gosub80:gosub45:goto522
754 ifco$(fs)=co$(ts)orfv+1<>tvthen522
756 gosub35:goto748
779 rem play to f
780 fc=b(fr,c(fr)):fv=fnv(fc):fs=fns(fc):ifc(12-fs)=0then522
781 iffnv(b(12-fs,c(12-fs)))+1<>fvthen522
782 iffr=1then840
790 gosub35:i=12-fs:c(i)=c(i)+1:b(i,c(i))=fc:gosub200:c(fr)=c(fr)-1
800 ifc(fr)>0then830
810 gosub45
820 ifc(fr)=0then850
830 gosub180:goto850
840 c(1)=c(1)-1:i=1:gosub200:i=12-fs:c(i)=c(i)+1:b(i,c(i))=fc:gosub200
850 k=0:fori=9to12:k=k+c(i):next:ifk<>52then522
860 gosub58:goto900
870 sys886:fori=3to8:x=x(i):y=y(i):gosub66
874 ifc(i+10)=0then880
876 print"[145][145]";c(i+10)
880 next:gosub58:sys907:goto522
899 rem quit
900 sys886:print"[147][159]":poke53280,0:poke53281,0 :ifz7=1then903
902 x=10:y=5:s1=0:gosub66:fori=9to12:s1=s1+5*c(i):next:s1=s1-50
903 s2=s2+1:s3=s3+s1
904 s4=int(s3/s2+.5):z7=0
905 print"[147]": poke53280,0:poke53281,0:ifs1<>210then910
906 printtab(6) "[158][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
907 print tab(6)"[221] perfect game [221]"
908 print tab(6)"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]"
910 printtab(08)"[156]klondike scoreboard ":print
912 printtab(08)"[159] game score "s1" ":print
914 printtab(08)" session score "s3" ":print
916 printtab(08)" average score "s4" "
1002 x=18:y=16:gosub66:print"[158][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
1006 x=18:y=17:gosub66:print"[158][221] 1.new game [221]"
1008 x=18:y=18:gosub66:print"[158][221] 2.inspect tableau [221]"
1010 x=18:y=19:gosub66:print"[158][221] 3.to loadstar [221]"
1012 x=18:y