home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 226 / 226.d81 / acquire (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  23KB  |  786 lines
  1. 80 gosub18000:clr
  2. 90 rem acquire 38 1.8.85
  3. 95 x=rnd(-rnd(0))
  4. 100 dimt$(108),t1$(108),b$(13,10)
  5. 140 def fnz(x)=len(str$(x))-1
  6. 150 forq=1to7:readh$(q),bv(q),ct$(q),ce(q),pv(q),mn(q):hi$(q)=left$(h$(q),2)
  7. 155 sa(q)=25:next
  8. 160 tr=108:forq=1to108:readt1$(q):next
  9. 170 tg$="[213][192][192][192][201][157][157][157][157][157][221][221][157][157][157][157][157][202][192][192][192][203][145][157][157][157][157]":sp=1037:cz=54272:hw$="ltafwci":ha=7
  10. 175 og$="[176][192][174][157][157][157][221] [221][157][157][157][173][192][189][145][157][157]"
  11. 180 cd$=""
  12. 190 poke53281,1
  13. 195 input"[147][151]what is your name";nm$
  14. 197 x=(12-len(nm$))/2:forq=1tox:x$=x$+" ":next
  15. 200 p$(1)=x$+nm$
  16. 205 print"how many computer opponents[160]do you want,"
  17. 210 printnm$" (3 - 5)";:inputa
  18. 220 ifa<3ora>5thenprint"[145][145][145][145][145][145]":goto205
  19. 221 print"do you want to see other players':":
  20. 222 printtab(10)"share holdings";:inputa$
  21. 223 ifa$<>"n"thensk=1
  22. 224 printtab(11)"cash holdings";:inputa$
  23. 225 ifa$<>"n"thenck=1
  24. 226 printtab(13)"total worth";:inputa$
  25. 227 ifa$<>"n"thenvk=1
  26. 230 np=a+1
  27. 240 forq=1tonp:m(q)=6000:next
  28. 250 print"[151]o.k., "nm$", you are player no. 1"
  29. 260 gosub11110
  30. 300 rem board
  31. 310 print"[147]";:poke53281,0:poke53280,0
  32. 320 printtab(15)"[153]a b c d e f g h i j k l"
  33. 330 printtab(14)"[152][176][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][174]"
  34. 340 g1$="[152][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221]"
  35. 344 om(n3(1))=m(n3(1))+b1
  36. 350 g2$="[152][171][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][179]"
  37. 360 forq=1to8:printtab(13)"[153]"right$(str$(q),1);g1$:printtab(14)g2$:next
  38. 370 printtab(13)"[153]9"g1$
  39. 380 printtab(14)"[152][173][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][189]"
  40. 400 rem tile shuffling
  41. 410 print"please  wait":print" while  the "
  42. 420 print" tiles  are ":print"  shuffled  "
  43. 430 forq=1to108:t$(q)=t1$(q):next:forq=1to108
  44. 440 x=int(rnd(1)*108+1):t1$=t$(q)
  45. 450 t$(q)=t$(x):t$(x)=t1$
  46. 460 next
  47. 469 rem set share distrib factor
  48. 470 forq=1tonp
  49. 475 x=int(rnd(1)*3+1)
  50. 480 df(q)=x+2:next
  51. 490 gosub10100
  52. 500 rem draw first np tiles
  53. 510 print"players draw":print"for starting"
  54. 520 bt=21:forq=1tonp
  55. 530 print"[153]player"q:print" draws tile"
  56. 540 print""tg$"[153]"t$(q)
  57. 550 t$=t$(q):tr=tr-1:gosub11000
  58. 560 pokep,q+48:pokep+cz,1:p(q)=p
  59. 565 b$(v,h)="o"
  60. 570 ifv+h<btthenbt=v+h:bp=q
  61. 575 gosub11110
  62. 580 nextq
  63. 590 pokep(bp)+cz,14:print"  [154]player"bp:print"   starts":t=np+1:pl=bp
  64. 600 forq=1to3000:next
  65. 610 forq=1tonp:pokep(q),81:pokep(q)+cz,1:next
  66. 700 rem players draw tiles
  67. 710 gosub10100:print"players  now":print"draw 6 tiles":print"    each    "
  68. 712 print"            "
  69. 715 print"your  tiles,":print" money  and ":print" shares are ":print"shown  below"
  70. 720 forq=1tonp:forj=1to6
  71. 730 th$(q,j)=t$(t):t=t+1:tr=tr-1:next:next
  72. 740 gosub17000
  73. 760 ift>6*(np+1)+1goto980
  74. 780 gosub13200
  75. 790 gosub10000
  76. 980 gosub10100:poke1463,pl+48:poke55735,2:ifpl=1goto7000
  77. 990 print" "pl"'s turn"
  78. 995 gosub11110
  79. 1000 rem play
  80. 1010 q=0:im=0:pn(pl)=0:forj=1to7:im(j)=0:so(j)=0:next
  81. 1015 q=q+1:ifq=7goto1500
  82. 1017 ifth$(pl,q)=""goto1015
  83. 1020 lc(q)=0:pm=0:lc=0:h3=0:h4=0:t$=th$(pl,q):gosub11000:forj=1to3:pm(j)=0:next
  84. 1025 ut=0
  85. 1030 v(q)=v:h(q)=h:p(q)=p
  86. 1040 lr$=b$(v,h-1):iflr$=""goto1060
  87. 1050 gosub12000
  88. 1060 lr$=b$(v+1,h):iflr$=""goto1080
  89. 1070 gosub12000
  90. 1080 lr$=b$(v,h+1):iflr$=""goto1100
  91. 1090 gosub12000
  92. 1100 lr$=b$(v-1,h):iflr$=""goto1115
  93. 1110 gosub12000
  94. 1115 lc(q)=lc:ifpl=1goto7060
  95. 1120 iflc=0andpm=0thents(q)=5:goto1190
  96. 1130 iflc>0andpm=0thengosub12100
  97. 1131 rem 'o' link, no possible mergers - new hotel possibility
  98. 1135 ifts(q)=-5goto1015
  99. 1140 ifts(q)=7thenbt=q:bs=7:goto1540
  100. 1150 ifpm=>2thengosub12250
  101. 1155 ifut=1goto1200
  102. 1160 ifpm=1thengosub12500
  103. 1190 goto1015
  104. 1200 rem unplayable tile
  105. 1205 iftr<2thenth$(pl,q)="":ts(q)=-5:goto1015
  106. 1210 print"[153]i have to":print"change my"
  107. 1212 print"tile "th$(pl,q):print"(unplayable)"
  108. 1220 t=t+1:tr=tr-1:th$(pl,q)=t$(t):gosub11100:gosub10100:goto1020
  109. 1500 rem select comp's best
  110. 1510 bt=0:bs=-1:forq=1to6
  111. 1520 ifts(q)>bsthenbs=ts(q):bt=q
  112. 1530 next:ifbs>0goto1540
  113. 1533 print"[153] sorry!  no":print"playable":print"tiles.  turn"
  114. 1535 print" passes  to":print" purchases[146]":gosub11100:goto5000
  115. 1540 gosub13000 rem placing
  116. 1550 onbsgoto3200,3200,2400,2400,2800,3200,4200
  117. 2400 rem add tile
  118. 2410 e1=0:x=hh(bt):b$(v(bt),h(bt))=hi$(x)
  119. 2420 pokep(bt)+cz,ce(x):hs(x)=hs(x)+1
  120. 2430 ifhs(x)=41theneb=1:goto2440
  121. 2435 ifhs(x)=11thene1=1
  122. 2440 gosub11500:print""tab(mn(x))h$(x):print"chain grows":ifhs(x)<11goto2450
  123. 2445 ifsc(x)=0thensc(x)=1:print" and is now ":print" safe  from ":print"  takeover  "
  124. 2450 gosub11800:gosub11100
  125. 2460 ifeb=0orfb=1goto2500
  126. 2470 fb=1:gosub10100:gosub15750:goto5000
  127. 2500 ifes=0ande1=1thengosub15500
  128. 2510 ifes=0oret=1goto5000
  129. 2520 gosub10100:et=1:gosub15760:goto5000
  130. 2800 rem isolated tile
  131. 2810 b$(v(bt),h(bt))="o":goto5000
  132. 3200 rem merger
  133. 3210 pokep(bt),86:forq=1to1500:next:gosub10100
  134. 3220 forq=1to10:print"  merger!"
  135. 3230 forj=1to100:next
  136. 3240 print"  merger!":forj=1to100:next:next
  137. 3242 ifhs(mp(bt,1))<>hs(mp(bt,2))orpl>1goto3250
  138. 3245 gosub13500
  139. 3250 h1=mp(bt,1):h2=mp(bt,2):h3=mp(bt,3)
  140. 3255 print""tab(mn(h1))h$(h1):print"[155]takes over":printtab(mn(h2))h$(h2)
  141. 3260 ifh3>0thengosub10200
  142. 3262 b1=sv(h2)*10:b2=b1/2:rem boni
  143. 3265 print"[152]bonuses are":print"   $"b1:print" & $"b2:gosub10000
  144. 3270 gosub10100:print"shares held":print" in mergee"
  145. 3275 print"pl. "ct$(h2)"shs.":print"[163][163][163] "ct$(h2)"[163][163][163]"
  146. 3280 forq=1tonp:n1(q)=s(q,h2):next
  147. 3285 forq=1tonp
  148. 3290 n=n1(q)
  149. 3295 forj=1tonp
  150. 3300 ifn1(j)=>nthenn=n1(j):xx=j
  151. 3305 nextj:n2(q)=n:n1(xx)=0:n3(q)=xx
  152. 3310 ifn2(q)>0thenprint""n3(q)" "ct$(h2);n2(q)""
  153. 3315 nextq:print""
  154. 3340 ifn2(2)>0goto3370
  155. 3350 print"  player"n3(1):print"scoops pool!":print"gets $"b1+b2
  156. 3360 m(n3(1))=m(n3(1))+b1+b2:goto3500
  157. 3370 ifn2(1)<>n2(2)orn2(2)<>n2(3)goto3400
  158. 3375 nw=3:ifn2(3)=n2(4)thennw=4
  159. 3380 x=int((b1+b2)/nw):forq=1tonw:m(n3(q))=m(n3(q))+x:next
  160. 3385 printright$(str$(nw),1)"-way split!":print"  players"
  161. 3387 ifnw=4thenprintn3(1)"[157]"n3(2)"[157]"n3(3)"&"n3(4):goto3395
  162. 3390 print" "n3(1)n3(2)"&"n3(3)
  163. 3395 print" get $"x:print"    each":goto3500
  164. 3400 ifn2(1)<>n2(2)goto3440
  165. 3410 x=(b1+b2)/2:forq=1to2:m(n3(q))=m(n3(q))+x:next
  166. 3420 print" share-out!":print"  players":print" "n3(1)"&"n3(2)"get"
  167. 3430 print"$"x"each":goto3500
  168. 3440 m(n3(1))=m(n3(1))+b1
  169. 3450 print"  player"n3(1):print"gets $"b1
  170. 3460 ifn2(2)<>n2(3)goto3490
  171. 3465 nw=2:ifn2(3)=n2(4)thennw=3
  172. 3470 x=int(b2/nw):forq=2tonw+1:m(n3(q))=m(n3(q))+x:next
  173. 3475 print"  players":ifnw=3thenprintn3(2)"[157]"n3(3)"&"n3(4)"get":goto3485
  174. 3480 print" "n3(2)"&"n3(3)"get"
  175. 3485 print"$"x"each":goto3500
  176. 3490 m(n3(2))=m(n3(2))+b2
  177. 3495 print"  player"n3(2):print"gets $"b2
  178. 3500 gosub13200:gosub10000
  179. 3600 gosub10100:print"   merger":print" decisions:"
  180. 3605 hs(h1)=hs(h1)+hs(h2)+1:x=h1:gosub11800
  181. 3607 hs(h2)=0:hu(h2)=0:ha=ha+1:ifsa(h2)>0thensa=sa-1
  182. 3610 sc=0:forz=pltopl+np-1:ts=0:ns=0:ne=0:nk=0:n%=0
  183. 3620 q=z:ifq>npthenq=z-np
  184. 3625 ifs(q,h2)=0goto4055
  185. 3627 sc=sc+1:ifsc=4thensc=0:gosub10000:gosub10100:print""
  186. 3629 rem selling
  187. 3630 m=m(q):n=0:ss=s(q,h2):print"  player"q"[157] "
  188. 3635 ifq=1thenprint"press a key[146]":gosub10000:goto7100
  189. 3637 br$="[157][157][157]( ":ifss>9thenbr$="[157][157][157][157]( "
  190. 3638 print" "ss;br$;"shares)":ifsa=0goto3739
  191. 3640 forj=1to7:ifhu(j)=0orsa(j)=0goto3660
  192. 3650 n=n+sv(j)
  193. 3660 nextj:av=n*3/sa
  194. 3670 ifav<=mgoto3739:rem test money
  195. 3690 ns=ns+1:ifm+ns*sv(h2)<avgoto3690
  196. 3700 ifns=>s(q,h2)thenns=s(q,h2)
  197. 3710 s(q,h2)=s(q,h2)-ns:sa(h2)=sa(h2)+ns:m(q)=m+sv(h2)*ns
  198. 3720 ifs(q,h2)=0ors(q,h2)-nk=0goto3980
  199. 3739 rem changing
  200. 3750 ifq=1goto3820
  201. 3755 ifsa(h1)=0ors(q,h2)=1goto3900
  202. 3760 ifhs(h1)<11orsv(h1)-sv(h2)=>300goto3799
  203. 3770 ifs(q,h1)=>14-npors(q,h1)<(25-sa(h1))/np-4goto3900
  204. 3799 rem exchange
  205. 3800 ne=int(s(q,h2)/2)
  206. 3810 ifsa(h1)<nethenne=ne-1:goto3810
  207. 3820 s(q,h2)=s(q