home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1988 February / 1988-02.d64 / mosaic (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  140 lines
  1. 10 rem copyright 1988 compute! publ., inc. - all rights reserved
  2. 20 dimr,p,n,h,l,t,x,y,a,b,c,n$(4):s=53248:pokes+21,0:pokes+32,6:pokes+24,21
  3. 30 x$="[214][206][205][206][214][205][206][205][218][206][205]":forr=1to4:x$=x$+x$:readn$(r):next:f=256:co=7:gosub1210
  4. 40 ln=214:ys=679:dimh(11,2),b(11,2),p(2),c(2)
  5. 50 rem*** enter ml data ***
  6. 60 forr=ystor+25:readp:poker,p:t=t+p:next
  7. 70 forp=0to2:b(0,p)=1:b(11,p)=1:h(11,p)=65:next:w=828:r=rnd(-rnd(-ti))
  8. 80 deffnv(t)=int((t-h(l,p))/(h(h,p)-h(l,p))*(h-l-1)+l+1)
  9. 90 deffnl(p)=(p+(p=0)or(p>pn))*6+11-2*pn:deffnp(p)=(2=porporgnand1)-1
  10. 100 rem *** clear cassette buffer ***
  11. 110 poke1023,0:poke781,1:poke782,191:poke91,3
  12. 120 poke90,65:poke89,3:poke88,64:sys41964
  13. 130 rem *** draw sprite ***
  14. 140 forr=832tor+35step6:readx,y:forp=rtor+3step3:pokep,x:pokep+1,y:nextp,r
  15. 150 pokes+23,10:pokes+28,10:pokes+29,10:pokes+37,8:pokes+38,0:pokes+39,7
  16. 160 pokes+40,2:pokes+41,7:pokes+42,2:pokes+4,174:pokes+6,174
  17. 170 poke2040,14:poke2041,13:poke2042,15:poke2043,13
  18. 180 rem *** number tiles ***
  19. 190 forr=1to64:dk$=dk$+chr$(r):next
  20. 200 rem *** get selection from menu ***
  21. 210 poke198,0
  22. 220 getd$:ifd$=""then220
  23. 230 ifd$="[136]"thenco=7-co:gosub1260:goto210
  24. 240 ifd$=chr$(13)thend$="4":goto270
  25. 250 ifd$="0"thenifgmthen300
  26. 260 ifd$<"1"ord$>"4"then210
  27. 270 g=0:gm=0:gn=val(d$):pn=1-(gn>2):n$(0)=n$(abs(gn-2)+2)
  28. 280 m=146-16*pn:pokes+5,m+5:pokes+7,m+5:forr=0topn:p(r)=0:next
  29. 290 rem *** deal hands ***
  30. 300 gosub1340:d=64:forp=0topn:pokeln,fnl(p):print
  31. 310 print"[145][154]"n$(p)tab(80-len(str$(p(p))));mid$(str$(p(p)),2):forr=1to10
  32. 320 gosub1030:h(r,p)=t:b(r,p)=0:print"[129][146][161][158]";:iffnp(p)thenpoke646,co
  33. 330 printright$(str$(t),2)"[161][157][157][157][157][129][187][146][162][162][172][145][145][157][157][157][157][129][190][162][162][188]";:nextr,p:hm=11:p=g
  34. 340 gosub1020:gosub1310:gosub1170:forp=0topnstep2:l=0:h=11:gosub1060:next:p=g
  35. 350 rem *** main loop ***
  36. 360 p=-(p+1)*(p<pn):iffnp(p)then460
  37. 370 rem *** get player's move ***
  38. 380 poke198,0
  39. 390 getd$:if(d$<"0"ord$>"9")andd$<>" "then390
  40. 400 ifd$<>" "then430
  41. 410 gosub1020:gosub1160:poke198,0
  42. 420 getd$:if(d$<"0"ord$>"9")andd$<>" "then420
  43. 430 gosub1330:ifd$=" "thenpokes+21,3:gosub1310:goto360
  44. 440 n=val(d$)-10*(d$="0"):print"[158]":goto510
  45. 450 rem *** get computer's move ***
  46. 460 gosub740:ifb(n,p)-1orethen490
  47. 470 gosub1020:gosub1160:gosub740:ifb(n,p)-1orethen490
  48. 480 r=(n=l)-(n=h):ifrthenifabs(t-h(n,p))<abs(t-h(n-r,p))thenn=n+r:e=1
  49. 490 gosub1330
  50. 500 rem *** make play on screen ***
  51. 510 pokes+21,3:i=n-5.5:sn=-1.5*(sgn(p-.5)-(p=2)):x=168:fory=mtoy-sn*32step-sn
  52. 520 pokew,x:pokew+1,y:sysys:x=x+i:ifx>=fthenx=x-f:pokew+2,3
  53. 530 next:pokeln,fnl(p):iffnp(p)thenpoke646,co
  54. 540 print:printtab(4*n+37)right$(str$(t),2):r=h(n,p):h(n,p)=t:t=r
  55. 550 forr=1to9:ifh(r,p)<h(r+1,p)thennext
  56. 560 c(p)=r:on11-rgoto610:gosub1310:gosub1110:poke198,0:x=x-i:fory=y+sntomstepsn
  57. 570 pokew,x:pokew+1,y:sysys:x=x-i:ifx<0thenx=x+f:pokew+2,0
  58. 580 next:iffnp(p)thenife+b(n,p)=0thenb(n,p)=1:hm=h:h=n:gosub1060
  59. 590 e=0:goto360
  60. 600 rem *** win routine ***
  61. 610 pokeln,fnl(0)+4:print:printtab(8)""n$(p)"winsround";mid$(str$(gm+1),2);
  62. 620 print"![158]":pokes+21,0:forr=0topn:print,""right$(""+n$(r),11)":";
  63. 630 printright$(str$(c(r)*5),2):next:gm=gm+1:g=g+1:ifg>pntheng=0
  64. 640 poke646,14:forr=0topn:y=0:d=7:ifp=rthend=1
  65. 650 forx=55377+fnl(r)*40tox+39step4:y=y+1:ify>c(r)thend=11
  66. 660 pokex,d:pokex+1,d:nextx:p(r)=p(r)+c(r)*5
  67. 670 pokeln,fnl(r):print:print"[145]"spc(40-len(str$(p(r))))mid$(str$(p(r)),2):nextr
  68. 680 pokeln,fnl(1)+4:print:printtab(6)"[159]pressanykey;[f1]formenu":pokew+2,3
  69. 690 poke198,0
  70. 700 getd$:ifd$=""then700
  71. 710 ifd$="[133]"thengosub1210:goto210
  72. 720 goto300
  73. 730 rem *** sbr: choose best play ***
  74. 740 n=int(t/6.5+1):ifb(n,p)then920
  75. 750 forl=n-1to1step-1:ifb(l,p)-1thennext
  76. 760 ift<h(l,p)thenn=l:goto920
  77. 770 forh=n+1to10:ifb(h,p)-1thennext
  78. 780 ift>h(h,p)thenn=h:goto920
  79. 790 n=fnv(t):ifh-l<4ort-h(l,p)<6orh(h,p)-t<6thenreturn
  80. 800 b=0:y=l:hm=h:x=n:c=0
  81. 810 h=e+x:ifb(h,p)then870
  82. 820 a=h(h,p):ifc=0thenh(h,p)=t
  83. 830 b(h,p)=1:gosub1060:h=e+x:l=0
  84. 840 forr=y+1tohm-1:l=l+b(r,p):next:h(h,p)=a:a=b<l:ifathenb=l:n=h
  85. 850 forr=y+1tohm-1:ifathenb(r,1)=b(r,p)
  86. 860 b(r,p)=0:next:l=y
  87. 870 ife-1thene=(e=0)-e:goto810
  88. 880 ifcorh(n,p)<h(y,p)orh(n,p)>h(hm,p)then910
  89. 890 ifh(n,p)-h(y,p)<4*(n-y-1)orh(hm,p)-h(n,p)<4*(hm-n-1)then910
  90. 900 ifabs(t-h(n,p))<(h(hm,p)-h(l,p))/(hm-l-1)thenc=b:x=n-1:h=n:b=b-1:goto820
  91. 910 forr=y+1tohm-1:b(r,p)=b(r,1):next:ifc=0orb<cthenreturn
  92. 920 e=0:forl=nto1step-1:ifb(l-1,p)thennext
  93. 930 forh=nto10:ifb(h+1,p)thennext
  94. 940 ift<h(l,p)thenn=l-1:goto750
  95. 950 ift>h(h,p)thenn=h+1:goto750
  96. 960 forn=ltoh:ift>h(n,p)thennext
  97. 970 ifl=0then990
  98. 980 n=n+(n-l<=h-norh>9):ifn=h=l-hthenn=n+(h(n-1,p)<h(n-2,p)andh(n-2,p)<t)
  99. 990 r=(n=l)-(n=h):ifrthenif(h(n,p)<h(n+r,p))=(h(n+r,p)<t)thenb(n,p)=0:goto750
  100. 1000 return
  101. 1010 rem *** sbr: draw next tile ***
  102. 1020 poke781,1:poke782,62:poke91,3:poke90,128:poke89,3:poke88,192:sys41964
  103. 1030 x=rnd(1)*d+1:dk$=left$(dk$,x-1)+mid$(dk$,x+1)+mid$(dk$,x,1)
  104. 1040 t=asc(right$(dk$,1)):d=d-1:return
  105. 1050 rem *** sbr: evaluate hand ***
  106. 1060 forr=l+1toh-1:iffnv(h(r,p))=rthenb(r,p)=1:onr-lgoto1080:h=r:goto1060
  107. 1070 next:ifr>=hmthenreturn
  108. 1080 forl=rtohm-2:ifb(l+1,p)thennext:return
  109. 1090 forr=l+1tohm-1:ifb(r,p)-1thennext
  110. 1100 h=r:goto1060
  111. 1110 rem *** sbr: change numbers in sprite ***
  112. 1120 a=s+8*asc(right$(str$(t),2)):b=s-a+8*(asc(right$(str$(t),1))):c=921
  113. 1130 poke56333,127:poke1,251:forr=atoa+7:pokec,peek(r)
  114. 1140 pokec+1,peek(r+b):c=c+3:next:poke1,255:poke56333,129:return
  115. 1150 rem *** sbr: move tile onto screen ***
  116. 1160 forr=1to10:pokew,r/2+168:pokew+1,r/2+m:sysys:next:pokes+21,12
  117. 1170 pokew+1,m:pokew,225:pokew+2,3:sysys:pokes+21,peek(s+21)or3
  118. 1180 poke198,0:gosub1110:a=244:forr=1to90:a=a+2:ifa=fthenpokew+2,0:a=0
  119. 1190 pokew,a:sysys:next:return
  120. 1200 rem *** sbr: print menu screen ***
  121. 1210 gosub1340:print""left$("[159][0]continuecurrentgame",sgn(gm)*30)
  122. 1220 print"[158][1]playervsplayer"
  123. 1230 print"[2]playervscomputer"
  124. 1240 print"[3]playervsplayervscomputer"
  125. 1250 print"[4]playervscomputervscomputer"
  126. 1260 print"":printtab(8)"[159]to"mid$("show   hide",co+1,4);
  127. 1270 print"computer'stiles,":printtab(7)"push[f7]beforeselection."
  128. 1280 printtab(3)"copyright1988compute!pub.,inc."
  129. 1290 printtab(10)"allrightsreserved[145]":return
  130. 1300 rem *** sbr: print guide ***
  131. 1310 pokeln,fnl(p+1)+1:print:print"[154][169]1[146]";
  132. 1320 print"[169][169]2[146][169][169]3[146][169][169]4[146][169][169]5  6[223][146][223]7[223][146][223]8[223][146][223]9[223][146][223]0[223][145]";:return
  133. 1330 print"[146]"mid$(x$,7*fnl(p)-4,40)"[158]";:return
  134. 1340 pokes+17,43:print"[147]"x$x$x$x$x$left$(x$,118)"[206][157][148][218][146]",
  135. 1350 print"[157]mosaic":pokes+33,0:pokes+17,27:return
  136. 1360 data"player1","computer1","player2","computer2"
  137. 1370 data173,17,208,16,251,160,2,185,59,3,153,255,207
  138. 1380 data153,1,208,136,208,244,173,62,3,141,16,208,96
  139. 1390 data21,88,95,250,127,254,127,254,95,250,26,168
  140.