home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1984 December / 64er_Magazin_84-12_1984_Markt__Technik_de.d64 / 3d-viergewinnt (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  313 lines
  1. 10 rem        *******************
  2. 11 rem        *                 *
  3. 12 rem        * 3d-vier-gewinnt *
  4. 13 rem        *                 *
  5. 14 rem        *   (c) 1984 by   *
  6. 15 rem        *                 *
  7. 16 rem        *    uwe weiss    *
  8. 17 rem        *  loeskenweg 60  *
  9. 18 rem        *  4300  essen 1  *
  10. 19 rem        *                 *
  11. 20 rem        * tel 0201/326366 *
  12. 21 rem        *                 *
  13. 22 rem        *******************
  14. 23 :
  15. 24 :
  16. 25 :
  17. 26 :
  18. 27 :
  19. 28 :
  20. 29 :
  21. 30 :
  22. 100 gosub1500:rem initialisierung
  23. 110 zg=0:pl=3:gw=0
  24. 120 pl=5-pl:zg=zg+1
  25. 130 if(gw<>0)or(zg>64)then3500:rem spielende
  26. 140 printco$(pl):gosub3100
  27. 141 h=(20-len(sp$(pl)))/2:x0=1:y0=24
  28. 145 x$=left$(bl$,h)+sp$(pl)+left$(bl$,10):gosub3010:printchr$(19)
  29. 150 ifsp$(pl)="c 64"then500
  30. 160 rem *** spielerzug ***
  31. 170 x=0:y=0:a0=1575
  32. 180 a1=1575+2*x-80*y
  33. 200 pokea0,32:a0=a1
  34. 210 pokea1,160:pokea1+54272,co(pl)
  35. 220 j=peek(56320)and31
  36. 230 getk$:k=asc(k$+chr$(0))
  37. 235 if(k=0)and(j=31)then220
  38. 240 ifk=133then350:rem zugvorschlag
  39. 250 ifk=134then360:rem seitenwechsel
  40. 260 if(k=13)or((jand16)=0)then320
  41. 270 if(k=145)or((jand1)=0)thenify<3theny=y+1
  42. 280 if(k=17)or((jand2)=0)thenify>0theny=y-1
  43. 290 if(k=157)or((jand4)=0)thenifx>0thenx=x-1
  44. 300 if(k=29)or((jand8)=0)thenifx<3thenx=x+1
  45. 310 goto180
  46. 320 ifbe(x,y)=4then220
  47. 330 gosub2500:rem zug ausfuehren
  48. 340 goto120
  49. 350 pokea1,32:gosub2000:x=zx:y=zy:goto180
  50. 360 sp$=sp$(2):sp$(2)=sp$(3):sp$(3)=sp$:goto140
  51. 500 rem *** computerzug ***
  52. 510 gosub2000
  53. 520 x=zx:y=zy
  54. 530 ad=1575+2*x-80*y
  55. 540 pokead,160:pokead+54272,co(pl)
  56. 550 gosub2500:pokead,32
  57. 560 goto120
  58. 1500 ifru=1then1645
  59. 1505 ru=1
  60. 1510 dimfe(3,3,3),be(3,3),bw(3,3),w(3,3)
  61. 1511 dimrx(3,3),ry(3,3),rz(3,3),mx(15)
  62. 1512 dimux(3),uy(3),uz(3),ox(3),oy(3),oz(3)
  63. 1513 dimx$(3),w$(3),sp$(3),co$(3),cl$(3)
  64. 1514 dimx(3),y(3),z(3),ss(3),co(3)
  65. 1515 h0$=chr$(18)+"[169]"
  66. 1516 h1$=chr$(17)+chr$(157)
  67. 1517 h2$=h1$+chr$(157)+chr$(157)
  68. 1518 h3$=chr$(146)+"[169]"
  69. 1520 w$(0)=h0$+h1$+"[180]"+h1$+"[204][175]"+h3$
  70. 1525 w$(1)=h0$+h1$+" "+h1$+"  "+h3$
  71. 1530 w$(2)=h0$+"[180] "+h2$+"[180][204][175]"+h2$+"[204][175]"+h3$
  72. 1535 w$(3)=h0$+"[180] "+h2$+" [204][175]"+h2$+"  "+h3$
  73. 1536 x$(0)=w$(3)
  74. 1537 fori=1to3:x$(i)=w$(2):next
  75. 1539 printchr$(147):poke53280,0:poke53281,12
  76. 1540 printchr$(19)chr$(18)chr$(144);
  77. 1545 bl$="                                        "
  78. 1550 printleft$(bl$,12)"3d-vier-gewinnt"left$(bl$,13)
  79. 1555 print:print:print:print" bitte waehlen sie:"
  80. 1560 print:print" 1 = schwarzweissfernseher"
  81. 1565 print:print" 2 = farbfernseher"
  82. 1570 getk$:k=val(k$)
  83. 1575 onkgoto1585,1605
  84. 1580 goto1570
  85. 1585 co$(2)=chr$(5):co$(3)=chr$(144)
  86. 1590 cl$(2)=chr$(155):cl$(3)=chr$(151)
  87. 1595 co(2)=1:co(3)=0
  88. 1600 goto1620
  89. 1605 co$(2)=chr$(28):co$(3)=chr$(31)
  90. 1610 cl$(2)=chr$(150):cl$(3)=chr$(154)
  91. 1615 co(2)=2:co(3)=6
  92. 1620 sp$(2)="c 64":sp$(3)="c 64"
  93. 1625 s=54272:pokes+23,113:pokes+24,31
  94. 1630 pokes+2,0:pokes+3,8:pokes+4,0
  95. 1635 pokes+5,21:pokes+6,240
  96. 1640 goto1670
  97. 1645 sp$=sp$(2):sp$(2)=sp$(3):sp$(3)=sp$
  98. 1650 fori=0to3:forj=0to3
  99. 1655 be(i,j)=0
  100. 1660 fork=1to3:fe(i,j,k)=0
  101. 1665 nextk,j,i
  102. 1670 printchr$(147)chr$(18)chr$(144);
  103. 1675 print"f1:zugvorschlag";left$(bl$,9);"f3:seitenwechsel"
  104. 1680 printchr$(5)
  105. 1685 fori=1to4
  106. 1690 print:print:print
  107. 1695 print" [207][208]    [207][208]    [207][208]    [207][208]"
  108. 1700 print" [204][186]    [204][186]    [204][186]    [204][186]":next
  109. 1705 fori=2to3
  110. 1710 printchr$(19)
  111. 1715 printco$(i)"spieler";i-1;"  "sp$(i);bl$
  112. 1720 printchr$(145)chr$(145);spc(9)" ";
  113. 1725 inputsp$(i)
  114. 1730 ss(i)=1
  115. 1735 ifsp$(i)<>"c 64"then1755
  116. 1740 print"spielstaerke 1/2"
  117. 1745 getk$:ifk$="2"thenss(i)=2:goto1755
  118. 1750 ifk$<>"1"then1745
  119. 1755 printchr$(19)
  120. 1760 printleft$(bl$,30):printleft$(bl$,30)
  121. 1765 next
  122. 1770 fori=0to3:forj=0to3
  123. 1775 rx(i,j)=1/16:ry(i,j)=1/16:rz(i,j)=1/8:fe(i,j,0)=1
  124. 1780 next:next
  125. 1785 fori=0to3
  126. 1790 rx(i,0)=1:ry(i,0)=1
  127. 1795 ux(i)=1/8:uy(i)=1/8:uz(i)=1/16
  128. 1800 ox(i)=1/8:oy(i)=1/8:oz(i)=1/16
  129. 1805 next
  130. 1810 uz(0)=1:oz(0)=1
  131. 1815 d1=1/8:d2=d1:d3=d1:d4=d1
  132. 1820 return
  133. 2000 xx=0:gosub2200
  134. 2010 ifss(pl)=1then2100
  135. 2020 fori=0to3:forj=0to3
  136. 2030 w(i,j)=bw(i,j)
  137. 2040 next:next
  138. 2050 xx=1:gosub2200
  139. 2060 fori=0to3:forj=0to3
  140. 2070 bw=bw(i,j):bw(i,j)=w(i,j)
  141. 2080 if(w(i,j)<64)and(bw>0)thenbw(i,j)=bw(i,j)-bw/2
  142. 2090 next:next
  143. 2100 max=-5000:h=0
  144. 2110 fori=0to3:forj=0to3
  145. 2120 bw=bw(i,j)
  146. 2130 ifbw=maxthenmx(h)=10*i+j:h=h+1
  147. 2140 ifbw>maxthenh=1:mx(0)=10*i+j:max=bw
  148. 2150 next:next
  149. 2160 zz=int(rnd(0)*(h))
  150. 2170 zx=int(mx(zz)/10):zy=mx(zz)-zx*10
  151. 2180 return
  152. 2200 fory=0to3:forx=0to3:bw=0
  153. 2210 z=be(x,y)+xx:ad=1575+2*x-80*y:pokead,160:pokead+54272,co(pl)
  154. 2220 ifz>3thenbw=-10000:goto2350
  155. 2230 bw=bw+rx(y,z)+ry(x,z)+rz(x,y)
  156. 2240 ify=zthenbw=bw+ux(x)
  157. 2250 ifx=zthenbw=bw+uy(y)
  158. 2260 ifx=ythenbw=bw+uz(z)
  159. 2270 ify=3-zthenbw=bw+ox(x)
  160. 2280 ifx=3-zthenbw=bw+oy(y)
  161. 2290 ifx=3-ythenbw=bw+oz(z)
  162. 2300 if(x=y)and(x=z)thenbw=bw+d1
  163. 2310 if(x=3-y)and(x=z)thenbw=bw+d2
  164. 2320 if(x=y)and(x=3-z)thenbw=bw+d3
  165. 2330 if(y=z)and(x=3-z)thenbw=bw+d4
  166. 2340 h0=bw*1e4-int(bw*1e4)
  167. 2345 ifbw>64thenbw=64
  168. 2346 ifabs(h0-pl/10)<0.05thenbw=65
  169. 2350 bw(x,y)=bw
  170. 2360 pokead,32
  171. 2370 next:next
  172. 2380 return
  173. 2500 z=be(x,y):be(x,y)=z+1
  174. 2505 f=1114:d=3:gosub3800
  175. 2510 fe(x,y,z)=pl
  176. 2520 ifz<>3thenfe(x,y,z+1)=1
  177. 2530 printco$(pl):x$=x$(z):gosub3000
  178. 2540 h=1:q=0:fori=0to3
  179. 2541 h9=fe(i,y,z):x(i)=i:y(i)=y:z(i)=z
  180. 2542 gosub2800:next
  181. 2543 gosub2900:rx(y,z)=h
  182. 2550 h=1:q=0:fori=0to3
  183. 2551 h9=fe(x,i,z):x(i)=x:y(i)=i:z(i)=z
  184. 2552 gosub2800:next
  185. 2553 gosub2900:ry(x,z)=h
  186. 2560 h=1:q=0:fori=0to3
  187. 2561 h9=fe(x,y,i):x(i)=x:y(i)=y:z(i)=i
  188. 2562 gosub2800:next
  189. 2563 gosub2900:rz(x,y)=h
  190. 2570 ify<>zthen2580
  191. 2571 h=1:q=0:fori=0to3
  192. 2572 h9=fe(x,i,i):x(i)=x:y(i)=i:z(i)=i
  193. 2573 gosub2800:next
  194. 2574 gosub2900:ux(x)=h
  195. 2580 ifx<>zthen2590
  196. 2581 h=1:q=0:fori=0to3
  197. 2582 h9=fe(i,y,i):x(i)=i:y(i)=y:z(i)=i
  198. 2583 gosub2800:next
  199. 2584 gosub2900:uy(y)=h
  200. 2590 ifx<>ythen2600
  201. 2591 h=1:q=0:fori=0to3
  202. 2592 h9=fe(i,i,z):x(i)=i:y(i)=i:z(i)=z
  203. 2593 gosub2800:next
  204. 2594 gosub2900:uz(z)=h
  205. 2600 ify<>3-zthen2610
  206. 2601 h=1:q=0:fori=0to3
  207. 2602 h9=fe(x,i,3-i):x(i)=x:y(i)=i:z(i)=3-i
  208. 2603 gosub2800:next
  209. 2604 gosub2900:ox(x)=h
  210. 2610 ifx<>3-zthen2620
  211. 2611 h=1:q=0:fori=0to3
  212. 2612 h9=fe(i,y,3-i):x(i)=i:y(i)=y:z(i)=3-i
  213. 2613 gosub2800:next
  214. 2614 gosub2900:oy(y)=h
  215. 2620 ifx<>3-ythen2630
  216. 2621 h=1:q=0:fori=0to3
  217. 2622 h9=fe(i,3-i,z):x(i)=i:y(i)=3-i:z(i)=z
  218. 2623 gosub2800:next
  219. 2624 gosub2900:oz(z)=h
  220. 2630 if(x<>y)or(x<>z)then2640
  221. 2631 h=1:q=0:fori=0to3
  222. 2632 h9=fe(i,i,i):x(i)=i:y(i)=i:z(i)=i
  223. 2633 gosub2800:next
  224. 2634 gosub2900:d1=h
  225. 2640 if(x<>3-y)or(x<>z)then2650
  226. 2641 h=1:q=0:fori=0to3
  227. 2642 h9=fe(i,3-i,i):x(i)=i:y(i)=3-i:z(i)=i
  228. 2643 gosub2800:next
  229. 2644 gosub2900:d2=h
  230. 2650 if(x<>y)or(x<>3-z)then2660
  231. 2651 h=1:q=0:fori=0to3
  232. 2652 h9=fe(i,i,3-i):x(i)=i:y(i)=i:z(i)=3-i
  233. 2653 gosub2800:next
  234. 2654 gosub2900:d3=h
  235. 2660 if(y<>z)or(x<>3-z)then2670
  236. 2661 h=1:q=0:fori=0to3
  237. 2662 h9=fe(3-i,i,i):x(i)=3-i:y(i)=i:z(i)=i
  238. 2663 gosub2800:next
  239. 2664 gosub2900:d4=h
  240. 2670 z=z+1:ifz=4then2700
  241. 2680 rx(y,z)=rx(y,z)*2
  242. 2681 ry(x,z)=ry(x,z)*2
  243. 2682 ify=zthenux(x)=ux(x)*2
  244. 2683 ifx=zthenuy(y)=uy(y)*2
  245. 2684 ifx=ythenuz(z)=uz(z)*2
  246. 2685 ify=3-zthenox(x)=ox(x)*2
  247. 2686 ifx=3-zthenoy(y)=oy(y)*2
  248. 2687 ifx=3-ythenoz(z)=oz(z)*2
  249. 2688 if(x=y)and(x=z)thend1=2*d1
  250. 2689 if(x=3-y)and(x=z)thend2=2*d2
  251. 2690 if(x=y)and(x=3-z)thend3=2*d3
  252. 2691 if(y=z)and(x=3-z)thend4=2*d4
  253. 2700 return
  254. 2800 ifh9=0thenh=h/2:return
  255. 2810 ifh9=1thenreturn
  256. 2820 if(q<2)or(h9=q)thenh=h*4:q=h9:return
  257. 2830 h=0:return
  258. 2900 ifh=64thenh=h+pl/1e5
  259. 2910 ifh<>256thenreturn
  260. 2920 forj=0to3:gx(j)=x(j):gy(j)=y(j):gz(j)=z(j):next
  261. 2930 gw=pl:return
  262. 3000 x0=6*x+z+1:y0=20-5*y-z
  263. 3010 poke211,x0:poke214,y0:sys58732
  264. 3020 printx$;:return
  265. 3100 poke214,6:poke211,30:sys58732
  266. 3110 print"[176][192][178][192][178][192][178][192][174]"
  267. 3120 gosub3180:print"[221] [221] [221] [221] [221]"
  268. 3130 fori=1to3
  269. 3140 gosub3180:print"[171][192][219][192][219][192][219][192][179]"
  270. 3150 gosub3180:print"[221] [221] [221] [221] [221]":next
  271. 3160 gosub3180:print"[173][192][177][192][177][192][177][192][189]"
  272. 3170 return
  273. 3180 poke211,30:sys58732:return
  274. 3500 x$=chr$(144)+chr$(18)
  275. 3510 ifgw<>0then3540
  276. 3520 x$=x$+left$(bl$,13)+"unentschieden!"+left$(bl$,13)
  277. 3530 goto3580
  278. 3540 h$="sieger: "+sp$(gw):h=len(h$)
  279. 3550 ifh>40thenh$=left$(h$,40):h=40
  280. 3560 h=(40-h)/2
  281. 3570 x$=x$+left$(bl$,h)+h$+left$(bl$,h+.5)
  282. 3580 printchr$(19);x$:printchr$(19)
  283. 3590 f=4455:d=7:gosub3800
  284. 3591 f=5001:d=7:gosub3800
  285. 3592 f=5613:d=7:gosub3800
  286. 3593 f=5947:d=20:gosub3800
  287. 3594 f=4455:d=20:gosub3800
  288. 3595 f=5947:d=20:gosub3800
  289. 3596 f=4455:d=20:gosub3800
  290. 3597 f=5947:d=50:gosub3800
  291. 3600 ifgw<>0then3620
  292. 3610 poke198,0:wait198,1:poke198,0:goto100
  293. 3620 printco$(gw):gosub3750
  294. 3630 t=ti
  295. 3640 getk$:ifk$<>""then100
  296. 3650 ifti-t<30then3640
  297. 3660 printcl$(gw):gosub3750
  298. 3670 t=ti
  299. 3680 getk$:ifk$<>""then100
  300. 3690 ifti-t<30then3680
  301. 3700 goto3620
  302. 3750 fori=0to3
  303. 3760 x=gx(i):y=gy(i):z=gz(i):h=0
  304. 3770 ifz=0thenh=h+1
  305. 3780 ifz+1=be(x,y)thenh=h+2
  306. 3790 x$=w$(h):gosub3000
  307. 3795 next:return
  308. 3800 f0=int(f/256):poke54272,f-256*f0
  309. 3810 poke54273,f0:poke54276,65
  310. 3820 t=ti
  311. 3830 ifti-t<dthen3830
  312. 3840 poke54276,0:return
  313.