home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1987 November / 64er_Magazin_87-11_1987_Markt__Technik_de.d64 / b-mancala (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  297 lines
  1. 80 poke 53280,0
  2. 90 poke 53281,0
  3. 100 print"[147]":print"[158]"
  4. 102 poke 211,0:poke 214,5:sys 58732
  5. 104 print"        [213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  6. 110 print"        [221]  [213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]  [221]"
  7. 120 print"        [221]  [221] m a n c a l a [221]  [221]"
  8. 130 print"        [221]  [202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]  [221]"
  9. 150 print"        [171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"
  10. 152 print"        [221] programmiert von :  [221]"
  11. 160 print"        [221] benno     b o s e n [221]"
  12. 180 print"        [221] lenaustrasse 10     [221]"
  13. 190 print"        [221] 5216 niederkassel 2 [221]"
  14. 200 print"        [221] telefon  02208/5869 [221]"
  15. 210 print"        [202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]"
  16. 970 :
  17. 980 rem @ s1024
  18. 990 :
  19. 1000 rem num. variablen
  20. 1010 b=0:ba=0:bs=0:ea=0:eb=0:ee=0:f=0
  21. 1020 g=0:gz=0:h=0:i=0:j=0:l=0:m=0:n=0
  22. 1025 k=30000
  23. 1030 q=0:r=0:s=0:t=0:t0=0:ka=0:kd=0
  24. 1040 u=0:w=0:z=0:ze=0:zg=0:zx=0
  25. 1050 :
  26. 1100 rem strings
  27. 1110 g$="":r$=""
  28. 1130 d$="[221]    [221]    [221]    [221]    [221]    [221]    [221]"
  29. 1150 b$="                                       "
  30. 1200 :
  31. 1210 rem arrays
  32. 1220 dim a%(2,6,15),n%(10)
  33. 1970 goto 5900
  34. 1980 :
  35. 1990 rem setzen
  36. 2000 z=0
  37. 2010 u=0:b=a%(l,m,n):a%(l,m,n)=0
  38. 2020 if r=0 and n=6 then a%(l,m,13)=a%(l,m,13)+1:b=b-1
  39. 2030 if r=6 and n=12 then a%(l,m,14)=a%(l,m,14)+1:b=b-1
  40. 2040 if b=0 then 2100
  41. 2050 if n=6 or n=12 then u=u+1
  42. 2060 if n=12 then n=0
  43. 2070 n=n+1:a%(l,m,n)=a%(l,m,n)+1:b=b-1
  44. 2080 if b>0 then 2020
  45. 2100 if u=0 then 2190
  46. 2105 rem kette oder kapern ?
  47. 2110 if 10*u/2-int(u/2)*10=0 then z=z+1:n%(z)=n:goto 2010
  48. 2120 b=a%(l,m,n)
  49. 2130 if b<2 or b>3 then 2190
  50. 2140 z=z+1:n%(z)=n:a%(l,m,n)=0
  51. 2150 if n<7 then a%(l,m,14)=a%(l,m,14)+b:goto 2170
  52. 2160 a%(l,m,13)=a%(l,m,13)+b
  53. 2170 if n=1 or n=7 then 2190
  54. 2180 n=n-1:goto 2120
  55. 2190 ze=z:return
  56. 2480 :
  57. 2490 rem verzweigung
  58. 2500 for m=1 to 6
  59. 2510 : if a%(s,t,m+r)=0 then 2615
  60. 2520 : for n=0 to 14
  61. 2530 :  a%(l,m,n)=a%(s,t,n)
  62. 2540 : next n
  63. 2550 : n=m+r
  64. 2560 : gosub 2000
  65. 2562 if r=0 then ka=13:goto 2566
  66. 2564 ka=14
  67. 2566 kd=a%(l,m,ka)-a%(0,0,ka)
  68. 2568 : a%(l,m,15)=a%(l,m,13)-a%(l,m,14)+kd
  69. 2570 : gosub 3000
  70. 2580 : if ea=0 then 2600
  71. 2590 : if r=0 then a%(l,m,15)=60:ee=1:goto 2620
  72. 2595 : goto 2615
  73. 2600 : if eb=0 then 2630
  74. 2610 : if r=6 then a%(l,m,15)=-60:ee=1:goto 2620
  75. 2615 : a%(l,m,0)=0
  76. 2620 : ea=0:eb=0
  77. 2630 next m
  78. 2640 return
  79. 2980 :
  80. 2990 rem spielende ?
  81. 3000 if a%(l,m,13)=>6*ba then ea=1:goto 3100
  82. 3010 if a%(l,m,14)=>6*ba then eb=1:goto 3100
  83. 3030 bs=0
  84. 3040 for n=1 to 12
  85. 3050 : bs=a%(l,m,n)+bs
  86. 3060 : if n=6 and bs=0 then eb=1
  87. 3070 : if n=6 then bs=0
  88. 3080 : if n=12 and bs=0 then ea=1
  89. 3090 next n
  90. 3100 return
  91. 3480 :
  92. 3490 rem auswahl
  93. 3500 if r=0 then w=-60:goto 3520
  94. 3510 w=60
  95. 3520 for m=1 to 6
  96. 3530 : if a%(l,m,0)=0 then 3570
  97. 3540 : if r=0 and a%(l,m,15)<w then 3570
  98. 3550 : if r=6 and a%(l,m,15)>w then 3570
  99. 3560 : w=a%(l,m,15)
  100. 3570 next m
  101. 3580 z=0
  102. 3590 for m=1 to 6
  103. 3600 : if a%(l,m,0)=1 and a%(l,m,15)=w then z=z+1:n%(z)=m
  104. 3610 next m
  105. 3620 if z=1 then 3650
  106. 3640 ze=z:z=int(rnd(1)*ze)+1
  107. 3650 q=n%(z)
  108. 3660 return
  109. 3980 :
  110. 3990 rem ausgabe
  111. 4000 poke 211,7:poke 214,7:sys 58732:print d$;
  112. 4010 for n=1 to 6
  113. 4030 : poke 211,38-5*n:sys 58732:print a%(l,m,n);
  114. 4050 next n
  115. 4060 poke 211,3:sys 58732:print a%(l,m,13)
  116. 4090 poke 211,2:poke 214,15:sys 58732:print d$;
  117. 4100 for n=7 to 12
  118. 4120 : poke 211,5*(n-6)-2:sys 58732:print a%(l,m,n);
  119. 4140 next n
  120. 4150 poke 211,33:sys 58732:print a%(l,m,14)
  121. 4170 if ze=0 then 4290
  122. 4175 rem kennz.kette / kapern
  123. 4180 for z=1 to ze
  124. 4190 : if n%(z)>6 then 4240
  125. 4200 : poke 214,6:poke 211,40-5*n%(z):sys 58732:print"[215]";:goto 4280
  126. 4240 : poke 214,16:poke 211,5*(n%(z)-6):sys 58732:print"[215]";
  127. 4280 next z
  128. 4290 return
  129. 4480 :
  130. 4490 rem zuggenerator
  131. 4500 if r=6 then poke 211,0:poke 214,1:sys 58732:print b$
  132. 4510 if r=0 then poke 211,0:poke 214,21:sys 58732:print b$
  133. 4520 if r=0 then poke 211,0:poke 214,1:sys 58732:print"  a denkt";
  134. 4530 if r=6 then poke 211,0:poke 214,21:sys 58732:print"  b denkt";
  135. 4540 s=0:t=0:l=0:gz=1
  136. 4550 gosub 2500
  137. 4560 if gz=g or ee=1 or zg<2 then ee=0:goto 4760
  138. 4570 for t0=1 to 6
  139. 4580 : print t0;
  140. 4590 : if a%(s,t0,0)=0 then 4740
  141. 4600 : t=t0
  142. 4610 : gz=gz+1:l=1
  143. 4620 : if r=6 then r=0:goto 4640
  144. 4630 : r=6
  145. 4640 : gosub 2500
  146. 4650 : gosub 3500
  147. 4660 : if r=6 then r=0:goto 4680
  148. 4670 : r=6
  149. 4680 : if ee=1 then 4730
  150. 4690 : s=1:t=q:l=2
  151. 4700 : gosub 2500
  152. 4710 : gosub 3500
  153. 4720 : if gz<g and ee=0 then s=2:t=q:l=1:goto 4610
  154. 4730 : a%(0,t0,15)=w:s=0:gz=1:ee=0
  155. 4740 next t0
  156. 4750 l=0
  157. 4760 gosub 3500
  158. 4770 n=q+r:m=0
  159. 4780 print" und setzt !";
  160. 4790 poke 54290,21
  161. 4800 poke 54290,20
  162. 4810 return
  163. 4830 return
  164. 4980 :
  165. 4990 rem eingabe
  166. 5000 poke 211,0:poke 214,1:sys 58732
  167. 5010 if r=0 then print"      spieler a setzt !"
  168. 5020 if r=6 then print b$
  169. 5030 poke 211,0:poke 214,21:sys 58732
  170. 5040 if r=6 then print"      spieler b setzt !"
  171. 5050 if r=0 then print b$
  172. 5060 get g$:if g$=" "then 5060
  173. 5070 q=val(g$):if q<1 or q>6 then 5060
  174. 5075 poke 211,0:poke 214,23:sys 58732:print b$
  175. 5080 n=q+r:l=0:m=0
  176. 5090 if a%(l,m,n)>0 then 5190
  177. 5095 poke 54290,21
  178. 5100 poke 54290,20
  179. 5105 poke 211,3:poke 214,23:sys 58732
  180. 5110 print"feld ist null ! - neu setzen !"
  181. 5130 poke 54290,21
  182. 5140 poke 54290,20
  183. 5180 goto 5060
  184. 5190 return
  185. 5880 :
  186. 5890 rem vorprg
  187. 5900 poke 160,0:poke 161,0:poke 162,0
  188. 5910 f=ti+150
  189. 5920 if ti<f then 5920
  190. 5940 rem gong/stimme 3
  191. 5950 for j=24272 to 24296:poke k+j,0:next
  192. 5960 poke 54287,15
  193. 5970 poke 54291,48:poke 54292,140
  194. 5980 poke 54294,110:poke 54295,247
  195. 5990 poke 54296,31
  196. 6020 print"[147]"
  197. 6030 print" [213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  198. 6040 print" [171][192][192][192][192][192][201]          spieler a           [221]"
  199. 6050 print" [221]k    [171][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][201][221]"
  200. 6060 print" [221]a    [221]    [221]    [221]    [221]    [221]    [221]    [221][221]"
  201. 6070 print" [221]l    [221]    [221]    [221]    [221]    [221]    [221]    [221][221]"
  202. 6080 print" [221]a    [221]    [221]    [221]    [221]    [221]    [221]    [221][221]"
  203. 6090 print" [221]h   a  6    5    4    3    2    1  [182][146][221]"
  204. 6100 print" [171][192][192][192][192][192][203]   [213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]          [221]"
  205. 6110 print" [221]         [221] m a n c a l a [221]          [221]"
  206. 6120 print" [221]         [202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]    [213][192][192][192][192][192][179]"
  207. 6130 print" [221][181] 1    2    3    4    5    6   b[146]   k[221]"
  208. 6140 print" [221][221]    [221]    [221]    [221]    [221]    [221]    [221]    a[221]"
  209. 6150 print" [221][221]    [221]    [221]    [221]    [221]    [221]    [221]    l[221]"
  210. 6160 print" [221][221]    [221]    [221]    [221]    [221]    [221]    [221]    a[221]"
  211. 6170 print" [221][202][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][179]    h[221]"
  212. 6180 print" [221]           spieler b          [202][192][192][192][192][192][179]"
  213. 6190 print" [202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]"
  214. 6210 print"   grundwerte der felder (3-9):";
  215. 6220 get g$:if g$=" "then 6220
  216. 6225 ba=val(g$):if ba<3 or ba>9 then 6220
  217. 6230 print ba
  218. 6240 print"   anzahl spieler ? (0-2)";
  219. 6250 get g$:if g$="" then 6250
  220. 6255 i=val(g$):if i<0 or i>2 then 6250
  221. 6260 print i
  222. 6270 print"   wer beginnt (a/b) ?";
  223. 6280 get r$:if r$="a"or r$="b"then 6290
  224. 6285 goto 6280
  225. 6290 print"  ";r$
  226. 6300 if i=2 then 6350
  227. 6320 print"   spielstaerke zuggenerator (1-4):";
  228. 6330 get g$:if g$=" "then 6330
  229. 6340 g=val(g$):if g<1 or g>4 then 6330
  230. 6345 print g
  231. 6350 poke 211,4:poke 214,11:sys 58732:print"*";ba;"*"
  232. 6360 for n=1 to 12:a%(l,m,n)=ba:next n
  233. 6370 a%(l,m,0)=1
  234. 6380 for n=13 to 15:a%(l,m,n)=0:next n
  235. 6385 gosub 4000
  236. 6390 f=ti+120
  237. 6395 if ti<f then 6395
  238. 6400 poke 211,0:poke 214,20:sys 58732
  239. 6405 for zx=1 to 4:print b$:next
  240. 6410 if r$="b" then r=6
  241. 6415 if r$="a" then r=0
  242. 6480 :
  243. 6490 rem hauptprogramm
  244. 6500 if i=0 or(i=1 and r=0)then gosub 4500:goto 6540
  245. 6520 gosub 5000
  246. 6540 :  poke 211,7:poke 214,6:sys 58732:print d$
  247. 6550 poke 211,2:poke 214,16:sys 58732:print d$
  248. 6560 if r=0 then 6580
  249. 6570 poke 211,5*(n-6)-1:poke 214,16:sys 58732:print"[209]":goto 6585
  250. 6580 poke 211,39-5*n:poke 214,6:sys 58732:print"[209]"
  251. 6583 poke 160,0:poke 161,0:poke 162,0
  252. 6585 f=ti+90
  253. 6588 if ti<f then 6588
  254. 6590 zg=zg+1
  255. 6600 gosub 2000
  256. 6610 gosub 4000
  257. 6620 gosub 3000
  258. 6630 if ea=1 or eb=1 then 6660
  259. 6635 if r=6 then r=0:goto 6500
  260. 6640 r=6:goto 6500
  261. 6645 :
  262. 6650 rem ende
  263. 6660 poke 211,6:poke 214,20:sys 58732
  264. 6670 if ea=1 then print"spieler a hat"
  265. 6675 if eb=1 then print"spieler b hat"
  266. 6680 print"      nach";zg;"zuegen gewonnen !"
  267. 6685 for j=24272 to 24296:poke k+j,0:next j
  268. 6730 if eb=1 then 6790
  269. 6732 rem triller/st1
  270. 6735 poke 54278,240:poke 54296,15
  271. 6740 poke 54276,17
  272. 6745 for j=1 to 3
  273. 6750 h=1:f=ti
  274. 6755 poke 54273,h
  275. 6760 h=h+10
  276. 6765 if ti<f+h/2 then 6765
  277. 6770 if h<125 then 6755
  278. 6775 next j
  279. 6780 poke 54276,16
  280. 6785 goto 6855
  281. 6787 rem dreiklang
  282. 6790 poke 54272,103:poke 54273,17
  283. 6795 poke 54277,31:poke 54278,13:poke 54296,15
  284. 6800 poke 54276,17
  285. 6805 f=ti
  286. 6810 if ti<f+30 then 6810
  287. 6815 poke 54279,237:poke 54280,21
  288. 6820 poke 54284,31:poke 54285,13:poke 54283,17
  289. 6830 if ti<f+60 then 6830
  290. 6835 poke 54286,20:poke 54287,26
  291. 6840 poke 54291,31:poke 54292,13:poke 54290,17
  292. 6855 print"      neues spiel (j/n) ?"
  293. 6857 if ti<f+180 then poke 54276,16:poke 54283,16:poke 54290,16
  294. 6860 get g$:if g$=""then 6860
  295. 6870 if g$="j"then ea=0:eb=0:zg=0:ze=0:goto 5950
  296. 6880 print"[147]";:end
  297.