home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 94
/
094.d81
/
tens
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
5KB
|
163 lines
1 rem save"tens v3.0",8
9 printchr$(142):poke53272,31:poke198,0:mt=52480
10 goto500
19 rem choice*
20 gosub62
21 fori=1tocc: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
57 rem any key-get a$*
58 x=10:y=24:gosub66:print" please press a key [145][145][145]"
62 geta$:ifa$=""then70:return
64 rem print at*
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 illusion on deck
80 x=x(dk):y=y(dk):gosub66:printb1$;:fork=1to80:next:printbk$
82 c(i)=0:gosub200:c(i)=1:x=x(ws):y=y(ws):gosub66:gosub202:c(i)=0:return
110 rem start up
111 dimva$(13),vb$(13):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]"
113 s$(0)="[162]":s$(1)="[173]":s$(2)="[192]":s$(3)="[193]":co$(0)="[144]":co$(1)="":co$(2)=""
114 co$(3)="[144]":s1$(0)="[161]":s1$(1)="[218]":s1$(2)="[223]":s1$(3)="[176]"
115 fori=0to12:va$(i)=mid$(cr$,i+1,1):vb$(i)=mid$(cs$,i+1,1):next
116 bk$="[129]!##$[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]\++*[157][157][157][157][145][145][145][145]"
117 bl$="[155]@@@@[157][157][157][157]@@@@[157][157][157][157]@@@@[157][157][157][157]@@@@[157][157][157][157]@@@@[157][157][157][157][145][145][145][145]"
118 bg$="[155] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
119 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13)
120 nc=52:ns=13: jj=-1:dims(nc):fori=0tonc-1:s(i)=i:next
121 b1$="[150]!##$[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]\++*[157][157][157][157][145][145][145][145]"
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
135 dimx(15),y(15),c(15),b(13,1),dk(52),ws(52):return
140 ch$="0123456789 qh":cc=13:dk=10:ws=11:np=9
142 x=9: fori=0to4:y(i)=4:y(i+5)=11:x(i)=x+5:x(i+5)=x+5:x=x+5:next
144 x(10)=5:y(10)=18:x(11)=12:y(11)=18
148 return
149 rem end game
150 x=6:y=12:gosub66:print" [192][192][192][192][192][192][192] "
152 y=y+1:gosub66:print" you "
154 y=y+1:gosub66:print" win! "
156 y=y+1:gosub66:print" [192][192][192][192][192][192][192] "
158 wn=0:goto170
160 x=02:y=12:gosub66:print" "
162 y=y+1:gosub66:print" "
164 y=y+1:gosub66:print" "
166 x=x+1:y=y-1:gosub66:print""c(dk)"cards left"
170 x=2:y=17:gosub66: print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192] "
172 y=y+1:gosub66:print" 1. new game "
174 y=y+1:gosub66: print" 2. to loadstar "
176 y=y+1:gosub66:print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192] "
177 sysmt+3,1,39,24,24,160,6
178 gosub62:ifa$<"1"ora$>"2"then178
182 onval(a$)goto612,6000
190 ch$="0123456789abc qh":cc=16:dk=14:ws=15:np=12
192 x=-2:fori=0to6:y(i)=4:y(i+5)=10:x(i)=x+5:x=x+5:next
194 x(14)=09:y(14)=18:x(15)=27:y(15)=18
196 x=-2:fori=7to12:y(i)=11:x(i)=x+5:x=x+5: next
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=1to20: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][157][157][157][157]";:return
299 rem deal
300 fori=0tonp:ifc(i)>0then308
304 x=x(dk):y=y(dk):gosub66:printb1$;:printbk$:c(i)=1:b(i,1)=dk(c(dk))
306 c(dk)=c(dk)-1:gosub200:ifc(dk)=0then310
308 next
309 return
310 x=x(dk):y=y(dk):gosub66:printbl$:wn=1:return
319 rem play faces in tens
320 kk=i:tc=fnv(b(i,1)):k=0:forj=0to12:iffnv(b(j,1))<>tcthen328
324 k=k+1
328 next
332 ifk=4then 338
336 return
338 c(kk)=0:i=kk:gosub200:c(kk)=1:x=x(ws):y=y(ws):gosub66:i=kk:gosub202:c(kk)=0
340 forj=0to12:iffnv(b(j,1))<>tcthen348
344 c(j)=0:i=j: gosub200:c(j)=1:x=x(ws):y=y(ws):gosub66:i=j:gosub202:c(j)=0
348 next
350 return
500 poke53280,08:poke53281,01:sysmt+3,0,39,0,24,126,08
501 sysmt+3,8,32,10,15,255,0
502 sysmt+3,7,31,9,14,160,06
503 sysmt+18,10,"[212][160][207][160][213][160][199][160][200][160][160][212][160][197][160][206][160][211]":sysmt+18,12,"a maurice jones "
504 sysmt+18,13,"solitaire "
510 gosub111:gosub26:gosub190
612 fori=1to52:dk(i)=s(i-1):next:c(dk)=52:fori=0to12:c(i)=0:next:c(ws)=0
614 poke53280,08:poke53281,1:print"[147]";
616 sysmt+3,0,39,0,24,000,15:sysmt+3,0,39,0,2,160,6:sysmt+3,0,39,24,24,160,6
618 sysmt+18,24," h - help q - quit"
619 x=0:y=24:gosub66:print"[146][144]/";
620 x=10:y=1:gosub66:print"[212][160][207][160][213][160][199][160][200] [160] [212][160][197][160][206][160][211] "
625 x=x(dk):y=y(dk):gosub66:printbk$:fori=0to12:x=x(i):y=y(i):gosub66:
629 print"[156]";mid$(str$(i),2,1):next
630 b9$="abc":fori=10to12:x=x(i):y=y(i):gosub66:
631 print"[156]";mid$(b9$,i-9 ,1):next
632 gosub300
634 x=16:y=19:gosub66:print" [192][192][192][192][192][192] ":y=y+1:gosub66:print" from "
635 y=y+1:gosub66:print" [192][192][192][192][192][192] [146]"
638 gosub20:i=i-1: ifi<13then646
642 oni-12goto678,160,900
646 ifc(i)=0then638
650 iffnv(b(i,c(i)))<09then658
654 gosub320:goto634
658 x=17:y=20:gosub66:print" "
660 fc=i:x=17:y=20:gosub66:print" and "
662 gosub20:i=i-1:ifi<13then668
666 oni-12goto634,160,900
668 ifc(i)=0then634
669 rem ifi=fcthen634
670 iffnv(b(fc,c(fc)))+fnv(b(i,c(i)))<>08thengosub2000:goto634
674 sc=i:i=fc:gosub82:forj=1to100:next: i=sc:gosub82: goto634
678 gosub300:ifwn<>1then634
682 fori=1to100:next:goto150
800 rem help
802 return
900 poke53280,1:sysmt+6,208:print"[147]":print" tough tens "
910 print"/": print" discard pairs of cards which total"
929 print"ten. discard kings, queens, jacks, and
930 [153]"tens only in sets of four of the same
940 print"value. empty spaces are filled from
950 [153]"the deck. the game is won if all the
960 print"cards of the deck can be played to the
970 [153]"board.":[153]" at the "[199](34)"from"[199](34)" prompt enter the char-
980 print"acter [0-c] of the pile containing a
990 [153]"card you want to play. if the card is
1000 print"a ten, jack, queen, or king all four
1010 [153]"such cards will be discarded with no
1020 print"further action on your part. otherwise
1030 [153]"you will be prompted with "[199](34)"and"[199](34)" for the
1040 print"second card in the pair. the space bar
1050 [153]"deals to the empty spaces.
1080 print" at any prompt q ends the game and h
1090 [153]"gives this screen.
1100 gosub58:sysmt+9,208:poke53280,8:goto634
2000 pokef+8,4
2010 pokef+12,63:pokef+13,17:pokef+11,33:fort=1to100:next:pokef+11,32
2020 return
5999 rem reconnect*
6000 pokev+21,0:poke56,160:clr
6020 open15,8,15,"r0:hello connect=hello connect":input#15,er%:close15
6025 ifer%<>63thenend
6030 poke646,peek(53281):print"[147]load"chr$(34)"hello connect"chr$(34)",8"
6035 print"run"
6040 poke631,13:poke632,13:poke198,2:end
10000 open15,8,15,"s0:tens":close15:save"tens",8:end