home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 32 / 032.d81 / yahtzee (.txt) < prev   
Commodore BASIC  |  2022-08-26  |  8KB  |  319 lines
  1. 1 dimb%(39):poke53281,0:poke53280,6:poke646,1
  2. 5 remnocas converter
  3. 10 rem
  4. 15 rem      **********************
  5. 18 rem
  6. 20 rem         computer yahtzee
  7. 30 rem
  8. 40 rem          copyright 1986
  9. 45 rem
  10. 50 rem       by: christine benoit
  11. 60 rem
  12. 65 rem      **********************
  13. 70 rem
  14. 80 rem
  15. 100 gosub960:remtitlepage
  16. 110 gosub800:reminitialize
  17. 115 gosub1100:reminstrucs
  18. 120 print"[147]"chr$(142);:gosub900:remborder
  19. 130 gosub700:remscreen
  20. 140 gosub750:remclear
  21. 150 gosub200:remplay
  22. 160 gosub914:remtotalup
  23. 170 ifagn=1then120
  24. 180 printchr$(147);: 
  25. 190 print:goto63000
  26. 200 gosub300:remrolldice
  27. 210 gosub450:remsort
  28. 220 gosub500:remscore
  29. 225 numleft=numleft-1
  30. 230 ifnumleft>0then200
  31. 240 return
  32. 250 print"";:vt=10:ht=1:gosub50000:printchr$(18);:printsp$;
  33. 255 vt=10:ht=1:x=41-len(x$):y=int(x/2)
  34. 260 printspc(y);x$;
  35. 265 x=fre(0):return
  36. 270 rem sound routine
  37. 280 rem
  38. 290 return
  39. 300 trial=1:print"[158]";
  40. 305 fori=5to7:vt=i:ht=5:gosub50000:printspc(30);:next
  41. 310 fori=1to5:rl(i)=1:next
  42. 315 print"[158]";:fori=1to5
  43. 320 ifrl(i)=0then328
  44. 325 dice(i)=int(rnd(1)*6)+1:d=i:gosub400:rl(i)=0
  45. 328 nexti
  46. 330 iftrial=3thenprint"";:return
  47. 335 trial=trial+1
  48. 340 :
  49. 345 :
  50. 350 :
  51. 355 :
  52. 356 :
  53. 360 x$="select dice--press return: 1 2 3 4 5     ":gosub250
  54. 365 r=5:n=0
  55. 370 poke198,0:wait198,1
  56. 375 getk$:k=asc(k$+chr$(0)):ifk$="q"thengosub60000:ifk=141then315
  57. 376 ifk=13then315
  58. 380 k=k-48:ifk<1ork>5then370
  59. 385 v=10:ifrl(k)=0thenrl(k)=1:n=n+1:goto395
  60. 390 rl(k)=0:n=n-1
  61. 395 print"[146]";:ifrl(k)=0thenprint"";
  62. 396 vt=v+1:ht=26+2*k:gosub50000
  63. 397 printmid$(str$(k),2);"";
  64. 398 goto370
  65. 400 v=5:h=6*d
  66. 410 forx=3to12:vt=v+x-3*int(x/3):ht=h:gosub50000:print"[209][209][209]";:ht=h
  67. 412 gosub50000:print"   ";:next
  68. 415 d=dice(d)
  69. 420 vt=v:ht=h:gosub50000:printdice$(d,1);
  70. 425 vt=v+1:ht=h:gosub50000:printdice$(d,2);
  71. 430 vt=v+2:ht=h:gosub50000:printdice$(d,3);
  72. 435 rem
  73. 440 return
  74. 450 fori=1to4
  75. 455 forj=i+1to5
  76. 460 ifdice(j)>=dice(i)then470
  77. 465 x=dice(j):dice(j)=dice(i):dice(i)=x
  78. 470 nextj
  79. 475 nexti
  80. 480 return
  81. 500 x$="select score with cursor and return     ":gosub250:print"[129]";
  82. 505 c=1:dc=1:goto555
  83. 510 poke198,0:wait198,1:print"[129]";
  84. 515 getk$:k=asc(k$+chr$(0)):ifk$="q"thengosub60000:ifk=13then570
  85. 516 ifk=13then570
  86. 520 ifk=17thendc=1:goto535
  87. 525 ifk=145thendc=-1:goto535
  88. 530 goto510
  89. 535 vt=vrt(c):ht=2+15*abs((c>6)):gosub50000:print"[146][129]"choice$(c)
  90. 540 c=c+dc
  91. 545 ifc=0thenc=13
  92. 550 ifc=14thenc=1
  93. 555 ifsc(c,2)=1then540
  94. 560 print"";:vt=vrt(c):ht=2+15*abs((c>6)):gosub50000:printchoice$(c)
  95. 565 goto510
  96. 570 ifc<7then637
  97. 571 onc-6goto577,585,593,603,617,627,632
  98. 572 sc(c,1)=temp:sc(c,2)=1:vt=vrt(c)
  99. 573 ht=2+15*abs((c>6)):gosub50000:printchoice$(c);
  100. 574 ht=10+23*abs((c>6)):gosub50000:printspc(abs((temp<10)));
  101. 575 s$=mid$(str$(temp),2):iflen(s$)<2thenprint"[157] ";
  102. 576 print"[158]";s$;"[129]";:gosub690:return
  103. 577 rem***3ofakind
  104. 578 rem
  105. 579 ifdice(1)=dice(2)anddice(2)=dice(3)then583
  106. 580 ifdice(2)=dice(3)anddice(3)=dice(4)then583
  107. 581 ifdice(3)=dice(4)anddice(4)=dice(5)then583
  108. 582 goto646:remerror
  109. 583 temp=dice(1)+dice(2)+dice(3)+dice(4)+dice(5)
  110. 584 goto572
  111. 585 rem
  112. 586 rem***4ofakind
  113. 587 rem
  114. 588 ifdice(1)=dice(4)then591
  115. 589 ifdice(2)=dice(5)then591
  116. 590 goto646:remerror
  117. 591 temp=dice(1)+dice(2)+dice(3)+dice(4)+dice(5)
  118. 592 goto572
  119. 593 rem
  120. 594 rem***fullhouse
  121. 595 rem
  122. 596 ifdice(1)<>dice(3)then599
  123. 597 ifdice(4)=dice(5)then601
  124. 598 goto646:remerror
  125. 599 ifdice(3)=dice(5)anddice(1)=dice(2)then601
  126. 600 goto646:remerror
  127. 601 temp=25:goto572
  128. 602 s1=0
  129. 603 rem
  130. 604 rem***smallstraight
  131. 605 rem
  132. 606 s1=0
  133. 607 ifdice(1)+1=dice(2)thens2=1:goto609
  134. 608 s2=2
  135. 609 forj=s2to4
  136. 610 ifdice(j)+1=dice(j+1)thens1=10*s1+dice(j)
  137. 611 nextj
  138. 612 ifdice(5)-dice(4)=2thens1=10*s1+dice(4):goto614
  139. 613 ifdice(5)-dice(4)<2thens1=10*s1+dice(5)
  140. 614 ifs1=1234ors1=2345ors1=3456ors1=12345ors1=23456then616
  141. 615 goto646:remerror
  142. 616 temp=30:goto572
  143. 617 rem
  144. 618 rem***largestraight
  145. 619 rem
  146. 620 si=0
  147. 621 forj=1to4
  148. 622 ifdice(j)+1=dice(j+1)thensi=si+1:goto624
  149. 623 si=0
  150. 624 nextj
  151. 625 ifsi<>4then646:remerror
  152. 626 temp=40:goto572
  153. 627 rem
  154. 628 rem***yahtzee
  155. 629 rem
  156. 630 ifdice(1)<>dice(5)then646:remerror
  157. 631 temp=50:goto572
  158. 632 rem
  159. 633 rem***chance
  160. 634 rem
  161. 635 temp=dice(1)+dice(2)+dice(3)+dice(4)+dice(5)
  162. 636 goto572
  163. 637 rem
  164. 638 rem***1'sthrough6's
  165. 639 rem
  166. 640 temp=0
  167. 641 forj=1to5
  168. 642 ifdice(j)=cthentemp=temp+c
  169. 643 nextj
  170. 644 iftemp=0then646:remerror
  171. 645 goto572
  172. 646 rem
  173. 647 rem***errorroutine
  174. 648 rem
  175. 649 x$=sp$:gosub250:x$="you don't have "
  176. 650 ifc<7thenx$=x$+"any ":goto652
  177. 651 ifc=9orc=10orc=11thenx$=x$+"a "
  178. 652 x$=x$+choice$(c):gosub250:gosub270
  179. 653 fort=1to1000:next
  180. 654 x$="do you want to take a zero? (y/n)":gosub250:gosub280
  181. 655 poke198,0:wait198,1:getr$:printr$;
  182. 656 ifr$="y"thentemp=0:x$=sp$:gosub250:print"[146][129]";:goto572
  183. 657 ifr$="n"thenx$="select score with cursor and return":gosub250:goto510
  184. 658 goto654
  185. 690 t=0:fori=1to6:t=t+sc(i,1):next
  186. 694 bn=35*abs((t>62))
  187. 696 vt=20:ht=10:gosub50000:print"[158]";spc(abs((bn<10)));mid$(str$(bn),2);
  188. 698 return
  189. 700 print"";spc(6);
  190. 705 fori=1to5:printchr$(18);:print"[159]"i"[157] [146]   ";:next:printspc(5);:print
  191. 706 print:print:print
  192. 710 fori=1to3:print"";sp$;:next:print
  193. 715 printspc(2)"[129]ones....[158]$$     [129]3 of a kind.....[158]$$"spc(5);
  194. 720 printspc(2)"[129]twos....[158]$$     [129]4 of a kind.....[158]$$"spc(5);
  195. 725 printspc(2)"[129]threes..[158]$$     [129]full house......[158]$$"spc(5);
  196. 730 printspc(2)"[129]fours...[158]$$     [129]small straight..[158]$$"spc(5);
  197. 735 printspc(2)"[129]fives...[158]$$     [129]large straight..[158]$$"spc(5);
  198. 740 printspc(2)"[129]sixes...[158]$$     [129]yahtzee.........[158]$$"spc(5);
  199. 745 printspc(2)"[129]bonus...[158] 0     [129]chance..........[158]$$"spc(5)
  200. 746 print"[158]            press q[158] to quit."
  201. 748 print"":return
  202. 750 fori=1to13:sc(i,1)=0:sc(i,2)=0:next
  203. 760 numleft=13:bn=0
  204. 770 return
  205. 800 dimdice(5),dice$(6,3),choice$(13),sc(13,2),rl(5)
  206. 802 dimvrt(13)
  207. 805 rem
  208. 810 fori=1to6:forj=1to3:readdice$(i,j):next:next
  209. 815 fori=1to13:readchoice$(i):next
  210. 818 fori=1to13:readvrt(i):next
  211. 820 rem
  212. 830 data"   "," [209] ","   ","  [209]","   ","[209]  "
  213. 840 data"  [209]"," [209] ","[209]  ","[209] [209]","   ","[209] [209]"
  214. 850 data"[209] [209]"," [209] ","[209] [209]","[209] [209]","[209] [209]","[209] [209]"
  215. 860 dataones,twos,threes,fours,fives,sixes,3 of a kind
  216. 862 data4 of a kind,full house,small straight
  217. 864 datalarge straight,yahtzee,chance
  218. 865 data14,15,16,17,18,19,14,15,16,17,18,19,20
  219. 870 games = 0:bst=0:wrst=999:ttl=0
  220. 875 vt=22:ht=11:gosub50000:print"[ [208][210][197][211][211] [193][206][217] [203][197][217] ]";
  221. 877 rem
  222. 880 poke198,0:wait198,1:rem****rnd(1):ifk<128then880
  223. 885 getk$
  224. 890 return
  225. 900 printchr$(147);"[146]";
  226. 902 print"[154][176][192][192][179][159]c o m p u t e r   y a h t z e e[146][154][171][192][192][192][174]";
  227. 904 rem
  228. 906 fori=1to23:vt=i:ht=0:gosub50000:print"[221]";:ht=39:gosub50000:print"[221]";:next
  229. 908 vt=24:ht=0:gosub50000:print"[173][192][192][179][159]b y    c h r i s    b e n o i t[146][154][171][192][192][192]";:
  230. 909 poke2023,125:poke2023+54272,14
  231. 910 rem
  232. 912 return
  233. 914 printdn$
  234. 915 print"";:printchr$(18);
  235. 916 print"[159]    c o m p u t e r   y a h t z e e     ";
  236. 917 tp=bn:fori=1to6:tp=tp+sc(i,1):next
  237. 918 bt=0:fori=7to13:bt=bt+sc(i,1):next
  238. 920 gt=tp+bt:games=games+1:ttl=ttl+gt:avg=int(ttl/games)
  239. 922 ifgt<wrstthenwrst=gt
  240. 924 ifgt>bstthenbst=gt
  241. 926 vt=9:ht=9:gosub50000:print"[146]---";:ht=32:gosub50000:print"---"
  242. 928 vt=10:ht=8:gosub50000:nm=tp:gosub956
  243. 930 ht=31:gosub50000:nm=bt:gosub956
  244. 932 h=6:vt=14
  245. 934 ht=h:vt=vt+1:gosub50000:print"[129]score for this game......[158]";:nm=gt:gosub956
  246. 936 ht=h:vt=vt+1:gosub50000:print"[129]number of games played...[158]";:nm=games:gosub956
  247. 938 ht=h:vt=vt+1:gosub50000:print"[129]best score so far........[158]";:nm=bst:gosub956
  248. 940 ht=h:vt=vt+1:gosub50000:print"[129]worst score so far.......[158]";:nm=wrst:gosub956
  249. 942 ht=h:vt=vt+1:gosub50000:print"[129]average score............[158]";:nm=avg:gosub956
  250. 944 fort=1to3000:next
  251. 946 print:print:agn=0
  252. 947 vt=vt+2:ht=11:gosub50000
  253. 948 print"[159]play again? ([154]y[159]/[154]n[159])[145]";:gosub280:agn=0
  254. 949 poke198,0:wait198,1:getr$
  255. 950 ifr$="y"thenagn=1:goto954
  256. 952 ifr$<>"n"then949
  257. 954 return
  258. 956 printspc(abs((nm<100)));spc(abs((nm<10)));nm:return
  259. 960 :printchr$(147);: