home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #2 / utv1n2s1.d64 / concentration (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  9KB  |  286 lines
  1. 10 printchr$(8) chr$(142)chr$(147)
  2. 100 rem   ***dimensions and*
  3. 110 rem ***preliminary initialization***
  4. 120 dimpf%(4,5),sc$(2),ss$(2),cd$(9),pn$(6),sc(6),cs(6),dk%(20),m1$(4)
  5. 125 dim l$(13),rl(13),cl(13), n(13)
  6. 130 pr=49156:pd=pr-2:p2=pr-4:fori=0to12:readq:pokep2+i,q:nexti:ro=251:co=252
  7. 140 data230,251,230,251,166,251,164,252,24,32,240,255,96
  8. 150 bo=53280:ba=bo+1:pt=646:cs$=chr$(147):bs$=chr$(32):rv$=chr$(18)
  9. 160 of$=chr$(146):x=rnd(-ti)
  10. 170 lg$=chr$(153):lr$=chr$(150):lb$=chr$(154):wh$=chr$(5)
  11. 180 ak$="any key to continue"
  12. 190 bl$="":fori=1to40:bl$=bl$+bs$:nexti
  13. 200 em$=left$(bl$,13):ec$=left$(bl$,5)
  14. 205 print"[147]": poke53280,5: poke53281,13
  15. 210 goto 3600: rem *** screen init ***
  16. 220 rem     ***subroutines***
  17. 230 rem     ***move cursor***
  18. 240 pokero,r:pokeco,c:syspr:return
  19. 250 rem     ***timing loop***
  20. 260 tx=dd:iftm<>0thentx=tm
  21. 270 tx=ti+tx*30
  22. 280 iftx>tithen280
  23. 290 tm=0:return
  24. 300 rem    ***get any key***
  25. 310 getz$:ifz$=""then310
  26. 315 if z$=chr$(140)then 2000
  27. 320 return
  28. 330 rem      ***ring bell***
  29. 340 pokesd+4,21:tm=.75:gosub260:pokesd+4,0:return
  30. 350 rem ***print screen background***
  31. 360 printcs$:r=1:c=2:gosub240:printog$of$"round";rn;tab(12)"game";gn
  32. 370 printog$:r=0:c=26:gosub240:printvl$;:fori=1to24:syspd:printvl$;:nexti
  33. 380 r=2:c=0:gosub240:printmm$;:fori=1to25:printmm$;:nexti:printlj$
  34. 390 r=8:c=26:gosub240:printrj$;:fori=1to13:printmm$;:nexti
  35. 400 r=3:c=3:gosub240:printbu$"1"rp$"2"rp$"3"rp$"4"rp$"5"
  36. 410 r=6:c=0:gosub240:print"a"dp$"b"dp$"c"dp$"d"
  37. 420 r=0:c=27:gosub240:printbk$rv$"name   score"of$
  38. 430 r=10:c=29:gosub240:printog$of$"messages":return
  39. 440 rem    ***print scores***
  40. 450 r=1:c=27:gosub240:fori=1tonp:syspd:printbk$pn$(i);:ex=0
  41. 460 ifi=pthenprintrd$aw$bk$;:ex=2
  42. 470 x$=str$(sc(i)):printspc(12-len(x$)-len(pn$(i))-ex)x$
  43. 480 nexti:return
  44. 490 rem  ***shuffle deck & deal***
  45. 500 r=7:c=9:gosub240:printbu$"shuffling"
  46. 510 fori=1to20:dk%(i)=i+9:nexti:n=20
  47. 520 fori=1to4:forj=1to5:x=int(rnd(1)*n)+1:pf%(i,j)=dk%(x)
  48. 530 ifx=nthendk%(n)=0:n=n-1:goto550
  49. 540 fork=xton-1:dk%(k)=dk%(k+1):nextk:dk%(n)=0:n=n-1
  50. 550 nextj,i:return
  51. 560 rem    ***print blank cards***
  52. 570 fori=1to4:forj=1to5:r=rl(i):c=cl(j):gosub240:printbc$;:nextj,i
  53. 580 return
  54. 590 rem ***get and check row letter***
  55. 600 getz$:z$=z$+chr$(0):rw=asc(z$)
  56. 602 if rw=140  then 2000
  57. 605 ifrw<65orrw>68then600
  58. 610 rw=rw-64:r=17:c=33:gosub240:printz$;:return
  59. 620 rem ***get & check column number***
  60. 630 getz$:z$=z$+chr$(0):cm=asc(z$)
  61. 632 if rw=140 then 2000
  62. 635 ifcm<49orcm>53then630
  63. 640 cm=cm-48:r=21:c=33:gosub240:printz$;:return
  64. 650 rem ***erase message area***
  65. 660 r=11:c=27:gosub240:fori=1to12:syspd:printem$;:nexti:return
  66. 670 rem  ***decode card and prepare***
  67. 680 rem ***card string for printing***
  68. 690 su%=pf%(rw,cm)/10:de%=pf%(rw,cm)-10*su%
  69. 700 ifde%=0thencd$=jr$:return
  70. 710 cd$=c1$+sc$(su%)+de$(de%)+c2$+sc$(su%)+ss$(su%)+c3$+sc$(su%)+de$(de%)+c4$
  71. 720 return
  72. 730 rem  ***erase score area***
  73. 740 r=1:c=27:gosub240:fori=1to6:syspd:printem$;:nexti:return
  74. 750 rem    ***erase card***
  75. 760 gosub240:printec$:fori=1to4:syspd:printec$;:nexti:return
  76. 770 rem     ***play game***
  77. 780 rem ***entry point for 1st game***
  78. 790 sp=1:rn=1:gn=1
  79. 800 rem ***entry point-other games***
  80. 810 p=sp:gosub360:gosub450:gosub500:gosub570:goto850
  81. 820 rem ***entry point during game***
  82. 830 pokebo,5:pokeba,13:gosub660:gosub740:gosub450
  83. 840 rem **entry & recording-1st card**
  84. 850 r=12:c=28:gosub240:printbu$m1$(1);
  85. 852 r=13:c=28:gosub240:printbu$"first card"
  86. 855 r=15:c=28:gosub240:printbu$m1$(2);
  87. 857 r=17:c=33:gosub240:printbu$"?";
  88. 860 r=19:c=27:gosub240:printbu$m1$(3);
  89. 862 r=21:c=33:gosub240:printbu$"?";
  90. 865 r=24:c=28:gosub240:printbu$m1$(4);
  91. 870 gosub600
  92. 880 gosub630:gosub660:r1=rw:c1=cm
  93. 890 rem ***check if card available***
  94. 900 ifpf%(rw,cm)<>0then950
  95. 910 r=12:c=27:gosub240:printrd$"card has":sysp2:print"been used":sysp2
  96. 920 print"try again"
  97. 930 tm=4:gosub260:gosub660:goto850
  98. 940 rem ***decode & print card***
  99. 950 gosub690:d1=de%:r=rl(rw):c=cl(cm):gosub240:printcd$
  100. 960 rem***get & record 2nd card***
  101. 970 r=12:c=28:gosub240:printbu$m1$(1);
  102. 972 r=13:c=28:gosub240:printbu$"second card"
  103. 975 r=15:c=28:gosub240:printbu$m1$(2);
  104. 977 r=17:c=33:gosub240:printbu$"?";
  105. 980 r=19:c=27:gosub240:printbu$m1$(3);
  106. 982 r=21:c=33:gosub240:printbu$"?";
  107. 985 r=24:c=28:gosub240:printbu$m1$(4);
  108. 990 gosub600
  109. 1000 gosub630:gosub660:r2=rw:c2=cm
  110. 1010 rem ***check if card available***
  111. 1020 ifpf%(rw,cm)=0then1040
  112. 1030 ifr1<>r2orc1<>c2then1080
  113. 1040 r=12:c=27:gosub240:printrd$"card has":sysp2:print"been used":sysp2
  114. 1050 print"try again"
  115. 1060 tm=4:gosub260:gosub 660:goto970
  116. 1070 rem ***decode & print card***
  117. 1080 gosub690:d2=de%:r=rl(rw):c=cl(cm):gosub240:printcd$
  118. 1090 rem   ***check for match***
  119. 1100 ifd1=0ord2=0ord1=d2then1210
  120. 1110 rem ***no match-reprint blank***
  121. 1120 rem ***cards after time loop***
  122. 1130 rem  ***go to next player***
  123. 1140 gosub260:r=rl(r1):c=cl(c1):gosub240:printbc$:r=rl(r2):c=cl(c2):gosub240
  124. 1150 printbc$
  125. 1160 p=fnp(p):r=12:c=27:gosub240:printrd$"no match":sysp2:print"next player
  126. 1170 tm[178]4:[141]260:[137]830
  127. 1180 [143] ***cards match-update score***
  128. 1190 [143]   ***erase matched cards***
  129. 1200 [143]  ***check for end of game***
  130. 1210 [139]d1[178]0[175]d2[178]0[167][129]i[178]1[164]4:[141]340:[130]i:sc(p)[178]sc(p)[170]4
  131. 1220 [141]340:pf%(r1,c1)[178]0:pf%(r2,c2)[178]0:nm[178]nm[170]1:sc(p)[178]sc(p)[170]1
  132. 1230 r[178]12:c[178]27:[141]240:[153]rd$"match-!!!":[158]p2
  133. 1240 [153]"you score"
  134. 1250 [139]nm[179]9[167][158]p2:[153]"play again":[137]1270
  135. 1260 [158]p2:[153]bn$"end of":[158]p2:[153]"this game"
  136. 1270 tm[178]4:[141]260:[139]nm[178]9[167]1320
  137. 1280 r[178]rl(r1):c[178]cl(c1):[141]760:r[178]rl(r2):c[178]cl(c2):[141]760:[141]450
  138. 1290 [137]830
  139. 1300 [143] ***print game & cumulative***
  140. 1310 [143]       ***scores***
  141. 1320 [153]cs$:[151]bo,0:[151]ba,0:r[178]3:c[178]11:[141]240:[153]lr$rv$"round"of$;rn;
  142. 1330 [153][163]23)rv$"game"of$;gn
  143. 1340 r[178]6:c[178]20:[141]240:[153]lg$"this   total"
  144. 1350 r[178]7:c[178]8:[141]240:[153]"player      hand   score"
  145. 1360 [158]pd:[153]lb$;:[129]i[178]1[164]24:[153]bm$;:[130]i:[153]yw$
  146. 1370 [129]i[178]1[164]np:cs(i)[178]cs(i)[170]sc(i):[130]i
  147. 1380 [129]i[178]1[164]np:[158]pd:[153]pn$(i);:l[178][195]([196](sc(i))):[153][163]24[171]l)[196](sc(i));
  148. 1390 l[178][195]([196](cs(i))):[153][163]32[171]l)[196](cs(i)):[130]i
  149. 1400 [143] ***update starting player,***
  150. 1410 [143] ***round & game numbers***
  151. 1420 sp[178][165]p(sp):[139]sp[178]1[167]rn[178]rn[170]1:gn[178]0
  152. 1430 gn[178]gn[170]1
  153. 1440 [143] ***another game or round?***
  154. 1450 r[178]17:c[178]8:[141]240:[153]wh$"another ";
  155. 1460 [139]sp[178]1[167][153]"round? (y/n)":[137]1480
  156. 1470 [153]"game? (y/n)"
  157. 1480 [161]z$:[139]z$[178]""[176](z$[179][177]"y"[175]z$[179][177]"n")[167]1480
  158. 1490 [139]z$[178]"n"[167][151]bo,5:[151]ba,13:[151]pt,1:[137]2000
  159. 1500 [129]i[178]1[164]6:sc(i)[178]0:[130]i:nm[178]0:[153]cs$:[151]ba,13:[151]bo,5:[137]810
  160. 1510 [143]***print opening screen***
  161. 1520 [153]cs$:[151]bo,0:[151]ba,0:r[178]9:c[178]15:[141]240:[153]lg$"welcome to"
  162. 1530 r[178]11:c[178]13:[141]240:[153]lr$rv$"concentration"of$
  163. 1540 r[178]13:c[178]9:[141]240:[153]lb$"(c)1987 by jim speers."
  164. 1545 r[178]15:c[178]1:[141]240:[153]lb$"published by softdisk publishing, inc."
  165. 1550 r[178]11:c[178]13:[141]240:[129]i[178]1[164]5:[158]pr:[153]lr$"concentration":tm[178].5:[141]260
  166. 1560 [158]pr:[153]rv$"concentration"of$:tm[178].5:[141]260:[130]i
  167. 1570 r[178]17:c[178]10:[141]240:[153]wh$ak$:[141]310:
  168. 1580 [158]pr:[153]bl$:r[178]17:c[178]9:[141]240:[153]"one moment, please...."
  169. 1590 [137]1620
  170. 1600 [143]  ***initialize variables***
  171. 1610 [143] *graphic & control characters*
  172. 1620 rd$[178][199](28):sc$(1)[178]rd$:bk$[178][199](144):sc$(2)[178]bk$:bu$[178][199](31)
  173. 1630 bn$[178][199](149):og$[178][199](129):gn$[178][199](30):lj$[178][199](179):rj$[178][199](171)
  174. 1640 tm$[178][199](164):lm$[178][199](167):rm$[178][199](165):bm$[178][199](163):cb$[178][199](166)
  175. 1650 cm$[178][199](191):ey$[178][199](119)
  176. 1660 ns$[178][199](113):mr$[178][199](106):mm$[178][199](96):ml$[178][199](107):ss$(1)[178][199](115)
  177. 1670 ss$(2)[178][199](97):aw$[178][199](95)[170]mm$
  178. 1680 [143] ***character sub-strings***
  179. 1690 dn$[178][199](17):rt$[178][199](29):lf$[178][199](157):nl$[178]lf$[170]lf$[170]lf$[170