home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disc 45 / Commodore_Disc_45_19xx_-_de.d64 / kalah (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  295 lines
  1. 10 rem kalah ===================c64
  2. 20 rem (p) commodore disc
  3. 30 rem ============================
  4. 40 rem (c) r. rudert
  5. 50 rem
  6. 60 rem
  7. 70 rem basic 2.0
  8. 80 rem c64
  9. 90 rem ============================
  10. 100 rem version 2.1.87
  11. 110 dim fr(13,2),f(5,2,7)
  12. 120 sg=0:cl$=chr$(147)
  13. 130 rf=15:bf=13:poke 53280,rf:poke 53281,bf:c=0:poke 646,c
  14. 140 gosub 2090:rem menue
  15. 150 gosub 1540:rem initialisierung
  16. 160 rem ***************************
  17. 170 if s1=1 and r=-1 or s2=1 and r=1 then gosub 1400:rem zugeingabe
  18. 180 if s1=-1 and r=-1 or s2=-1 and r=1 then gosub 870:rem computerzug
  19. 190 if sg=1 then gosub 2570:goto 120
  20. 200 r=-r:goto 170
  21. 210 end
  22. 220 rem**************************
  23. 230 rem proc:kopieren spielfeld
  24. 240 rem auf hoehere ebene +
  25. 250 rem zuguntersuchung
  26. 260 t1=t-1:for i=1 to 7:f(t,0,i)=f(t1,0,i):f(t,2,i)=f(t1,2,i):next
  27. 270 rem**************************
  28. 280 z2=0:rp=1+r:rm=1-r
  29. 290 fd=f(t,rp,z):f(t,rp,z)=0
  30. 300 ie=7:if fd<7-z then ie=z+fd:fd=0:goto 320
  31. 310 fd=fd-7+z
  32. 320 for z=z+1 to ie
  33. 330 f(t,rp,z)=f(t,rp,z)+1:next
  34. 340 if f(t,rp,7)>=z6 then d(t)=999:return
  35. 350 if fd<1 and z<>8 then 460
  36. 360 z2=1:ie=6:if fd<6 then ie=fd:fd=0:goto 380
  37. 370 fd=fd-6
  38. 380 for z=1 to ie
  39. 390 f(t,rm,z)=f(t,rm,z)+1:next
  40. 400 if fd>0 then z=0:goto 300
  41. 410 if f(t,rm,z-1)<>2 and f(t,rm,z-1)<>3 then 470
  42. 420 f(t,rp,7)=f(t,rp,7)+f(t,rm,z-1):f(t,rm,z-1)=0
  43. 430 if f(t,rp,7)>=z6 then d(t)=999:return
  44. 440 z=z-1:if z>0 goto 410
  45. 450 goto 470
  46. 460 if z2=1 and f(t,rp,z-1)>0 then z=z-1:z2=0:goto 290
  47. 470 su=0:for i=1 to 6:su=su+f(t,rp,i):if su<>0 then 520
  48. 480 next
  49. 490 su=0:for i=1 to 6:su=su+f(t,rm,i):f(t,rm,i)=0
  50. 500 next
  51. 510 f(t,rp,7)=f(t,rp,7)+su:if f(t,rp,7)>=z6 then d(t)=999:return
  52. 520 d(t)=f(t,rp,7)-f(t,rm,7):return
  53. 530 rem***************************
  54. 540 rem proc:zugdurchfuehrung
  55. 550 z2=0:rp=1+r:rm=1-r
  56. 560 fd=f(0,rp,z):f(0,rp,z)=0:o=r:gosub 2360
  57. 570 ie=7:if fd<7-z then ie=z+fd:fd=0:goto 590
  58. 580 fd=fd-7+z
  59. 590 for z=z+1 to ie
  60. 600 f(0,rp,z)=f(0,rp,z)+1:o=r:gosub 2360:next
  61. 610 if f(0,rp,7)>=z6 then sg=1
  62. 620 if fd<1 and z<>8 then 750
  63. 630 if fd<1 then 760
  64. 640 z2=1:ie=6:if fd<6 then ie=fd:fd=0:goto 660
  65. 650 fd=fd-6
  66. 660 for z=1 to ie
  67. 670 f(0,rm,z)=f(0,rm,z)+1:o=-r:gosub 2360:next
  68. 680 if fd>0 then z=0:goto 570
  69. 690 if f(0,rm,z-1)<>2 and f(0,rm,z-1)<>3 then 760
  70. 700 f(0,rp,7)=f(0,rp,7)+f(0,rm,z-1):i=z:z=7:o=r:gosub 2360:z=i
  71. 710 if f(0,rp,7)>=z6 then sg=1
  72. 720 z=z-1:f(0,rm,z)=0:o=-r:gosub 2360:z=z+1
  73. 730 z=z-1:if z>0 goto 690
  74. 740 return
  75. 750 if z2=1 and f(0,rp,z-1)>0 then z=z-1:z2=0:goto 560
  76. 760 su=0:for i=1 to 6:su=su+f(0,rp,i):if su<>0 goto 800
  77. 770 next
  78. 780 su=0:for z=1 to 6:su=su+f(0,rm,z):f(0,rm,z)=0:o=-r:gosub 2360:next
  79. 790 goto 830
  80. 800 su=0:for i=1 to 6:su=su+f(0,rm,i):if su<>0 goto 840
  81. 810 next
  82. 820 sg=1:return
  83. 830 f(0,rp,7)=f(0,rp,7)+su:z=7:o=r:gosub 2360:sg=1
  84. 840 return
  85. 850 rem**************************
  86. 860 rem proc:computerzug
  87. 870 if sd>0 goto 910
  88. 880 z=int(rnd(1)*6+1)
  89. 890 if f(t,1+r,z)=0 goto 880
  90. 900 zm=z:goto 1340
  91. 910 t=1:d(0)=-999
  92. 920 for i1=1 to 6
  93. 930 :if f(0,1+r,i1)=0 goto 1330
  94. 940 :z=i1:gosub 260
  95. 950 :if sd=1 goto 1310
  96. 960 :t=2:r=-r:d(1)=-999
  97. 970 for i2=1 to 6
  98. 980 :if f(1,1+r,i2)=0 goto 1290
  99. 990 :z=i2:gosub 260
  100. 1000 :if sd=2 goto 1270
  101. 1010 :t=3:r=-r:d(2)=-999
  102. 1020 for i3=1 to 6
  103. 1030 :if f(2,1+r,i3)=0 goto 1250
  104. 1040 :z=i3:gosub 260
  105. 1050 :if sd=3 goto 1230
  106. 1060 :t=4:r=-r:d(3)=-999
  107. 1070 for i4=1 to 6
  108. 1080 :if f(3,1+r,i4)=0 goto 1210
  109. 1090 :z=i4:gosub 260
  110. 1100 :if sd=4 goto 1190
  111. 1110 :t=5:r=-r:d(4)=-999
  112. 1120 for i5=1 to 6
  113. 1130 :if f(4,1+r,i5)=0 goto 1170
  114. 1140 :z=i5:gosub 260
  115. 1150 :if -d(5)>d(4) then d(4)=d(5)
  116. 1160 :if d(5)>-d(3) then i5=6
  117. 1170 next
  118. 1180 :t=4:r=-r:d(4)=-d(4)
  119. 1190 :if d(4)>d(3) then d(3)=d(4)
  120. 1200 :if d(4)>-d(2) then i4=6
  121. 1210 next
  122. 1220 :t=3:r=-r:d(3)=-d(3)
  123. 1230 :if d(3)>d(2) then d(2)=d(3)
  124. 1240 :if d(3)>-d(1) then i3=6
  125. 1250 next
  126. 1260 :t=2:r=-r:d(2)=-d(2)
  127. 1270 :if d(2)>d(1) then d(1)=d(2)
  128. 1280 :if d(2)>-d(0) then i2=6
  129. 1290 next
  130. 1300 :t=1:r=-r:d(1)=-d(1)
  131. 1310 :if d(1)>d(0) then d(0)=d(1):zm=i1
  132. 1320 :if d(1)=d(0) and int(i1*rnd(1))>3 then d(0)=d(1):zm=i1
  133. 1330 next:t=0
  134. 1340 x=1968+r*15:poke x,zm+3+r*3:for i=x-9tox-2:pokei,peek(i)-128:next
  135. 1350 z=zm:gosub 550
  136. 1360 x=x-r*30:poke x,32:for i=x-9tox-2:pokei,peek(i)+128:next:get k$
  137. 1370 return
  138. 1380 rem**************************
  139. 1390 rem proc:zugeingabe
  140. 1400 ih=1:gosub 2700
  141. 1410 get iz$:if len(iz$)=0 goto 1410
  142. 1420 z=asc(iz$)-64
  143. 1430 if z<4+3*r goto 1400
  144. 1440 if z>68 and z<73 then gosub 2790:goto 1400
  145. 1450 if z>9+3*r goto 1400
  146. 1460 if r>0 then z=z-6
  147. 1470 if f(0,1+r,z)=0 goto 1400
  148. 1480 x=1968+r*15:poke x,asc(iz$)-64:for i=x-9tox-2:pokei,peek(i)-128:next
  149. 1490 gosub 550
  150. 1500 x=x-r*30:poke x,32:for i=x-9tox-2:pokei,peek(i)+128:next
  151. 1510 return
  152. 1520 rem**************************
  153. 1530 rem proc:initialisierung
  154. 1540 a=53281:b=peek(646):c=peek(a):pokea,b:printcl$;:pokea,c
  155. 1550 for i=0 to 2 step 2:for j=1 to 6
  156. 1560 f(0,i,j)=z
  157. 1570 next:next
  158. 1580 z6=z*6:r=-1
  159. 1590 rem maschinenprogramm fuer farbwechsel
  160. 1600 for i=1 to 25:read x:poke 49151+i,x:next
  161. 1610 data 169,0,133,250,168,169,216,133
  162. 1620 data 251,162,4,173,134,2,145,250
  163. 1630 data 200,208,251,230,251,202,208
  164. 1640 data 246,96
  165. 1650 f(0,0,7)=0:f(0,2,7)=0
  166. 1660 for i=0 to 35 step 5
  167. 1670 poke 1064+i,236:poke 1068+i,116
  168. 1680 poke 1824+i,119:poke 1828+i,96
  169. 1690 for j=0 to 680 step 40
  170. 1700 poke 1104+i+j,97:poke 1108+i+j,116
  171. 1710 next
  172. 1720 for j=0 to 2
  173. 1730 poke 1065+j+i,226
  174. 1740 if i=0 or i=35 goto 1800
  175. 1750 poke 1425+j+i,119
  176. 1760 poke 1465+j+i,226
  177. 1770 poke 1464+i,236:poke 1468+i,116
  178. 1780 poke 1424+i,119:poke 1428+i,96
  179. 1790 poke 1866+i,i/5:poke 1026+i,13-i/5
  180. 1800 poke 1825+j+i,119
  181. 1810 next:next
  182. 1820 poke 1963,148
  183. 1830 poke 211,20:poke 214,23:sys 58640
  184. 1840 print right$(str$(sd),1)
  185. 1850 si=54272:fl=si:fh=si+1:w=si+4:a=si+5:h=si+6
  186. 1860 poke si+24,15:poke si+3,7
  187. 1870 rem frequenzen einlesen
  188. 1880 for i=1 to 13:read fr(i,1),fr(i,2):next
  189. 1890 data 8,180,9,196,10,247,11,158
  190. 1900 data 13,10,14,162,16,109,17,103
  191. 1910 data 19,137,21,237,23,59,26,20
  192. 1920 data 52,39
  193. 1930 for i=1 to 6
  194. 1940 :z=i
  195. 1950 :o=-1:gosub 2360
  196. 1960 :o=+1:gosub 2360
  197. 1970 next
  198. 1980 poke 211,0:poke 214,23:sys 58640
  199. 1990 printchr$(18);"spieler1";chr$(146);":"
  200. 2000 poke 211,30:poke 214,23:sys 58640
  201. 2010 print"spieler2:";
  202. 2020 if s1=-1 then poke 1988,131:goto 2040
  203. 2030 poke 1988,141
  204. 2040 if s2=-1 then poke 2018,131:goto 2060
  205. 2050 poke 2018,141
  206. 2060 return
  207. 2070 rem**************************
  208. 2080 rem proc:menue
  209. 2090 print cl$;spc(13);"k a h l a h"
  210. 2100 print:print:print
  211. 2110 print "zahl der steine pro feld (1..9)";
  212. 2120 get z$:if len(z$)=0 goto 2120
  213. 2130 z=asc(z$)-48
  214. 2140 if z<1 or z>9 goto 2120
  215. 2150 print z
  216. 2160 print:print "erster spieler (m.ensch/c.omputer) ";
  217. 2170 get s1$:if len(s1$)=0 goto 2170
  218. 2180 if s1$="m" then s1=1
  219. 2190 if s1$="c" then s1=-1
  220. 2200 if s1$<>"m" and s1$<>"c" goto 2170
  221. 2210 print s1$
  222. 2220 print:print "zweiter spieler (m.ensch/c.omputer) ";
  223. 2230 get s2$:if len(s2$)=0 goto 2230
  224. 2240 if s2$="m" then s2=1
  225. 2250 if s2$="c" then s2=-1
  226. 2260 if s2$<>"m" and s2$<>"c" goto 2230
  227. 2270 print s2$
  228. 2280 print:print"spielstaerke (0..5) ";
  229. 2290 get sd$:if len(sd$)=0 goto 2290
  230. 2300 if sd$<"0" or sd$>"5" goto 2290
  231. 2310 print sd$
  232. 2320 sd=asc(sd$)-48
  233. 2330 return
  234. 2340 rem**************************
  235. 2350 rem proc:neue stellung
  236. 2360 ih=z+3*(1+o)
  237. 2370 fz=int(f(0,1+o,z)/10)
  238. 2380 fe=f(0,1+o,z)-fz*10
  239. 2390 if o<0 then ia=z*5+1:ib=480:iu=800
  240. 2400 if o>0 then ia=36-z*5:ib=80:iu=400
  241. 2410 if z=7 then ib=80:iu=800:ih=13
  242. 2420 for j=1 to 24
  243. 2430 if fz=0 goto 2470
  244. 2440 poke 1024+ib+ia,81:fz=fz-1:ib=ib+40:ifib=iu thenib=280-o*200:ia=ia+1
  245. 2450 next
  246. 2460 for j=1 to 24
  247. 2470 if fe=0 goto 2500
  248. 2480 poke 1024+ib+ia,87:fe=fe-1:ib=ib+40:ifib=iu thenib=280-o*200:ia=ia+1
  249. 2490 next
  250. 2500 if ia=z*5+4 and o=-1 then gosub 2700:return
  251. 2510 if ia=39-z*5 and o=1 then gosub 2700:return
  252. 2520 sc=1024+ib+ia:if peek(sc)=32 then gosub 2700:return
  253. 2530 poke sc,32:ib=ib+40:if ib=iu then ib=280-o*200:ia=ia+1
  254. 2540 goto 2500
  255. 2550 rem**************************
  256. 2560 rem proc:gewinnnanzeige
  257. 2570 poke 211,15:poke 214,24:sys 58640
  258. 2580 print "spielende";chr$(145);
  259. 2590 ih=6:poke 53280,3:poke 53280,4
  260. 2600 get k$:if len(k$)=0 goto 2590
  261. 2610 x$="2":if f(0,0,7)>f(0,2,7) then x$="1"
  262. 2620 print cl$;"gewonnen hat spieler ";x$
  263. 2630 print:print "noch ein spiel? (j/n)";
  264. 2640 get k$:if k$="" then 2640
  265. 2650 if k$="n" then end
  266. 2660 if k$="j" then print k$:restore:return
  267. 2670 goto 2640
  268. 2680 rem*************************
  269. 2690 rem proc:signal
  270. 2700 poke a,16+5
  271. 2710 poke h,8*16
  272. 2720 poke fh,fr(ih,1):poke fl,fr(ih,2)
  273. 2730 poke w,33
  274. 2740 for j=1 to 100:next
  275. 2750 poke w,0:poke a,0:poke h,0
  276. 2760 return
  277. 2770 rem**************************
  278. 2780 rem proc:screenfarbe aendern
  279. 2790 on z-68 goto 2800,2820,2840,2850
  280. 2800 rf=rf+1:if rf>15 then rf=0
  281. 2810 poke 53280,rf:return
  282. 2820 bf=bf+1:if bf>15 then bf=0
  283. 2830 poke 53281,bf:return
  284. 2840 c=c+1:poke 646,c:sys 49152:return
  285. 2850 sd=sd+1:if sd=6 then sd=0
  286. 2860 poke 1964,sd+48
  287. 2870 return
  288. 2880 rem kalah ==================64
  289. 2890 rem 38911 bytes memory      ==
  290. 2900 rem 07601 bytes program     ==
  291. 2910 rem 01340 bytes variables   ==
  292. 2920 rem 00000 bytes strings     ==
  293. 2930 rem 29970 bytes free        ==
  294. 2940 rem ==========================
  295.