home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 193 / 193.d81 / favor (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  20KB  |  651 lines
  1. 1 poke55,0:poke56,159:clr
  2. 2 nm$="favor":nn$="amcgs.a":    dv=peek(186):ifdv<8thendv=8
  3. 3 print"[159][147]":poke53280,0:poke53281,0:poke788,49:tq=ti:poke53371,0:mt=49152
  4. 4 sys57812"amcgs.a font",dv,0:poke780,0:poke781,0:poke782,8:sys65493
  5. 12 open2,dv,2,nm$+".opts,p,r":input#2,k3,sd,so,cc,sk
  6. 14 input#2,bd,fb,mu,wg,pk,rd,kc,kc%(0):close2
  7. 17 gosub5500:poke53265,27:onmu+1goto500,482
  8. 18 :
  9. 19 rem brancher
  10. 20 onsd+1goto70,80
  11. 24 :
  12. 25 rem charge
  13. 26 a$="251331421502421502":poke53370,0
  14. 27 t=87:pokef+6,96:pokef+24,15
  15. 28 fori=1to18step3
  16. 29 pokef+1,val(mid$(a$,i,2)):pokef+4,33
  17. 30 forj=1tot*val(mid$(a$,i+2,1)):next
  18. 31 pokef+4,0:next:fori=ftof+24
  19. 32 pokei,0:next:poke53371,0:return
  20. 34 rem menu brancher
  21. 35 sysmt:poke53269,1
  22. 37 sysmt+9:ifl2%then57
  23. 41 i=1:geta$:ifa$=""then37
  24. 45 ifi>len(ch$)then37
  25. 49 ifa$=mid$(ch$,i,1)then59
  26. 53 i=i+1:goto45
  27. 57 ifcx%<x1+2orcx%>x2-2orcy%<y1+3orcy%>y2-1then37
  28. 58 i=(cy%-(y1)-1)/2
  29. 59 return
  30. 63 :
  31. 64 rem print at
  32. 65 x=x(i):y=y(i)
  33. 66 poke211,x:poke214,y:sys58732:return
  34. 68 :
  35. 69 rem keybord brancher
  36. 70 i=1:geta$:ifa$=""then76
  37. 71 ifi>len(ch$)then70
  38. 72 ifa$=mid$(ch$,i,1)thenreturn
  39. 73 i=i+1:goto71
  40. 76 ifjj=nc-2thenjj=-1
  41. 77 jj=jj+1:j%=jj+int(rnd(1)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto70
  42. 78 :
  43. 79 rem mouse brancher
  44. 80 sysmt+9:ifrg%andl2%=1orr2%=1            theni=rg%:return
  45. 81 ifjj=nc-2thenjj=-1
  46. 82 jj=jj+1:j%=jj+int(rnd(1)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto 80
  47. 88 :
  48. 89 rem wrong choice sound
  49. 90 poke53370,0:pokef+24,15:pokef+8,4:pokef+12,63:pokef+13,17:pokef+11,33
  50. 91 fori=1to100:next:pokef+11,32
  51. 92 y=sd:x=20-(len(wm$(wm)))/2:gosub66:printwm$(wm);:fori=1to300:next
  52. 93 poke53371,0:return
  53. 94 :
  54. 95 rem tone & message
  55. 96 poke53370,0:pokef+24,15:pokef+5,4:pokef+6,12
  56. 97 pokef+4,23:pokef+15,100:pokef+4,20:pokef+1,30:fork=1to350:next:pokef+6,0
  57. 98 pokef+4,129:goto92
  58. 109 :
  59. 110 rem special turn from deck  not a sub
  60. 111 tc=b%(t2,c(t2)):ts=fns(tc):tv=fnv(tc)
  61. 115 gosub270:onplgoto119,640
  62. 119 ift2>sf+3orgf=sf+3thenwm=3:gosub90:goto534
  63. 120 t2=t2+4:goto620
  64. 121 :
  65. 122 rem auto
  66. 123 tc=b%(t2,c(t2)):ts=fns(tc):tv=fnv(tc)
  67. 127 gosub270:onplgoto141,131
  68. 131 fork=c(fr)-1to1step-1
  69. 133 iffns(b%(fr,k))<>fsthen139
  70. 135 iffnv(b%(fr,k))<>fnv(b%(fr,k+1))+1then139
  71. 137 nextk
  72. 139 mm=k+1:goto1240
  73. 141 ift2>sf+3orgf=sf+3thenwm=3:gosub90:goto534
  74. 143 t2=t2+4:goto123
  75. 149 :
  76. 150 rem fill empty spaces
  77. 151 iffr=1or(c(0)=0andc(1)=0)then534
  78. 152 ifc(fr)>0then534
  79. 154 ifc(1)>0then160
  80. 156 c(fr)=c(fr)+1:b%(fr,c(fr))=b%(0,c(0)):c(0)=c(0)-1:i=0:gosub250:gosub230
  81. 157 ifc(0)=0thensysmt+30,x(0),x(0)+3,y(0),y(0)+4,kt,sk
  82. 158 i=fr:gosub200:goto534
  83. 160 c(fr)=c(fr)+1:b%(fr,c(fr))=b%(1,c(1)):c(1)=c(1)-1:i=1:gosub200
  84. 162 goto158
  85. 168 :
  86. 169 rem erases pile i
  87. 170 ifks(i)=2then174
  88. 172 mx=y(i)+sp(i)*(mx(i)-1)+4:sysmt+30,x(i),x(i)+3,y(i),mx,kt,sk:goto177
  89. 174 mx=x(i)+sp(i)*(mx(i)-1)+3:sysmt+30,x(i),mx,y(i),y(i)+4,kt,sk
  90. 177 return
  91. 178 :
  92. 179 rem magic :202 other place  203:any card
  93. 180 onks(i)goto181,190
  94. 181 x=x(i):y=y(i)+sp(i)*(c(i)-1)
  95. 182 ify>y(i)+sp(i)*(mx(i)-1)theny=y(i)+sp(i)*(mx(i)-1)
  96. 184 gosub66:goto202
  97. 190 y=y(i):x=x(i)+sp(i)*(c(i)-1)
  98. 192 ifx>x(i)+sp(i)*(mx(i)-1)thenx=x(i)+sp(i)*(mx(i)-1)
  99. 194 gosub66:goto202
  100. 200 x=x(i):y=y(i):gosub66:ifc(i)=0thengosub170
  101. 202 ca=b%(i,c(i)):ifc(i)=0then224
  102. 203 poke53370,0:ifso=1then220
  103. 214 pokef+1,50:pokef+24,12:pokef+4,129:fort=1to15:next:pokef+4,128:pokef+5,0
  104. 220 print"[146]";:printst$(ca);:poke53371,0:return
  105. 224 sysmt+30,x,x+3,y,y+4,kt,sk:return
  106. 228 :
  107. 229 rem print count at i
  108. 230 k=len(str$(c(i))):sysmt+30,x(i)-2,x(i)-1,y(i)+3,y(i)+3,kt,sk
  109. 234 ifc(i)=0then246
  110. 236 x=x(i)-k+1:y=y(i)+3
  111. 238 gosub66:print"[156]"right$(str$(c(i)),k-1):return
  112. 244 gosub66:print"[156]"right$(str$(c(i)-1),k-1):return
  113. 246 ifi=0thensysmt+30,x(0),x(0)+3,y(0),y(0)+4,kt,sk
  114. 247 return
  115. 248 :
  116. 249 rem prints deck at i
  117. 250 print"[146]":gosub65
  118. 252 poke53370,0:ifso=1then256
  119. 254 pokef+1,50:pokef+24,12:pokef+4,129:fort=1to15:next:pokef+4,128:pokef+5,0
  120. 256 poke646,cc:printbk$:sysmt+30,x+1,x+2,y+1,y+3,kc%(kc),cc:poke53371,0:return
  121. 258 :
  122. 259 rem redeal
  123. 260 kd=fl(2):ifrd=0thenkd=fl(3)
  124. 261 ifre= kdthenwm=9:gosub90:return
  125. 262 x=c(1):fori=1tox:b%(0,x)=b%(1,i):x=x-1:next:c(0)=c(1):c(1)=0
  126. 263 i=1:gosub65:sysmt+30,x,x+ht+2,y,y+4,kt,sk:i=0:gosub250:gosub230
  127. 264 ifht=3thenreturn
  128. 265 re=re+1
  129. 266 return
  130. 268 :
  131. 269 will it play
  132. 270 pl=1
  133. 272 if(t2>gt)and(tc+1=fc)thenpl=2:return
  134. 274 ift2>1andt2<sfandtc-1=fcthenpl=2:return
  135. 286 return
  136. 288 :
  137. 289 rem play from klon type waste
  138. 290 c(t2)=c(t2)+1:b%(t2,c(t2))=b%(fr,c(fr)):c(fr)=c(fr)-1:
  139. 291 y=y(1):x=x(1)+nt-1 :gosub66
  140. 292 sysmt+30,x,x+3,y,y+4,kt,sk
  141. 294 nt=nt-1:ifnt<1thennt=1
  142. 296 i=1:y=y(1):x=x(1)+nt-1:gosub66:gosub202
  143. 297 i=t2:gosub180:return
  144. 298 :
  145. 299 rem print stats
  146. 300 x1=2:x2=15:y1=8:y2=19:cl=cc:gosub2100
  147. 302 x=x1+2:y=y1+2
  148. 306 gosub66:print"[149]played";
  149. 307 x=x1+12-len(str$(t6)):gosub66:print"[144]"t6
  150. 308 x=x1+2:y=y+2:gosub66:print"high ";
  151. 309 x=x1+12-len(str$(hi)):gosub66:print"[144]"hi
  152. 310 x=x1+2:y=y+1:gosub66:print"low  ";
  153. 311 x=x1+12-len(str$(lo)):gosub66:print"[144]"lo
  154. 312 x=x1+2:y=y+1:gosub66:print"ave. ";
  155. 313 x=x1+12-len(str$(ave)):gosub66:print"[144]"ave
  156. 316 x=x1+2:y=y+2:gosub66:print"[156]games";
  157. 317 x=x1+12-len(str$(g7)):gosub66:print"[144]"g7
  158. 320 x=x1+2:y=y+1:gosub66:print"[156]wins ";
  159. 321 x=x1+12-len(str$(nw)):gosub66:print"[144]"nw
  160. 326 return
  161. 328 :
  162. 329 rem clear message
  163. 330 ifsd=1then342
  164. 332 print"[146]"
  165. 334 sysmt+30,0,29,0,0,100,bd
  166. 338 x=30:y=0:gosub66 :print"[146][144][163]h-help[146][174]":return
  167. 342 sysmt+30,0,39,1,1,kt,sk:return
  168. 366 :
  169. 367 rem declare win
  170. 368 ifso=0thengosub26
  171. 370 nw=nw+1:wf=1
  172. 372 x1=21:x2=34:y1=2:y2=06:cl=2:gosub2300
  173. 374 y=y1+2:x=x1+3:gosub66:print"youwin ":return
  174. 388 :
  175. 389 rem update stats
  176. 390 g7=g7+1:t6=0:ifwf=1thent6=52:goto392:rem t6=nc in most
  177. 391 fori=sftonp:t6=t6+c(i):next
  178. 392 g8=g8+t6:av=int(g8/g7+.5):ift6<lothenlo=t6
  179. 394 ift6>hithenhi=t6
  180. 395 ifg7=1thenhi=t6:lo=t6
  181. 396 wf=0:return
  182. 408 :
  183. 409 rem alternate heading
  184. 410 ifsd=1then418
  185. 412 ms=0:sysmt+30,0,39,0,0,100,bd
  186. 413 poke53269,0
  187. 414 fori=1togt+1:gosub65:print"[144][145]"mid$(sc$,i,1):next:return
  188. 418 ifsd=1thenms=1:sysmt+30,0,39,07,24,kt,sk:x=0:y=0:gosub66:printcm$
  189. 420 return
  190. 438 :
  191. 439 rem spread graphics
  192. 440 print"[146]":ifk>36then442
  193. 441 x=1:y=4:forj=1tok:gosub66:c(i)=j:gosub202:x=x+1:next:goto447
  194. 442 x=1:y=4:forj=1to36:gosub66:c(i)=j:gosub202:x=x+1:next:ifk>72then445
  195. 444 x=1:y=10:forj=37tok:gosub66:c(i)=j:gosub202:x=x+1:next:goto447
  196. 445 x=1:y=10:forj=37to72:gosub66:c(i)=j:gosub202:x=x+1:next
  197. 446 x=1:y=16:forj=73tok :gosub66:c(i)=j:gosub202:x=x+1:next
  198. 447 return
  199. 480 :
  200. 481 rem menu opening
  201. 482 gosub5000
  202. 484 onigoto500,486,488,39000
  203. 486 gosub5400:goto482
  204. 488 ifrd%(1)=0andrd%(2)=0thenwm=0:gosub330: gosub90:gosub5000:goto484
  205. 490 goto502
  206. 498 :
  207. 499 new game
  208. 500 fori=1tonc:rd%(i) =s(i-1):next:c(0)=nc:re=0 :kd=fl(2):ifrd=0thenkd=fl(3)
  209. 502 sysmt+42,216:fori=1tonp:c(i)=0:k(i)=0:next
  210. 503 sysmt:gosub410
  211. 504 fori=1tonc:b%(0,i)=rd%(i):next:c(0)=nc
  212. 508 fori=14to17:c(i)=1:b%(i,1)=13*(i-14):gosub200:next
  213. 512 fori=2to13:c(i)=c(i)+1:b%(i,c(i))=b%(0,c(0)):c(0)=c(0)-1:gosub200:next
  214. 520 i=0:gosub250:gosub230
  215. 530 sysmt:ifsd=1then   poke53269,1
  216. 532 fork=0tonp:mm(k)=c(k):next:sysmt+39,144:t6=0
  217. 534 gosub330:print"[146]";:wm=4
  218. 535 y=sd:x=20-(len(wm$(wm)))/2:gosub66:printwm$(wm);
  219. 537 ch$=fr$:pokev+1,np+7:    gosub20
  220. 538 gosub330:ifi>6then544
  221. 540 onigoto 542,3000,850,4000,4004,1620
  222. 542 nw=nw+1:wf=1:ifso=0thengosub26
  223. 543 x1=21:x2=34:y1=2:y2=6:cl=2:gosub2300:y=4:x=24:gosub66:print"youwin ":goto4000
  224. 544 i=i-6  :iffl(1)<>3theni=i-1
  225. 545 fork=0togf:mm(k)=c(k):oo(k)=b%(k,1): next:sysmt+39,144
  226. 546 fr=i:sr=re:iffr=0thenonfl(1)goto552,577,  1
  227. 547 ifc(fr)=0thenwm=1:gosub90:goto534
  228. 548 iffr>gtthen534
  229. 549 goto600
  230. 550 :
  231. 551 rem turn three
  232. 552 ifc(0)=0andc(1)=0thenwm=1:gosub90:goto534
  233. 554 ifc(0)=0thengosub260:goto534
  234. 556 ht=fl(4):ifrd=0thenht=fl(5)
  235. 557 ut=nt:ifut<2then560
  236. 558 sysmt+30,x(1),x(1)+ht+2,y(1),y(1)+4,kt,sk:i=1:gosub200:form=1to350:next
  237. 560 nt=ht:ifnt=1then564
  238. 562 nt=ht:ifc(0)<htthennt=c(0)
  239. 564 i=1:forj=1tont:b%(1,c(1)+1)=b%(0,c(0)):c(1)=c(1)+1
  240. 565 ifc(0)=0thengosub246:goto570
  241. 566 c(0)=c(0)-1:ca=b%(1,c(1))
  242. 568 x=x(1)+j-1:y=y(1):gosub66:gosub202
  243. 570 next:i=0:gosub230:goto534
  244. 573 :
  245. 574 rem turn one to each tab
  246. 577 fori=lttogt:ifc(0)=0thenwm=1:gosub90:goto534
  247. 579 c(i)=c(i)+1:b%(i,c(