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