home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 2 #3 / Commodore_Disk_User_Vol.2_3_1989_-_Side_B.d64 / champ3 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  17KB  |  519 lines
  1. 10 rem       ******************
  2. 20 rem       *                *
  3. 30 rem       * champ dominoes *
  4. 40 rem       *                *
  5. 50 rem       *       by       *
  6. 60 rem       *                *
  7. 70 rem       *  athol mcewan  *
  8. 80 rem       *      1988      *
  9. 90 rem       *                *
  10. 100 rem      ******************
  11. 110 rem **initiate game**
  12. 120 poke53265,peek(53265)or16
  13. 130 poke51,144:poke52,148:poke55,144:poke56,148:clr:do=7:le=1:op=2
  14. 140 gosub4430:poke53280,0:poke53281,0
  15. 150 print"[147]";:fora=0to8:printtab(2)do$(a):next
  16. 160 print"[158]"tab(12)"by athol mcewan":gosub4520:gosub5060
  17. 170 print"[158]     do you need instructions [y/n] [146] n"
  18. 180 printtab(35)"[145]";:poke198,0:inputa$
  19. 190 ifa$="n"then220
  20. 200 ifa$="y"then4670
  21. 210 print"[145][145][145]":goto170
  22. 220 print"[147]";:fora=0to8:printtab(2)do$(a):next:rw=13:gosub2380
  23. 230 ifpeek(251)>4andpeek(251)<11thendo=peek(251)
  24. 240 ifpeek(252)>0andpeek(252)<3thenle=peek(252)
  25. 250 ifpeek(253)>0andpeek(253)<3thenop=peek(253)
  26. 260 printtab(15)"[145][145][145][158] select game [146]":printtab(4)
  27. 270 print" how many opponents [1 or 2]:[146] "op:printtab(33)"[145]";:inputop
  28. 280 ifop<1orop>2thenprint"[145][145]"tab(4):goto270
  29. 290 printtab(4)
  30. 300 print" number of dominoes: [146]"do:printtab(24)"[145]";:poke198,0:inputdo
  31. 310 ifdo<5ordo>9thenprint"[145][145][145]":do=7:goto290
  32. 320 printtab(4)" level [146]":print:printtab(4)"1. novice"
  33. 330 printtab(4)"2. championship"
  34. 340 printtab(4):print" select level [146] "le:printtab(18)"[145]";:poke198,0:inputle
  35. 350 ifle<1orle>2thenprint"[145][145][145]":goto340
  36. 360 td=do*(op+1):print"[147]":rw=11:gosub2380:fora=5to7
  37. 370 printtab(3);mid$(do$(a),3,31):next
  38. 380 rem **deal dominoes**
  39. 390 eq=0:fora=1todo:eq=eq+1:fori=1to(op+1)
  40. 400 rq=int(28*rnd(0)+1):ifs$(rq)=""then400
  41. 410 dd$(i)=s$(rq):s$(rq)=""
  42. 420 next:ifop=1thenm$(eq)=dd$(1):c$(eq)=dd$(2):next:goto450
  43. 430 m$(eq)=dd$(1):c$(eq)=dd$(2):h$(eq)=dd$(3):next
  44. 440 rem **set up game screen**
  45. 450 print"  [158]max":ifop=2thenprint"  joe"
  46. 460 ifop=2thenb2=do:d2=do:g2=do:gosub2490:gosub2510:gosub2440:gosub3390:goto480
  47. 470 ifop=1thenb2=do:d2=do:gosub2490:gosub2440:gosub3390
  48. 480 ifop=2thengosub3240:print"";tab(30)"[150]max[158]joeyou":mr=0:cr=0:gr=0:goto500
  49. 490 gosub3240:print"";tab(30)"[150]max   you":mr=0:cr=0
  50. 500 print" [158][176][192][192][174]":print" [194][194]":print" [173][192][192][189]"
  51. 510 rem **check for highest domino**
  52. 520 ifs$(28)=""thenx=6:goto600
  53. 530 ifs$(26)=""thenx=5:goto600
  54. 540 ifs$(23)=""thenx=4:goto600
  55. 550 ifs$(19)=""thenx=3:goto600
  56. 560 ifs$(14)=""thenx=2:goto600
  57. 570 ifs$(8)=""thenx=1:goto600
  58. 580 ifs$(1)=""thenx=0:goto600
  59. 590 goto690
  60. 600 fori=1todo:l=val(left$(m$(i),1)):r=val(right$(m$(i),1)):xx=l+r
  61. 610 ifl=xandr=xthenpp=i:pt=3:goto850
  62. 620 next
  63. 630 fori=1todo:l=val(left$(c$(i),1)):r=val(right$(c$(i),1)):xx=l+r
  64. 640 ifl=xandr=xthenpp=i:pt=1:n$="max":goto870
  65. 650 next:ifop=1then690
  66. 660 fori=1todo:l=val(left$(h$(i),1)):r=val(right$(h$(i),1)):xx=l+r
  67. 670 ifl=xandr=xthenpp=i:pt=2:n$="joe":goto900
  68. 680 next
  69. 690 ifs$(27)=""thenx=11:goto750
  70. 700 ifs$(25)=""thenx=10:goto750
  71. 710 ifs$(22)=""ors$(24)=""thenx=9:goto750
  72. 720 ifs$(21)=""ors$(18)=""thenx=8:goto750
  73. 730 ifs$(20)=""ors$(17)=""thenx=7:goto750
  74. 740 ifs$(16)=""ors$(12)=""ors$(7)=""thenx=6:goto750
  75. 750 fori=1todo:xx=val(left$(m$(i),1))+val(right$(m$(i),1))
  76. 760 ifxx=xthenpp=i:pt=3:goto850
  77. 770 next
  78. 780 fori=1todo:xx=val(left$(c$(i),1))+val(right$(c$(i),1))
  79. 790 ifxx=xthenpp=i:pt=1:n$="max":goto870
  80. 800 next:iop=1then840
  81. 810 fori=1todo:xx=val(left$(h$(i),1))+val(right$(h$(i),1))
  82. 820 ifxx=xthenpp=i:pt=2:n$="joe":goto900
  83. 830 next
  84. 840 rem **play highest domino**
  85. 850 lc=10:rc=10:gosub2400
  86. 860 printtab(10)"[158][145][145]you have first drop":fort=1to500:next:goto930
  87. 870 gosub2400:printtab(10)"[158][145][145]"n$" has first drop":fort=1to500:next
  88. 880 xx$=c$(pp):c$(pp)="":gosub2660:gosub3290:gosub2400:v1=val(left$(xx$,1))
  89. 890 v2=val(right$(xx$,1)):l=v1:r=v2:gosub3450:gosub3330:gosub2850:goto960
  90. 900 gosub2400:printtab(10)"[158][145][145]"n$" has first drop":fort=1to500:next
  91. 910 xx$=h$(pp):h$(pp)="":gosub2750:gosub3310:gosub2400:v1=val(left$(xx$,1))
  92. 920 v2=val(right$(xx$,1)):l=v1:r=v2:gosub3450:gosub3330:gosub2850:goto960
  93. 930 xx$=m$(pp):m$(pp)="":gosub2530:gosub3270:gosub2400:v1=val(left$(xx$,1))
  94. 940 v2=val(right$(xx$,1)):l=v1:r=v2:gosub3450:gosub3330
  95. 950 rem **check who plays next**
  96. 960 pt=pt+1
  97. 970 ifpt=1thenn$="max":goto1150
  98. 980 ifop=1andpt=2thenpt=3
  99. 990 ifpt=2thenn$="joe":goto1660
  100. 1000 ifpt=3then1030
  101. 1010 ifpt>3thenpt=1:goto970
  102. 1020 rem **you move routine**
  103. 1030 xx$="":gosub2420:cp=0
  104. 1040 rw=12:gosub2380:print"[158]enter your":print"move":sys39270
  105. 1050 g$=chr$(peek(252)):g$=g$+chr$(peek(253))
  106. 1060 ifleft$(g$,1)="d"thengosub3620:gosub2900:goto1120
  107. 1070 g=val(g$):ifg<1org>d2thengosub3760:goto1030
  108. 1080 xx$=m$(g):l=val(left$(xx$,1)):r=val(right$(xx$,1))
  109. 1090 ifl<>v1andl<>v2andr<>v1andr<>v2thengosub3760:goto1030
  110. 1100 m$(g)="":gosub3450:gosub2530:gosub3270:gosub1510:ifd2=0then3790
  111. 1110 goto960
  112. 1120 ifch=1thench=0:gosub2420:goto960
  113. 1130 ifch=0then1030
  114. 1140 rem **max's move routine**
  115. 1150 rw=12:gosub2380:print"[158]max to":print"move":fort=1to1000:next
  116. 1160 xx$="":fori=1to11:pd$(i)="":ng$(i)="":q(i)=0:next:c=1:v=1:ck=0
  117. 1170 fori=1tob2:l=val(left$(c$(i),1)):r=val(right$(c$(i),1))
  118. 1180 ifl=v1orr=v1thenpd$(c)=c$(i):c=c+1:goto1210
  119. 1190 ifl=v2orr=v2thenpd$(c)=c$(i):c=c+1:goto1210
  120. 1200 ng$(v)=c$(i):v=v+1
  121. 1210 next:c=c-1:v=v-1
  122. 1220 ifpd$(1)=""thengosub3010:goto1290
  123. 1230 ifc=1thenpp=1:xx$=pd$(pp):gosub2070:gosub3450:goto1270
  124. 1240 ifle=1then1260
  125. 1250 ifle=2then1310
  126. 1260 pp=int(c*rnd(0))+1:xx$=pd$(pp):gosub2070:gosub3450
  127. 1270 ifb2=0then3830
  128. 1280 goto960
  129. 1290 ifch=1thench=0:gosub2420:goto960
  130. 1300 ifch=0then1160
  131. 1310 iflc=10andrc=10then1390
  132. 1320 fora=1toc:l=val(left$(pd$(a),1)):r=val(right$(pd$(a),1))
  133. 1330 ifl=v1andr=lcthenq(a)=10
  134. 1340 ifl=v2andr=rcthenq(a)=10
  135. 1350 ifr=v1andl=lcthenq(a)=q(a)+10
  136. 1360 ifr=v2andl=rcthenq(a)=q(a)+10
  137. 1370 ifq(a)=20thenpp=a:xx$=pd$(a):gosub2070:gosub3450:goto1270
  138. 1380 next
  139. 1390 fora=1toc:l(a)=val(left$(pd$(a),1)):r(a)=val(right$(pd$(a),1))
  140. 1400 fori=1tov:ll(i)=val(left$(ng$(i),1)):rr(i)=val(right$(ng$(i),1))
  141. 1410 ifl(a)=v1andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  142. 1420 ifr(a)=v1andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  143. 1430 ifl(a)=v2andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  144. 1440 ifr(a)=v2andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  145. 1450 next:next
  146. 1460 fora=1toc:lt=val(left$(pd$(a),1)):rt=val(right$(pd$(a),1))
  147. 1470 q(a)=q(a)+lt+rt:next:lc=0:rc=0:pc=0:fora=1toc:tq=q(a)+l(a)+r(a)
  148. 1480 ifpc<tqthenpc=tq:pp=a
  149. 1490 next:xx$=pd$(pp):gosub2070:gosub3450:goto1270
  150. 1500 rem **position your domino**
  151. 1510 ifv1=v2andl=rthengosub2320:gosub2420:return
  152. 1520 ifl=v1andr=v2then1550
  153. 1530 ifr=v1andl=v2then1550
  154. 1540 gosub2320:goto1640
  155. 1550 ifd2=0andl=v1thenv2=l:v3=r:v4=l:gosub3350:goto1640
  156. 1560 ifd2=0andl=v2thenv1=l:v3=l:v4=r:gosub3370:goto1640
  157. 1570 gosub2420:print"[158][145][145][145]"gu$(l)"up":print"or "gu$(r):print"  up  "
  158. 1580 gosub3730:sys39270:sd$=chr$(peek(252)):sd=val(sd$)
  159. 1590 ifsd<>landsd<>rthen1570
  160. 1600 ifsd=landl=v1thenv2=l:v3=r:v4=l:gosub3350:goto1640
  161. 1610 ifsd=landl=v2thenv1=l:v3=l:v4=r:gosub3370:goto1640
  162. 1620 ifsd=randr=v1thenv2=r:v3=l:v4=r:gosub3350:goto1640
  163. 1630 ifsd=randr=v2thenv1=r:v3=r:v4=l:gosub3370
  164. 1640 gosub2420: return
  165. 1650 rem **joe's move routine**
  166. 1660 rw=12:gosub2380:print"[158]joe to":print"move":fort=1to1000:next
  167. 1670 xx$="":fori=1to11:pd$(i)="":ng$(i)="":q(i)=0:next:c=1:v=1:cj=0
  168. 1680 fori=1tog2:l=val(left$(h$(i),1)):r=val(right$(h$(i),1))
  169. 1690 ifl=v1orr=v1thenpd$(c)=h$(i):c=c+1:goto1720
  170. 1700 ifl=v2orr=v2thenpd$(c)=h$(i):c=c+1:goto1720
  171. 1710 ng$(v)=h$(i):v=v+1
  172. 1720 next:c=c-1:v=v-1
  173. 1730 ifpd$(1)=""thengosub3070:goto1800
  174. 1740 ifc=1thenpp=1:xx$=pd$(pp):gosub2090:gosub3450:goto1780
  175. 1750 ifle=1then1770
  176. 1760 ifle=2then1820
  177. 1770 pp=int(c*rnd(0))+1:xx$=pd$(pp):gosub2090:gosub3450
  178. 1780 ifg2=0then3830
  179. 1790 goto960
  180. 1800 ifch=1thench=0:gosub2420:goto960
  181. 1810 ifch=0then1670
  182. 1820 iflc=10andrc=10then1900
  183. 1830 fora=1toc:l=val(left$(pd$(a),1)):r=val(right$(pd$(a),1))
  184. 1840 ifl=v1andr=lcthenq(a)=10
  185. 1850 ifl=v2andr=rcthenq(a)=10
  186. 1860 ifr=v1andl=lcthenq(a)=q(a)+10
  187. 1870 ifr=v2andl=rcthenq(a)=q(a)+10
  188. 1880 ifq(a)=20thenpp=a:xx$=pd$(a):gosub2090:gosub3450:goto1780
  189. 1890 next
  190. 1900 fora=1toc:l(a)=val(left$(pd$(a),1)):r(a)=val(right$(pd$(a),1))
  191. 1910 fori=1tov:ll(i)=val(left$(ng$(i),1)):rr(i)=val(right$(ng$(i),1))
  192. 1920 ifl(a)=v1andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  193. 1930 ifr(a)=v1andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  194. 1940 ifl(a)=v2andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  195. 1950 ifr(a)=v2andr(a)=ll(i)orr(a)=rr(i)thenq(a)=q(a)+5
  196. 1960 next:next
  197. 1970 fora=1toc:lt=val(left$(pd$(a),1)):rt=val(right$(pd$(a),1))
  198. 1980 q(a)=q(a)+lt+rt:next:lc=0:rc=0:pc=0:fora=1toc:tq=q(a)+l(a)+r(a)
  199. 1990 ifpc<tqthenpc=tq:pp=a
  200. 2000 next:xx$=pd$(pp):gosub2090:gosub3450:goto1780
  201. 2010 ifv1=v2andl=rthengosub2320:gosub2420:return
  202. 2020 ifl=v1andr=v2then2050
  203. 2030 ifr=v1andl=v2then2050
  204. 2040 gosub2320:gosub2420:return
  205. 2050 ifg2=0andl=v1thenv2=l:v3=r:v4=l:gosub3350:gosub2420:return
  206. 2060 ifg2=0andl=v2thenv1=l:v3=l:v4=r:gosub3370:gosub2420:return
  207. 2070 fori=1tob2:ifc$(i)=pd$(pp)thenxx$=c$(i):c$(i)=""
  208. 2080 next:gosub2660:l=val(left$(xx$,1)):r=val(right$(xx$,1)):goto2120
  209. 2090 fori=1tog2:ifh$(i)=pd$(pp)thenxx$=h$(i):h$(i)=""
  210. 2100 next:gosub2750:l=val(left$(xx$,1)):r=val(right$(xx$,1))
  211. 2110 rem **decide where to position dom**
  212. 2120 ifl=v1andr=v2then2150
  213. 2130 ifr=v1andl=v2then2150
  214. 2140 gosub2320:goto2300
  215. 2150 ifp(r)=7andr=v2thenv2=l:v3=r:v4=l:gosub3350:goto2300
  216. 2160 ifp(r)=7andr=v1thenv1=l:v3=l:v4=r:gosub3370:goto2300
  217. 2170 ifp(l)=7andl=v2thenv2=r:v3=l:v4=r:gosub3350:goto2300
  218. 2180 ifp(l)=7andl=v1thenv1=r:v3=r:v4=l:gosub3370:goto2300
  219. 2190 ifle=1thenv1=r:v3=r:v4=l:gosub3370:goto2300
  220. 2200 aa=p(l):ifaa>=p(r)andl=v1thenv2=l:v3=r:v4=l:gosub3350:goto2300
  221. 2210 ifaa>=p(r)andl=v2thenv1=l:v3=l:v4=r:gosub3370:goto2300
  222. 2220 ifaa>=p(r)andr=v1thenv2=r:v3=l:v4=r:gosub3350:goto2300
  223. 2230 ifaa>=p(r)andr=v2thenv1=r:v3=r:v4=l:gosub3370:goto2300
  224. 2240 ifaa<p(r)andr=v1thenv1=l:v3=l:v4=r:gosub3370:goto2300
  225. 2250 ifaa<p(r)andr=v2thenv2=l:v3=r:v4=l:gosub3350:goto2300
  226. 2260 ifl=v1thenv2=l:v3=r:v4=l:gosub3370:goto2300
  227. 2270 ifl=v2thenv2=l:v3=l:v4=r:gosub3350:goto2300
  228. 2280 ifr=v1thenv2=r:v3=l:v4=r:gosub3370:goto2300
  229. 2290 ifr=v2thenv1=r:v3=r:v4=l:gosub3350
  230. 2300 ifpt=1thengosub3290:return
  231. 2310 ifpt=2thengosub3310:return
  232. 2320 ifl=v1thenv1=r:v3=r:v4=l:gosub3370:goto2360
  233. 2330 ifl=v2thenv2=r:v3=l:v4=r:gosub3350:goto2360
  234. 2340 ifr=v1thenv1=l:v3=l:v4=r:gosub3370:goto2360
  235. 2350 ifr=v2thenv2=l:v3=r:v4=l:gosub3350
  236. 2360 return
  237. 2370 rem **set up row**
  238. 2380 rw=rw+1:ee$=left$(rw$,rw):printee$;:return
  239. 2390 rem **clear centre of screen**
  240. 2400 rw=11:gosub2380:fori=1to4:printleft$(cl$,33):next:return
  241. 2410 rem **clear left centre of screen**
  242. 2420 rw=11:gosub2380:fora=1to3:printleft$(cl$,10):next:return
  243. 2430 rem **play your dom with sound**
  244. 2440 m=1:pokell,val(left$(m$(m),1)):pokerr,val(right$(m$(m),1)):syso1:gosub3710
  245. 2450 m=m+1:pokell,val(left$(m$(m),1)):pokerr,val(right$(m$(m),1)):syso2:gosub3710
  246. 2460 ifm>d2-1thenreturn
  247. 2470 goto2450
  248. 2480 rem **play max's dom with sound**
  249. 2490 sysc1:gosub3710:forp=1tob2-1:sysc2:gosub3710:next:gosub2850:return
  250. 2500 rem **play joe's dom with sound**
  251. 2510 sysq1:gosub3710:forp=1tog2-1:sysq2:gosub3710:next:return
  252. 2520 rem **remove one of your dom**
  253. 2530 d2=d2-1:ifd2=0thenrw=15:gosub2380:fora=1to9:printleft$(cl$,33):next:return
  254. 2540 i=1:fora=1to(d2+1):ifm$(a)=""then2560
  255. 2550 zz$(i)=m$(a):i=i+1
  256. 2560 next
  257. 2570 fora=1to11:m$(a)="":next:fora=1tod2:m$(a)=zz$(a):next
  258. 2580 rw=15:gosub2380:fori=1to9:printleft$(cl$,34):next
  259. 2590 printleft$(cl$,34);""
  260. 2600 m=1:pokell,val(left$(m$(m),1)):pokerr,val(right$(m$(m),1)):syso1
  261. 2610 ifd2=1thengosub3240:return
  262. 2620 m=m+1:pokell,val(left$(m$(m),1)):pokerr,val(right$(m$(m),1)):syso2
  263. 2630 ifm>d2-1thengosub3240:return
  264. 2640 goto2620
  265. 2650 rem **remove one of max's dom**
  266. 2660 b2=b2-1:ifb2=0thenprint"";:fora=1to5
  267. 2670 ifb2=0thenprint""left$(cl$,24):next:return
  268. 2680 i=1:fora=1to(b2+1):ifc$(a)=""then2700
  269. 2690 zz$(i)=c$(a):i=i+1
  270. 2700 next
  271. 2710 fora=1to11:c$(a)="":next:fora=1tob2:c$(a)=zz$(a):next
  272. 2720 print"";:fora=1to5:print""left$(cl$,24):next:sysc1:ifb2=1thenreturn
  273. 2730 forp=1tob2-1:sysc2:next:gosub2850:return
  274. 2740 rem **remove one of joe's dom**
  275. 2750 g2=g2-1:ifg2=0thenprint"":fora=1to5
  276. 2760 ifg2=0thenprint""left$(cl$,24):next:return
  277. 2770 i=1:fora=1to(g2+1):ifh$(a)=""then2790
  278. 2780 zz$(i)=h$(a):i=i+1
  279. 2790 next
  280. 2800 fora=1to11:h$(a)="":next:fora=1tog2:h$(a)=zz$(a):next
  281. 2810 print"":fora=1to5:print""left$(cl$,24):next
  282. 2820 sysq1:ifg2=1thenreturn
  283. 2830 forp=1tog2-1:sysq2:next:gosub2850:return
  284. 2840 rem **print nos for computer dom**
  285. 2850 print"                        "
  286. 2860 dn=b2:ifg2>b2thendn=g2
  287. 2870 rw=5:gosub2380:print"";:fora=1todn:a$=str$(a)
  288. 2880 a$=right$(a$,(len(a$)-1)):printa$" ";:next:return
  289. 2890 rem **routine if you cant play**
  290. 2900 lc=v1:rc=v2:ifd2<11then2950
  291. 2910 xx$="out[146]":gosub3270:cp=1:ch=1
  292. 2920 ifop=1andcp=1andck=1then3980
  293. 2930 ifcp=1andck=1andcj=1then3980
  294. 2940 gosub3710:gosub3710:return
  295. 2950 iftd=28then2910
  296. 2960 a=int(28*rnd(0)+1):ifs$(a)=""then2960
  297. 2970 d2=d2+1:m$(d2)=s$(a):s$(a)="":td=td+1:gosub3390
  298. 2980 pokell,val(left$(m$(d2),1)):pokerr,val(right$(m$(d2),1)):print"[152]":syso2
  299. 2990 gosub3710:gosub3240:return
  300. 3000 rem **routine if max cant play**
  301. 3010 ifb2<11then3110
  302. 3020 xx$="out[146]":gosub3290:ck=1:ch=1
  303. 3030 ifop=1andcp=1andck=1then3980
  304. 3040 ifck=1andcp=1andcj=1then3980
  305. 3050 gosub3710:gosub3710:gosub2860:return
  306. 3060 rem **routine if joe cant play**
  307. 3070 ifg2<11then3170
  308. 3080 xx$="out[146]":gosub3310:cj=1:ch=1
  309. 3090 ifck=1andcp=1andcj=1then3980
  310. 3100 gosub3710:gosub3710:gosub2860:return
  311. 3110 iftd=28then3020
  312. 3120 a=int(28*rnd(0)+1):ifs$(a)=""then3120
  313. 3130 rem **add dom to max's hand**
  314. 3140 b2=b2+1:c$(b2)=s$(a):s$(a)="":td=td+1:gosub3390
  315. 3150 print"[152]":sysc2
  316. 3160 gosub3710:return
  317. 3170 iftd=28then3080
  318. 3180 a=int(28*rnd(0)+1):ifs$(a)=""then3180
  319. 3190 rem **add dom to joe's hand**
  320. 3200 g2=g2+1:h$(g2)=s$(a):s$(a)="":td=td+1:gosub3390
  321. 3210 print"[152]":sysq2
  322. 3220 gosub3710:return
  323. 3230 rem **nos for your dominoes**
  324. 3240 rw=24:gosub2380:printtab(1)"1 ";:ifd2=1thenreturn
  325. 3250 fori=2tod2:printi;:next:return
  326. 3260 rem ** print your dom value in column**
  327. 3270 rw=mr:mr=mr+1:gosub2380:print"":printtab(36)xx$:return
  328. 3280 rem **print max's dom value in column**
  329. 3290 rw=cr:cr=cr+1:gosub2380:print"[150]":printtab(30)xx$:return
  330. 3300 rem **print joe's dom value in column**
  331. 3310 rw=gr:gr=gr+1:gosub2380:print"[158]":printtab(33)xx$:return
  332. 3320 rem **print centre dominoe**
  333. 3330 pokell,v1:pokerr,v2:syscd:gosub3710:return
  334. 3340 rem **print centre right dominoe**
  335. 3350 pokell,v3:pokerr,v4:syscc:gosub3710:return
  336. 3360 rem **print centre left dominoe**
  337. 3370 pokell,v3:pokerr,v4:syscl:gosub3710:return
  338. 3380 rem **print no of dominoes left**
  339. 3390 i=28-td:ifi<0theni=0
  340. 3400 print"  ":i$=str$(i)
  341. 3410 i$=right$(i$,(len(i$)-1))
  342. 3420 iflen(i$)=1theni$="0"+i$
  343. 3430 print"[156]"i$:return
  344. 3440 rem **keep check on dominoes played**
  345. 3450 r=val(right$(xx$,1)):l=val(left$(xx$,1))
  346. 3460 ifr=0thenp(0)=p(0)+1
  347. 3470 ifr=1thenp(1)=p(1)+1
  348. 3480 ifr=2thenp(2)=p(2)+1
  349. 3490 ifr=3thenp(3)=p(3)+1
  350. 3500 ifr=4thenp(4)=p(4)+1
  351. 3510 ifr=5thenp(5)=p(5)+1
  352. 3520 ifr=6thenp(6)=p(6)+1
  353. 3530 ifl=0thenp(0)=p(0)+1
  354. 3540 ifl=1thenp(1)=p(1)+1
  355. 3550 ifl=2thenp(2)=p(2)+1
  356. 3560 ifl=3thenp(3)=p(3)+1
  357. 3570 ifl=4thenp(4)=p(4)+1
  358. 3580 ifl=5thenp(5)=p(5)+1
  359. 3590 ifl=6thenp(6)=p(6)+1
  360. 3600 return
  361. 3610 rem **check if you can play**
  362. 3620 ifle<>1thenreturn
  363. 3630 fora=1tod2:l=val(left$(m$(a),1)):r=val(right$(m$(a),1))
  364. 3640 ifl=v1orr=v1then3680
  365. 3650 ifl=v2orr=v2then3680
  366. 3660 next
  367. 3670 return
  368. 3680 fori=1to3:gosub2420:rw=12:gosub2380:print"you can":print"  play[158]"
  369. 3690 gosub3760:next:fora=1to1000:next:goto1030
  370. 3700 rem **sound routines**
  371. 3710 forx=sstoss+24:pokex,0:next:pokevo,15:pokead,5:pokesr,5:pokewf,17
  372. 3720 fortz=1to4:pokewf,130:pokehf,33:pokelf,33:pokehf,0:pokelf,o:next:return
  373. 3730 fora=1to3:pokevo,15
  374. 3740 pokewf,0:pokelf,0:pokehf,0:pokead,0:pokesr,240:pokewf,17
  375. 3750 pokehf,150:pokewf,0:poke53280,0:next:return
  376. 3760 pokevo,15:pokewf,0:pokelf,0:pokehf,0:pokead,0:pokesr,240:pokewf,17
  377. 3770 forz=60to0step-1:pokehf,z:next:return
  378. 3780 rem **you have won**
  379. 3790 rw=18:gosub2380:printee$tab(15)"well done":printtab(16)"you win"
  380. 3800 rw=24:gosub2380:print"   "
  381. 3810 w=0:f=17:t=1:goto3890
  382. 3820 rem **max or joe wins**
  383. 3830 ifb2=0thenrw=3:gosub2380:printee$tab(15)"hard luck"
  384. 3840 ifb2=0thenprinttab(16)"max wins"
  385. 3850 ifop=2andg2=0thenrw=8:gosub2380:printee$tab(15)"hard luck"
  386. 3860 ifop=2andg2=0thenprinttab(16)"joe wins"
  387. 3870 w=17:f=0:t=-1:goto3890
  388. 3880 rem **end of game sound**
  389. 3890 pokevo,15:pokewf,0:pokess,0:pokehf,0:pokead,0:pokesr,240:pokewf,33
  390. 3900 forz=wtofstept:poke53280,z:fora1=1to15:pokehf,a*a1:next:next
  391. 3910 pokewf,0:poke53280,0:rw=23:gosub2380
  392. 3920 printtab(5)"[158] do you want another game: [146] y":printtab(31)"[145]";:inputa$
  393. 3930 ifleft$(a$,1)="y"thenpoke251,do:poke252,le:poke253,op
  394. 3940 ifleft$(a$,1)="y"thenclr:gosub4430:gosub4520:goto220
  395. 3950 ifleft$(a$,1)="n"thenstop
  396. 3960 print"[145][145]":goto3920
  397. 3970 rem  **stitched game**
  398. 3980 c1=0:c2=0:v1=0:v2=0:j1=0:j2=0
  399. 3990 print"[147]";:fora=0to8:printtab(2)do$(a):next
  400. 4000 printtab(14)"stitched game"
  401. 4010 ifop=1thenrw=15:gosub2380:print"max"spc(31)"you":goto4030
  402. 4020 rw=15:gosub2380:print"max"spc(14)"joe"spc(14)"you"
  403. 4030 tt=b2:ifd2>ttthentt=d2
  404. 4040 ifg2>ttthentt=g2
  405. 4050 fora=1tott:c1=c1+val(left$(c$(a),1)):c2=c2+val(right$(c$(a),1))
  406. 4060 ifc$(a)=""thenc$(a)="   "
  407. 4070 print"[158]"c$(a)spc(14);
  408. 4080 ifop=2thenj1=j1+val(left$(h$(a),1)):j2=j2+val(right$(h$(a),1))
  409. 4090 ifop=2andh$(a)=""thenh$(a)="   "
  410. 4100 ifop=2thenprinth$(a);spc(14);
  411. 4110 ifop=1thenprintspc(17);
  412. 4120 v1=v1+val(left$(m$(a),1)):v2=v2+val(right$(m$(a),1))
  413. 4130 ifm$(a)=""thenm$(a)="   "
  414. 4140 printm$(a):next:goto4210
  415. 4150 fora=1tott:c1=c1+val(left$(c$(a),1)):c2=c2+val(right$(c$(a),1))
  416. 4160 ifc$(a)=""thenc$(a)="   "
  417. 4170 print"[158]"c$(a)spc(31);
  418. 4180 v1=v1+val(left$(m$(a),1)):v2=v2+val(right$(m$(a),1))
  419. 4190 ifm$(a)=""thenm$(a)="   "
  420. 4200 printm$(a):next
  421. 4210 ifop=2thenrw=11:gosub2380:print"max's"spc(11)"joe's"spc(13)"your"
  422. 4220 ifop=1thenrw=11:gosub2380:print"max's"spc(29)"your"
  423. 4230 ifop=2thenprint"points"spc(10)"points"spc(11)"points"
  424. 4240 ifop=1thenprint"points"spc(27)"points"
  425. 4250 s1=c1+c2:s2=j1+j2:s3=v1+v2
  426. 4260 ifop=2thenprint""s1;spc(16-len(str$(s1)));s2;spc(16-len(str$(s2)))s3
  427. 4270 ifop=1thenprint" "s1;spc(32-len(str$(s1)));s3:s2=1000
  428. 4280 fort=1to10
  429. 4290 ifs1<s2ands1<s3thenn$="max":goto4360
  430. 4300 ifs2<s1ands2<s3thenn$="joe":goto4360
  431. 4310 ifs3<s1ands3<s2thenn$="you":goto4360
  432. 4320 ifs1=s2ands2=s3thenrw=14:gosub2380:printtab(16)"we draw":goto4410
  433. 4330 ifs1=s2thenrw=14:gosub2380:printtab(11)"max and joe draw":goto4410
  434. 4340 ifs1=s3thenrw=14:gosub2380:printtab(11)"max and you draw":goto4410
  435. 4350 ifs2=s3thenrw=14:gosub2380:printtab(11)"joe and you draw":goto4410
  436. 4360 rw=14:gosub2380:printtab(15)""n$" wins"
  437. 4370 ifn$="you"thenprinttab(22)"[145] "
  438. 4380 fora=1to200:next
  439. 4390 printtab(15)"[145]          ":next:printtab(15)"[145]"n$" wins"
  440. 4400 ifn$="you"thenprinttab(22)"[145] "
  441. 4410 rw=23:gosub2380:goto3920
  442. 4420 rem **set up variables etc**
  443. 4430 do$(0)="[176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  444. 4440 do$(1)="[221] [213][195][201][178] [178][176][195][201][213][178][201][176][195][201][178][213][195][201][176][201][178][176][195][201][178] [178][178][176][195][201] [221]"
  445. 4450 do$(2)="[221][158] [221]  [171][195][179][171][195][179][221][221][221][171][195][203][221][221][221][221][221][221][221][173][195][174][171][195][179][221][171][195][203] [221]"
  446. 4460 do$(3)="[221] [202][195][203][177] [177][177] [177][177] [177][177]  [177][202][195][203][177][202][189][173][195][189][177] [177][177][177]   [221]"
  447. 4470 do$(4)="[221]                                  [221]"
  448. 4480 do$(5)="[221]      [176][195][201][213][195][201][213][178][201][213][174][176][201][178][213][195][201][213][195][201][176][195][174]     [221]"
  449. 4490 do$(6)="[221][158]      [221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][221][171][195] [173][195][174]     [221]"
  450. 4500 do$(7)="[221]      [173][195][203][202][195][203][177] [177][173][189][177][173][189][202][195][203][173][195][189][173][195][189]     [221]"
  451. 4510 do$(8)="[173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189][159]":return
  452. 4520 gu$(0)="blank ":gu$(1)="one ":gu$(2)="two ":gu$(3)="three "
  453. 4530 gu$(4)="four ":gu$(5)="five ":gu$(6)="six "
  454. 4540 rw$=""
  455. 4550 cl$="                                       "
  456. 4560 dims$(28),c$(11),m$(11),h$(11),xx$(11),pd$(11),ng$(11),q$(11),q(11)
  457. 4570 ss=54272:lf=ss:hf=ss+1:ad=ss+5:sr=ss+6:wf=ss+4:vo=ss+24:h3=ss+15:l3=ss+14
  458. 4580 c1=39150:c2=39185:o1=38160:o2=38220:cd=38582:ll=251:rr=252
  459. 4590 cc=39011:cl=38992:q1=39210:q2=39245
  460. 4600 s$(1)="0-0":s$(2)="0-1":s$(3)="0-2":s$(4)="0-3":s$(5)="0-4":s$(6)="0-5"
  461. 4610 s$(7)="0-6":s$(8)="1-1":s$(9)="1-2":s$(10)="1-3":s$(11)="1-4":s$(12)="1-5"
  462. 4620 s$(13)="1-6":s$(14)="2-2":s$(15)="2-3":s$(16)="2-4":s$(17)="2-5"
  463. 4630 s$(18)="2-6":s$(19)="3-3":s$(20)="3-4":s$(21)="3-5":s$(22)="3-6"
  464. 4640 s$(23)="4-4":s$(24)="4-5":s$(25)="4-6":s$(26)="5-5":s$(27)="5-6"
  465. 4650 s$(28)="6-6":return
  466. 4660 rem **instructions**
  467. 4670 print"[147]   instructions [146][159]"
  468. 4680 print"normal domino rules apply...........
  469. 4690 [153]"you will be playing with a double six
  470. 4700 print"pack and dealt with the number of
  471. 4710 [153]"dominoes you select between 5 and 9.
  472. 4720 print"the computer will check which player
  473. 4730 [153]"holds the highest double and make the
  474. 4740 print"the first move.
  475. 4750 [153]"to make subsequent moves enter the
  476. 4760 print"number of the selected domino and
  477. 4770 [153]"press return. if you are unable to play
  478. 4780 print"additional dominoes can be drawn from
  479. 4790 [153]"the pool by entering 'd' and return.
  480. 4800 print"'d' should be used even if there are"
  481. 4810 print"no dominoes left in the pool."
  482. 4820 print"all dominoes played will be displayed
  483. 4830 [153]"on the right of the screen under the
  484. 4840 print"correct column.
  485. 4850 [153]"if you hold eleven dominoes or the
  486. 4860 print"pool is empty you will miss that turn.
  487. 4870 [153]"sys press return to continue wait
  488. 4880 geta$:ifa$=""then4880
  489. 4890 ifa$<>chr$(13)then4880
  490. 4900 print"[147][159]the computer will automatically make
  491. 4910 [153]"moves for max and joe.
  492. 4920 print"if your move can alter the state of the
  493. 4930 [153]"game. i.e. your selected domino can
  494. 4940 print"be played either way you will be asked
  495. 4950 [153]"which side up. the number you select
  496. 4960 print"will then be the value at both ends.
  497. 4970 [153]"if the game is 'stitched' (no player
  498. 4980 print"wins) the winner is decided by the
  499. 4990 [153]"lowest spot total of the dominoes on
  500. 5000 print"the table at the end of the game.
  501. 5010 [153]"sys  press return for first game wait
  502. 5020 geta$:ifa$=""then5020
  503. 5030 ifa$<>chr$(13)then5020
  504. 5040 goto220
  505. 5050 rem **redifine characters**
  506. 5060 i=49152
  507. 5070 read a:if a=256 then5100
  508. 5080 poke i,a:i=i+1:goto5070
  509. 5090 data 0,3,7,7,7,7,3,256
  510. 5100 i=49376
  511. 5110 read a:if a=256 then5140
  512. 5120 poke i,a:i=i+1:goto5110
  513. 5130 data 0,192,224,224,224,224,192,256
  514. 5140 i=49393
  515. 5150 read a:if a=256 then return
  516. 5160 poke i,a:i=i+1:goto5150
  517. 5170 data 0,0,0,0,60,126,126,126
  518. 5180 data 126,60,0,0,0,0,256
  519.