home *** CD-ROM | disk | FTP | other *** search
/ Publication 16 / Publication_16_19xx_Civitas_de_Side_B.d64 / s-skat (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  27.8 KB  |  1,093 lines
  1. 100 poke 649,1
  2. 101 gosub20000:wait203,4:clr
  3. 102 poke 49990,0
  4. 103 for i=1to20
  5. 104 poke 49990+i,0
  6. 105 nexti
  7. 106 printchr$(8)
  8. 110 poke 53280,08:poke53281,08:print""
  9. 129 dim g1(2,3,4)
  10. 130 dim ku(3,10)
  11. 131 dim ko(3,4,11)
  12. 132 dim w(11)
  13. 133 dim we(2,4)
  14. 134 dim ge(32)
  15. 135 dim an(2,4)
  16. 136 dim kg(12,2)
  17. 137 dim ww(11)
  18. 138 dim ka$(11,10)
  19. 139 dim g2(2,4,11)
  20. 140 pa=2
  21. 141 dim g3(2,11)
  22. 142 dim g4(2,4)
  23. 143 dim at(2,11)
  24. 144 dim kd(3,4,11)
  25. 145 dim g5(2,5)
  26. 150 g=peek(49990)-int(peek(49990)/3)*3+1:g$=str$(g):g$="[144]"+right$(g$,len(g$)-1)
  27. 151 mm=14
  28. 152 fe=7
  29. 153 dim k(3):dimf(3)
  30. 154 dim sn(2):dimkn(2)
  31. 155 dim fb$(5):dim bh(3)
  32. 156 dim dr(2)
  33. 210 for i1=1to11
  34. 220 readw(i1):nexti1
  35. 230 data 0,0,0,0,10,8,4,3,1,1,1
  36. 240 for i=1to8:readww(i):nexti
  37. 250 data 2,2,2,2,11,10,4,3,0,0,0
  38. 255 for i1=1to2
  39. 260 fori=1to4
  40. 270 g3(i1,i)=7:g4(i1,i)=5:g5(i1,i)=11
  41. 271 g3(i1,0)=4
  42. 280 nexti,i1
  43. 285 fori1=1to2
  44. 290 g4(i1,0)=1:g5(i1,0)=4
  45. 295 nexti1
  46. 310 print"[147][145]spieler  01[146]                  spieler  02"
  47. 320 print"[144][213][192][192][192][192][192][192][192][201][176][192][192][192][192][192][192][192][192][192][192][192][192][174][144][213][192][192][192][192][192][192][192][201]"
  48. 330 print"[144][221]       [221][221]reizzahl:   [221]   [144][221]       [221]"
  49. 340 print"[221][221][171][192][192][192][192][192][192][192][192][192][192][192][192][179]   [144][221][221]"
  50. 360 print"[221][221][221]spieler:    [221]   [144][221][221]"
  51. 380 print"[221][221][171][192][192][192][192][192][192][192][192][192][192][192][192][179]   [144][221][221]"
  52. 390 print"[221][221][221]spiel:      [221]   [144][221][221]"
  53. 400 print"[221][221][221]            [221]   [144][221][221]"
  54. 401 print"[221][221][171][192][192][192][178][192][192][192][178][192][192][192][192][179]   [144][221][221]"
  55. 402 print"[221][221][221]g:"+g$+"[221]h: [221]s:  [221]   [144][221][221]"
  56. 420 print"[221][221][173][192][192][192][177][192][192][192][177][192][192][192][192][189]   [144][221][221]"
  57. 430 print"[202][192][192][192][192][192][192][192][203][202][192][192][192][192][192][192][192][203]"
  58. 440 print"   bieten = >leer<   aussteigen = >w<   "
  59. 445 au$="> moment! <":gosub2700
  60. 610 gosub2780
  61. 1010 for i1=1to4
  62. 1020 for i2=0to7
  63. 1030 l=l+1
  64. 1040 ge(l)=10*i1+i2
  65. 1050 nexti2
  66. 1060 nexti1
  67. 1105 for i=1to100
  68. 1110 z1=int(rnd(8)*32)+1
  69. 1120 z2=int(rnd(8)*32)+1
  70. 1130 zw=ge(z1):ge(z1)=ge(z2):ge(z2)=zw
  71. 1140 nexti
  72. 1200 :
  73. 1210 for i1=1to3
  74. 1220 for i2=1to10
  75. 1230 ku(i1,i2)=ge((i1-1)*10+i2)
  76. 1240 nexti2
  77. 1250 nexti1
  78. 1260 sk(1)=ge(31):sk(2)=ge(32)
  79. 1269 gosub1300:gosub1780:gosub1797:gosub1500:gosub2550
  80. 1270 gosub1700:gosub1807:ifnq=1thengosub2900:gosub3286:gosub3200:goto1278
  81. 1271 gosub4450:ifso(5)=0thengosub2300
  82. 1272 if so(5)=1andsp<>3thenfe=fa(sp)
  83. 1273 if sp<>3andso(5)=0thengosub2400:gosub4900:gosub2800
  84. 1274 if sp<>3thengosub2900:gosub3286:gosub3200:gosub2750:gosub4700
  85. 1275 ifsp=3andso(5)=0thengosub3286:gosub1780:gosub2600:gosub3286:gosub1780:gosub1797
  86. 1277 if sp=3thengosub2750:gosub3000:gosub4500:gosub3286:gosub3200
  87. 1278 gosub3100
  88. 1279 if n1=3thengosub8000:n1=1:az=2:gosub3119:yy=0:n1=2:az=3:gosub3119:yy=0:goto1282
  89. 1280 if n1=1thengosub3119:n1=2:az=2:yy=0:gosub3119:n1=3:az=3:gosub8000:yy=0:goto1282
  90. 1281 if n1=2thengosub3119:n1=3:az=2:gosub8000:yy=0:n1=1:az=3:gosub3119:yy=0:goto1282
  91. 1282 gosub7000:az=1:if ru<11andso(1)=0then1279
  92. 1283 if ru<10andso(1)=1then1279
  93. 1284 goto7400
  94. 1300 :
  95. 1310 for i2=1to10:rem kartennummer
  96. 1320 for i1=1to3:rem spieler
  97. 1330 for i3=1to4:rem farbe
  98. 1340 for i4=0to7:rem wert
  99. 1350 if ku(i1,i2)=i3*10+i4andi4=0thenko(i1,i3,0)=1:gosub1400:goto1370
  100. 1360 if ku(i1,i2)=i3*10+i4thenko(i1,i3,i4+4)=1:gosub1400
  101. 1370 nexti4,i3,i1,i2
  102. 1399 return
  103. 1400 :
  104. 1401 if i1=3thenreturn
  105. 1405 if i4>0thenan(i1,i3)=an(i1,i3)+1
  106. 1406 if i4=0thenan(i1,0)=an(i1,0)+1
  107. 1407 if i4=0thenat(i1,i4)=at(i1,i4)+1
  108. 1408 if i4>0thenat(i1,i4+4)=at(i1,i4+4)+1
  109. 1420 if i4>0thenwe(i1,i3)=we(i1,i3)+w(i4+4)
  110. 1430 if i4=0thenoni3gosub1440,1441,1442,1443
  111. 1435 return
  112. 1440 v=25:goto1444
  113. 1441 v=23:goto1444
  114. 1442 v=20:goto1444
  115. 1443 v=16:goto1444
  116. 1444 we(i1,0)=we(i1,0)+v:return
  117. 1500 :
  118. 1510 :
  119. 1511 for i1=1to2
  120. 1512 sr=0: rem grand
  121. 1513 if at(i1,5)>1andat(i1,6)>1andat(i1,0)>2then sr=1
  122. 1514 if at(i1,5)>2andat(i1,6)>1andat(i1,0)>1then sr=1
  123. 1515 for i2=1to4
  124. 1516 if an(i1,i2)>5 and at(i1,0)>1thensr=1
  125. 1517 nexti2
  126. 1518 if sr=1thenkk(i1)=1:fa(i1)=0:fl(i1)=0:restore:fors=1to58:readss:nexts
  127. 1519 nexti1
  128. 1520 for i1=1to2
  129. 1521 if kk(i1)=1then1559
  130. 1525 gr=-1
  131. 1530 for i2=1to4
  132. 1540 if we(i1,i2)>grthengr=we(i1,i2):fa(i1)=i2
  133. 1550 nexti2
  134. 1559 nexti1
  135. 1560 :
  136. 1561 for i=1to3:bb(i)=0:nexti
  137. 1562 for i1=1to2
  138. 1563 for i2=1to4
  139. 1564 if i2<>fa(i1)thenbb(i1)=bb(i1)+we(i1,i2)
  140. 1565 if an(i1,i2)=0thenbb(i1)=bb(i1)
  141. 1566 nexti2:bb(i1)=bb(i1)/(10-an(i1,fa(i1))-an(i1,0))
  142. 1567 nexti1
  143. 1568 for i1=1to4:if bb(i1)>6thenbw(i1)=2:goto1571
  144. 1569 if bb(i1)>3thenbw(i1)=0:goto1571
  145. 1570 bw(i1)=-2
  146. 1571 nexti1
  147. 1572 :
  148. 1575 fl(1)=0:fl(2)=0:fl(3)=0
  149. 1580 for i1=1to2:ifkk(i1)=1then1623
  150. 1590 a=we(i1,0)
  151. 1591 restore
  152. 1592 forx=1to22:readff:nextx
  153. 1595 for i2=1to9:rem anzahl faelle
  154. 1600 read b1,b2,b3,b4
  155. 1610 if(a>b1anda<b2)and(we(i1,fa(i1))<(b3-bw(i1))oran(i1,fa(i1))<b4)thenfl(i1)=1
  156. 1620 nexti2
  157. 1623 nexti1
  158. 1624 return
  159. 1625 data -1,1,27,6
  160. 1630 data 15,21,18,4
  161. 1631 data 22,26,16,4
  162. 1632 data 35,37,09,3
  163. 1633 data 38,42,08,3
  164. 1634 data 42,46,09,3
  165. 1635 data 47,49,08,3
  166. 1636 data 58,69,05,2
  167. 1637 data 83,85,03,1
  168. 1700 :
  169. 1705 for i1=9to12
  170. 1706 ho(5-i1+8)=i1
  171. 1707 nexti1
  172. 1708 ho(0)=24:ho(5)=23
  173. 1710 for i1=1to2
  174. 1720 if fl(i1)=1thengosub4300:iffl(i1)=0thengosub4400
  175. 1721 if re(i1)=0andfl(i1)=1andbw(i1)=2thenre(i1)=18:goto1778:rem um kontra
  176. 1722 if fl(i1)=1then1778
  177. 1723 if fa(i1)=5then1765
  178. 1730 yy=ko(i1,1,0):bh(i1)=1+1
  179. 1740 for i2=2to4
  180. 1750 if ko(i1,i2,0)=yythenbh(i1)=bh(i1)+1:goto1760
  181. 1755 goto1765
  182. 1760 nexti2
  183. 1765 if sn(i1)=1thenbh(i1)=bh(i1)+2
  184. 1766 if hn(i1)=1thenbh(i1)=bh(i1)+1
  185. 1770 re(i1)=ho(fa(i1))*bh(i1)
  186. 1778 nexti1
  187. 1779 return
  188. 1780 :
  189. 1781 ta=2:n=0
  190. 1782 for i1=1to4
  191. 1783 if ko(3,i1,0)=1thengg=i1:g1=i1:gosub9000:i2=0:gosub1790
  192. 1784 next i1
  193. 1785 for i1=1to4
  194. 1786 for i2=5to11
  195. 1787 if ko(3,i1,i2)=1thengg=i1:g1=i2:gosub9000:gosub1790
  196. 1788 nexti2,i1:return
  197. 1790 :
  198. 1791 print"";tab(ta);"[144][213][192][192]":n=n+1:kg(n,1)=i1:kg(n,2)=i2
  199. 1792 for i3=1to9
  200. 1795 printtab(ta)"[144][221]"ff$left$(ka$(gn,i3),2):nexti3:printtab(ta);"[144][202][192][192][145][145]"
  201. 1796 ta=ta+3:return
  202. 1797 :
  203. 1798 print""
  204. 1799 printtab(ta)"[144][192][192][192][192][192][201]"
  205. 1800 for i1=1to9
  206. 1801 printtab(ta);ff$right$(ka$(gn,i1),5)"[144][221]"
  207. 1802 nexti1:printtab(ta);"[144][192][192][192][192][192][203][145]"
  208. 1803 return
  209. 1807 :
  210. 1808 data 0,18,20,22,23,24,27,30,33,35,36,39,40,44,45,48,50,54,55,60,63,66,70
  211. 1809 data 72,77,80,81,84,88,90,96,99,100,108,110,117,120,121,126,130,132,135
  212. 1810 data 140,143,144,150,153,154,156,160,162,165,168,170,171,176,180,187,189
  213. 1811 data 190,192,198,200
  214. 1812 au$="grand hd.(j/n)":gosub2700
  215. 1813 getx$:ifx$=""or(x$<>"j"andx$<>"n")then1813
  216. 1814 if x$="j"thenff=1:gb=18:rz=18:sp=3:so(5)=1:fe=0:au$="hand":gosub4600:goto2235
  217. 1815 au$="":gosub2700:t=0
  218. 1820 rs=g+2:ifrs>3thenrs=rs-3
  219. 1822 rh=g+1:ifrh>3thenrh=rh-3
  220. 1824 for i1=1to2
  221. 1825 gosub2140
  222. 1826 if rs=3thengosub1850:goto1834
  223. 1828 if rh=3thengosub1870:goto1834
  224. 1829 if re(rh)<re(rs)then1832
  225. 1830 sp=rh:rs=g:ifi1=2then1833
  226. 1831 gb=re(rs):ifgb>0thengosub1880
  227. 1832 goto1835
  228. 1833 if re(rs)>gbthengb=re(rs)
  229. 1834 if gb=0andre(rh)>0thengb=18:nk=1
  230. 1835 goto1841
  231. 1836 sp=rs:rs=g:ifi1=2then1839
  232. 1837 gb=re(rh):if gb>0thengosub1880
  233. 1838 goto1841
  234. 1839 if re(rh)>gbthengb=re(rh)
  235. 1840 if gb=0andre(rs)>0thengb=18:nk=1
  236. 1841 gosub2140:gosub2150
  237. 1842 nexti1
  238. 1843 if gb=0andg=2thenrs=3:rh=1:gosub1850:ifgb>0thensp=3
  239. 1844 gosub2231
  240. 1845 return
  241. 1850 rem extern sagen
  242. 1852 au$="> sagen! <":gosub2700
  243. 1854 getx$:ifx$<>" "andx$<>"w"then1854
  244. 1856 if x$="w"thensp=rh:rs=g:return
  245. 1858 read gb:ifgb=0then1858
  246. 1859 gosub2150
  247. 1860 if re(rh)<gbthenrh=rs:sp=rs:rs=g:return
  248. 1862 goto1854
  249. 1870 rem extern hoeren
  250. 1871 if re(rs)=0orre(rs)<gbthensp=3:rs=g:return
  251. 1872 au$="> hoeren! <":gosub2700
  252. 1873 readhh:ifre(rs)<hhthensp=rh:return
  253. 1874 gb=hh:gosub2150:ifgb=0then1873
  254. 1875 getx$:ifx$<>" "andx$<>"w"then1875
  255. 1876 if x$="w"thenrh=rs:sp=rs:rs=g:return
  256. 1878 goto1873
  257. 1880 ifi1=2thenreturn
  258. 1882 read hh:ifhh=gbthenreturn
  259. 1884 goto1882
  260. 2140 :
  261. 2141 print"[144]";tab(24);right$(str$(rs),len(str$(rs))-1)
  262. 2143 print"[144]";tab(20);right$(str$(rh),len(str$(rh))-1)
  263. 2144 return
  264. 2150 rem ausdruck gebot intern/extern**
  265. 2160 print"";tab(22);"[144]";gb
  266. 2180 return
  267. 2231 :
  268. 2234 rz=gb:ifrz=0thennq=1:fe=0:sp=0
  269. 2235 print"";tab(22);"[144]";rz
  270. 2240 print"";tab(23);"[144]";sp
  271. 2250 if sp=1thenprint"[153]spieler  01"
  272. 2260 if sp=2thenprint"[153]";tab(29);"spieler  02[145][145]"
  273. 2261 print"";tab(13);"[221]            [221]"
  274. 2262 printtab(14);"            "
  275. 2263 printtab(13);"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  276. 2265 return
  277. 2300 iffe=6thenreturn
  278. 2301 if sp<>3then2305
  279. 2302 au$="hand(j/n)":gosub2700
  280. 2303 getx$:ifx$=""or(x$<>"j"andx$<>"n")then2303
  281. 2304 if x$="j"thenso(5)=1:gosub4600
  282. 2305 au$="":gosub2700:ifso(5)=1thenreturn
  283. 2306 for i=1to2
  284. 2307 u1=int(sk(i)/10):u2=sk(i)-u1*10
  285. 2308 ifu2=0thenko(sp,u1,0)=1
  286. 2309 ifu2>0thenko(sp,u1,u2+4)=1
  287. 2310 if sp<3theni3=u1:i4=u2:i1=sp:gosub1400
  288. 2311 nexti
  289. 2330 return
  290. 2400 :
  291. 2410 if fa(sp)=0andan(sp,0)=4thenso(1)=1:ko(sp,0,4)=0:au$="spitze":gosub4600
  292. 2411 if an(sp,0)>2andfa(sp)=0andbw(sp)=2thenso(2)=1:au$="schneider":gosub4600
  293. 2412 if fa(sp)=0thenfe=0:return
  294. 2420 if fa(sp)=5thenfl(sp)=1:gosub4300:iffl(i1)=0thenfe=5:return
  295. 2460 gr=-2
  296. 2470 for i=1to4
  297. 2480 if we(sp,i)>gr thengr=we(sp,i):fe=i
  298. 2490 nexti
  299. 2492 ifan(sp,fe)>6andbh(sp)>2andbw(sp)>-2thenso(2)=1:au$="schneider":gosub4600
  300. 2495 if an(sp,fe)<7orko(sp,fe,11)=0thenreturn
  301. 2496 ko(sp,fe,11)=0:so(1)=1:au$="spitze":gosub4600
  302. 2497 for i=1to3
  303. 2498 g3(i,fe)=g3(i,fe)-1:g2(i,fe,11)=1
  304. 2499 nexti
  305. 2500 return
  306. 2550 rem auf spitze reizen
  307. 2560 fori=1to2
  308. 2570 if fl(i)=1then2590
  309. 2580 if an(i,fa(i))>6thensn(i)=1
  310. 2585 if fa(i)=0andan(i,0)=4thensn(i)=1
  311. 2590 nexti
  312. 2595 return
  313. 2600 :
  314. 2601 if so(5)=1thenreturn
  315. 2610 au$="> druecken ! <"
  316. 2620 gosub2700
  317. 2621 xx$=""
  318. 2625 for i1=1to2
  319. 2630 getx$:ifx$=""then2630
  320. 2635 if x$="_"thengosub2780:goto2621
  321. 2640 x=val(x$)
  322. 2650 ifx$="+"thenx=11
  323. 2660 ifx$="-"thenx=12
  324. 2670 ifx$="0"thenx=10
  325. 2680 if x=0thengoto2630
  326. 2685 if x$=xx$then2630
  327. 2686 print"";tab(4+(x-1)*3);"[144]";x$;"[145]"
  328. 2690 xx$=x$:dr(i1)=x:nexti1
  329. 2691 getx$:ifx$=""andx$<>"_"andx$<>chr$(13)then2691
  330. 2692 if x$="_"then2635
  331. 2693 for i1=1to2
  332. 2694 su(sp)=su(sp)+ww(kg(dr(i1),2))
  333. 2695 ko(3,kg(dr(i1),1),kg(dr(i1),2))=0
  334. 2696 nexti1
  335. 2697 au$="":gosub2700
  336. 2698 return
  337. 2700 :
  338. 2710 print"";tab(13);"              "
  339. 2720 if len(au$)>14thenstop
  340. 2730 print"[144]";tab(13+int((14-len(au$))/2));au$
  341. 2740 return
  342. 2750 :
  343. 2760 print"    1  2  3  4  5  6  7  8  9     0   [145][145][145]"
  344. 2770 return
  345. 2780 print"    1  2  3  4  5  6  7  8  9  0  +  -[145][145][145]"
  346. 2790 return
  347. 2800 :
  348. 2801 if fe=5thenau$="> moment! <":gosub2700:gosub3900:goto2880
  349. 2802 if re(sp)>0then2809
  350. 2803 for i1=6to7:rem hoch druecken
  351. 2804 for i2=1to4:ifi2=fethen2808
  352. 2805 ifko(sp,i2,i1)=1thenan(sp,i2)=an(sp,i2)-1
  353. 2806 ifko(sp,i2,i1)=1thensu(sp)=su(sp)+ww(i1):ko(sp,i2,i1)=0:g2(sp,i2,i1)=1:t2=t2+1
  354. 2807 if t2=2thenreturn
  355. 2808 nexti2,i1
  356. 2809 t1=t1+1:a1=6:a2=11:a3=1:ift1>2thena1=11:a2=5:a3=-1
  357. 2810 for i1=1to4
  358. 2815 if i1=fethen2830
  359. 2820 if an(sp,i1)=t1thengosub2850
  360. 2825 if t2=2thenreturn
  361. 2830 nexti1
  362. 2840 if t2<2then2809
  363. 2845 return
  364. 2850 :
  365. 2860 for i2=a1toa2stepa3
  366. 2864 if ko(sp,i1,i2)=0then2870
  367. 2865 ko(sp,i1,i2)=0:su(sp)=su(sp)+ww(i2):t2=t2+1:g2(sp,i1,i2)=0
  368. 2866 an(sp,i1)=an(sp,i1)-1
  369. 2867 ift2=2thenreturn
  370. 2870 nexti2
  371. 2875 return
  372. 2880 :
  373. 2881 jk$="445362728291455464738393"
  374. 2883 for i2=1to24step2
  375. 2884 j1=val(mid$(jk$,i2,1)):j2=val(mid$(jk$,i2+1,1))
  376. 2885 for i1=1to4
  377. 2886 ifko(sp,i1,j1)=0oran(sp,i1)>j2then2888
  378. 2887 lr=lr+1:ko(sp,i1,j1)=0:g2(sp,i1,j1)=1:an(sp,i1)=an(sp,i1)-1:iflr=2thenreturn
  379. 2888 nexti1,i2
  380. 2889 stop
  381. 2900 :
  382. 2910 fb$(1)="kreuz"
  383. 2920 fb$(2)="pik  "
  384. 2930 fb$(3)="herz "
  385. 2940 fb$(4)="karo "
  386. 2945 fb$(0)="grand"
  387. 2946 fb$(5)="null "
  388. 2948 if nq=1thenfb$(0)="[157]ramsch"
  389. 2950 print"[144]";tab(21);fb$(fe)
  390. 2951 iffe=5and(sp=3or(sp<>3andso(5)=1))thenau$="> moment! <":gosub2700:gosub3900
  391. 2952 if fe=5thenreturn
  392. 2953 for i3=1to2
  393. 2954 g3(i3,fe)=11:if fe=0theng3(i3,0)=4
  394. 2955 ifso(1)=1theng3(i3,fe)=g3(i3,fe)-1
  395. 2956 nexti3:iffe=0ornq=1ornk=1then2970
  396. 2957 fori7=1to2
  397. 2958 an(i7,fe)=an(i7,fe)+an(i7,0)
  398. 2959 ifan(i7,fe)>3andbw(i7)>-2andi7<>spandre(i7)>0thenso(4)=1:au$="kontra":gosub4600
  399. 2960 nexti7
  400. 2970 for i1=1to3
  401. 2971 for i2=1to4
  402. 2972 if ko(i1,i2,0)=1thenko(i1,fe,i2)=1:goto2974
  403. 2974 nexti2
  404. 2975 nexti1
  405. 2976 fori3=1to2:g4(i3,fe)=1:nexti3
  406. 2990 return
  407. 3000 if ff=1 then 3032
  408. 3001 if nq=1thengosub2900:return
  409. 3010 au$=">farbe(0-5)<":gosub2700
  410. 3015 print" [144]0null [144]1kreuz [144]2pik [144]3herz [144]4karo [144]5grand[145]"
  411. 3020 getx$:if(val(x$)=0andx$<>"0")orval(x$)>5then3020
  412. 3025 au$="":gosub2700
  413. 3030 fe=val(x$):if fe=0thenfe=5
  414. 3031 ifval(x$)=5thenfe=0
  415. 3032 gosub2900:return
  416. 3100 :
  417. 3109 n1=g+1:ifn1=4thenn1=1
  418. 3110 az=1:ru=1:rem rauskommer
  419. 3115 print" spiel: eingabe der linken kartennummer [145]"
  420. 3116 return
  421. 3119 :
  422. 3120 up=n1-1:ifup=0thenup=3
  423. 3130 op=n1+1:ifop=4thenop=1
  424. 3135 kv=k(up)
  425. 3139 if nq=1thenpo=az:goto3198
  426. 3140 if n1=spthenpo=az:goto3199
  427. 3150 if up=spandaz=1thenpo=1
  428. 3160 if up<>spandaz=1thenpo=2
  429. 3170 if up=spandaz=2thenpo=3
  430. 3175 if up<>spandaz=2thenpo=4
  431. 3176 if az=3thenpo=5
  432. 3177 on po goto 3300,3400,3500,3600,3700
  433. 3198 on po goto 10000,10100,10200
  434. 3199 on po goto 4000,4100,4200
  435. 3200 :
  436. 3220 n=0:ta=2:uj=1
  437. 3225 if fe=5then3260
  438. 3230 for i2=1to11
  439. 3240 if ko(3,fe,i2)=1andi2<5thengg=i2:g1=i2:gosub9000:i1=fe:gosub1790:goto3250
  440. 3245 if ko(3,fe,i2)=1thengg=fe:g1=i2:gosub9000:i1=fe:gosub1790
  441. 3250 next i2
  442. 3260 for i1=1to4
  443. 3265 if i1=fe then 3283
  444. 3270 for i2=4to11
  445. 3280 if ko(3,i1,i2)=1thengg=i1:g1=i2:gosub9000:gosub1790
  446. 3282 nexti2
  447. 3283 nexti1
  448. 3284 gosub1797
  449. 3285 return
  450. 3286 au$="":gosub2700
  451. 3287 print"";
  452. 3288 for i=1to11
  453. 3289 print"                                      "
  454. 3290 nexti
  455. 3291 return
  456. 3300 :
  457. 3301 if fe=5then4800
  458. 3303 fori=1to4:tf(i)=0:nexti
  459. 3304 df=fa:for fa=1to4
  460. 3305 ifg1(n1,sp,fa)=2andg1(n1,sp,fe)=2thenaa$="-3-3010511":gosub6500:ifyy=2thenfa=df:return
  461. 3306 ifg1(n1,sp,fe)=2thenaa$="-3-30105-1":gosub6500:ifyy=2thenfa=df:return
  462. 3307 if g1(n1,sp,fa)=2andso(1)=1thenaa$="-3-30107110506":gosub6500:ifyy=2thenfa=df:return
  463. 3308 nextfa:fa=df
  464. 3310 gr=100
  465. 3320 for i1=1to4
  466. 3325 if i1=fethengoto3340
  467. 3330 if an(n1,i1)<gr andtf(i1)=0thengr=an(n1,i1):fa=i1
  468. 3340 nexti1
  469. 3341 if gr=100thengosub5200:return
  470. 3345 tf(fa)=1
  471. 3346 if an(n1,fa)=2andg2(n1,fa,5)=0andko(n1,fa,6)=1andko(n1,fa,5)=0then3310
  472. 3360 if g1(n1,sp,fa)<2thengosub5000:if yy<2then3310
  473. 3365 if yy=2thenreturn
  474. 3380 if g1(n1,sp,fa)=2then3310
  475. 3390 stop
  476. 3400 :
  477. 3401 if fe=5then4800
  478. 3402 if fe>0then3406
  479. 3403 df=fa:for fa=1to4
  480. 3404 if g1(n1,sp,fa)<2thenaa$="-3-30005-2":gosub6500:ifyy=2thenreturn
  481. 3405 nextfa:fa=df
  482. 3406 df=fa:for fa=1to4
  483. 3407 ifg1(n1,sp,fa)=2andg1(n1,sp,fe)=2thenaa$="-3-3010511":gosub6500:ifyy=2thenfa=df:return
  484. 3408 ifg1(n1,sp,fe)=2thenaa$="-3-30105-1":gosub6500:ifyy=2thenfa=df:return
  485. 3409 nextfa:fa=df
  486. 3410 fori=1to4:tf(i)=0:nexti
  487. 3420 gr=-2
  488. 3430 fori1=1to4
  489. 3440 if i1=fethen3460
  490. 3450 if an(n1,i1)>gr andtf(i1)=0thengr=an(n1,i1):fa=i1
  491. 3460 nexti1
  492. 3465 if gr=-2thengosub 5200:ifyy=2thenreturn
  493. 3466 if gr=-2thenstop
  494. 3470 if g1(n1,sp,fa)<2thengosub5000:ifyy<2thentf(fa)=1:goto3420
  495. 3480 if yy=2thenreturn
  496. 3490 if g1(n1,sp,fa)=2thentf(fa)=1:goto3420
  497. 3500 rem ms pos 3 (2./1.spieler)*******
  498. 3501 if fe<5then3510
  499. 3502 if an(n1,fa)>0thenaa$="-3-30011-104-1":gosub6500:return
  500. 3503 goto3800
  501. 3510 if an(n1,fa)>0thengosub5300:ifyy=2thenreturn
  502. 3520 if ww(kv)>3 and g1(n1,op,fa)=2andan(n1,fe)>0thengosub5400:if yy=2thenreturn
  503. 3525 ifww(kv)>3andg4(n1,fa)=kvandan(n1,fe)>0andg1(n1,op,fa)<2thengosub5400:ifyy=2thenreturn
  504. 3530 ifg1(n1,op,fa)=1andkv<>g4(n1,fa)thengosub5500:ifyy=2thenreturn
  505. 3531 if g1(n1,op,fa)=2andg1(n1,op,fe)<2andg3(n1,fe)>0thengosub5500:ifyy=2thenreturn
  506. 3540 if kv>7or(g1(n1,op,fa)=1andkv=g4(n1,fa))thengosub5600:if yy=2thenreturn
  507. 3545 gosub5600:ifyy=2thenreturn
  508. 3546 stop :rem fall?
  509. 3600 rem ms pos 4 (2./1.mitspieler)****
  510. 3601 if fe<5then3610
  511. 3602 if an(n1,fa)>0thenaa$="-3-300-1111104":gosub6500:return
  512. 3604 goto 3800
  513. 3610 if an(n1,fa)>0thengosub5700:return
  514. 3620 if an(n1,fe)>0thengosub5800:ifyy=2thenreturn
  515. 3640 gosub5900:if yy=2thenreturn
  516. 3650 gosub5600:if yy=2thenreturn
  517. 3670 stop:rem immer noch falsch?
  518. 3700 rem ms-pos-5**********************
  519. 3701 if fe<5then3710
  520. 3702 if an(n1,fa)>0andha=spthenaa$="-3-30011-104-1":gosub6500:return
  521. 3703 if an(n1,fa)>0andha<>spthenaa$="-3-3000411":gosub6500:return
  522. 3704 goto3800
  523. 3710 if an(n1,fa)>0thengosub6100:ifyy=2thenreturn
  524. 3720 ifan(n1,fe)>0andha=spandww(k(op))+ww(k(up))>7thengosub6200:ifyy=2thenreturn
  525. 3730 if ha<>spthengosub5500:ifyy=2thenreturn
  526. 3750 gosub 5600:ifyy=2thenreturn
  527. 3760 stop
  528. 3800 rem unterprogramm abwurf null*****
  529. 3802 df=fa
  530. 3803 forfa=1to4
  531. 3804 ifan(n1,fa)=1thenaa$="-3-3000409":gosub6500:ifyy=2thenfa=df:return
  532. 3805 nextfa
  533. 3806 fa=df
  534. 3807 aa$="0104000411":gosub6500
  535. 3808 ifyy=2thenreturn
  536. 3809 stop
  537. 3900 rem neuordnung karten null *******
  538. 3901 fori1=1to2:for i2=1to4:g3(i1,i2)=8:nexti2,i1
  539. 3910 for i1=1to3:fori2=1to4:fori3=0to11
  540. 3920 kd(i1,i2,i3)=ko(i1,i2,i3)
  541. 3921 ko(i1,i2,i3)=0
  542. 3930 nexti3,i2,i1
  543. 3940 for i1=1to3:for i2=1to4:fori3=0to11
  544. 3950 if i3=8ori3=7thenko(i1,i2,i3-2)=kd(i1,i2,i3)
  545. 3960 if i3=5thenko(i1,i2,4)=kd(i1,i2,i3)
  546. 3970 if i3=0thenko(i1,i2,7)=kd(i1,i2,i3)
  547. 3975 if i1<>3andkd(i1,i2,0)=1thenan(i1,i2)=an(i1,i2)+1
  548. 3980 if i3=6thenko(i1,i2,8)=kd(i1,i2,i3)
  549. 3990 if i3>8thenko(i1,i2,i3)=kd(i1,i2,i3)
  550. 3995 nexti3,i2,i1
  551. 3996 return
  552. 4000 :
  553. 4001 if fe=5thenaa$="01040010091111":gosub6500:return
  554. 4005 uu=g3(n1,fe)-an(n1,fe)
  555. 4007 if fe=0anduu>0thenaa$="-4-40001-20401":gosub6500:ifyy=2thenreturn
  556. 4010 ifan(n1,fe)>2anduu>0andfe>0thenaa$="-4-40001-204011107":gosub6500:ifyy=2thenreturn
  557. 4020 aa$="0104010505":gosub6500:ifyy=2thenreturn
  558. 4030 for fa=1to4
  559. 4035 if fa=fethen4050
  560. 4040 ifg3(n1,fe)=an(n1,fe)thenrf=1:aa$="-3-30105-2":gosub6500:ifyy=2thenrf=0:return
  561. 4041 hl=g1(n1,op,fa)
  562. 4044 ifhl=2andg1(n1,up,fa)=2andrf=1thenaa$="-3-3010511":rf=0:gosub6500:ifyy=2thenreturn
  563. 4045 ifg1(n1,op,fa)<2andg1(n1,up,fa)<2thenaa$="-3-30105-2":gosub6500:ifyy=2thenreturn
  564. 4050 nextfa:fa=df
  565. 4060 aa$="0104011107":gosub6500:ifyy=2thenreturn
  566. 4070 aa$="-4-40011070401":gosub6500:ifyy=2thenreturn
  567. 4075 aa$="0104010605":gosub6500:ifyy=2thenreturn
  568. 4076 aa$="-4-4000605":gosub6500:ifyy=2thenreturn
  569. 4080 stop
  570. 4100 :
  571. 4101 if fe<5then4110
  572. 4102 if an(n1,fa)>0thenaa$="-3-300-1111104":gosub6500:return
  573. 4103 goto3800
  574. 4110 aa$="-3-300-2-21101":gosub6500:ifyy=2thenreturn
  575. 4119 hl=g2(n1,fa,5)
  576. 4120 if(hl=0andkv<>5)or(g2(n1,fa,6)=0andkv<>6)thenaa$="-4-40005110401":goto4150
  577. 4130 if ww(kv)>3andg1(n1,op,fa)=2thenaa$="-4-4-2-21109":goto4150
  578. 4140 if ww(kv)>3andg1(n1,op,fa)<2thenaa$="-4-405110401":goto4150
  579. 4145 goto4160
  580. 4150 gosub6500:ifyy=2thenreturn
  581. 4160 for fa=1to4:ifan(n1,fa)=2andko(n1,fa,6)=1then4162
  582. 4161 aa$="-3-3011108":gosub6500:ifyy=2thenfa=df:return
  583. 4162 nextfa:fa=df
  584. 4170 aa$="-4-40011070401":gosub6500:ifyy=2thenreturn
  585. 4180 aa$="0104000705":gosub6500:ifyy=2thenreturn
  586. 4190 stop
  587. 4200 :
  588. 4201 if fe<5then4210
  589. 4202 if an(n1,fa)>0thenaa$="-3-300-11104-1":gosub6500:ifyy=2thenreturn
  590. 4204 goto3800
  591. 4210 iff(ha)=fathenaa$="-3-300-10111-1":gosub6500:ifyy=2thenreturn
  592. 4211 if f(ha)=feandfa<>fethenaa$="-3-3011101":gosub6500:ifyy=2thenreturn
  593. 4220 if(ww(k(op))+ww(kv))>7andf(ha)<>fethenaa$="-4-40005110401":gosub6500:ifyy=2thenreturn
  594. 4230 if(ww(op)+ww(up))>7andf(ha)=fethenaa$="-4-400-101":gosub6500:ifyy=2thenreturn
  595. 4240 goto4160
  596. 4300 :
  597. 4320 if at(i1,11)+at(i1,10)<4thenreturn
  598. 4330 if at(i1,9)+at(i1,6)+at(i1,0)<8-at(i1,11)-at(i1,10)thenreturn
  599. 4340 if at(i1,5)+at(i1,7)+at(i1,8)>3thenreturn
  600. 4350 fa(i1)=5:fl(i1)=0:re(i1)=23:bh(i1)=1
  601. 4360 return
  602. 4400 :
  603. 4405 fori4=1to2
  604. 4406 if fa(i4)=5thengosub4430:goto4415
  605. 4407 if fa(i4)=0andan(i4,0)>2andbw(i4)>-2thenhn(i4)=1
  606. 4410 if bw(i4)=2andan(i4,fa(i4))>5thenhn(i4)=1
  607. 4415 nexti4
  608. 4420 return
  609. 4430 t=0
  610. 4431 fori2=1to4
  611. 4435 ag=an(i4,i2):wg=we(i4,i2):ifko(i4,i2,0)=1thenwg=wg+4:ag=ag+1
  612. 4436 if ko(i4,i2,6)=1thenwg=wg-5
  613. 4437 ifag=0then4447
  614. 4440 if wg/ag>1.7thent=1
  615. 4447 nexti2
  616. 4448 if t=0thenhn(i1)=1
  617. 4449 return
  618. 4450 rem handausdruck
  619. 4451 if sp=3orfe=6thenreturn
  620. 4460 if hn(sp)=1thenso(5)=1:au$="hand":gosub4600
  621. 4470 return
  622. 4500 :
  623. 4510 if fe=5thenreturn
  624. 4515 if(fe=0andko(3,0,4)=0)or(fe>0andko(3,fe,11)=0)then4550
  625. 4520 au$="spitze (j/n)":gosub2700
  626. 4530 getx$:ifx$=""then4530
  627. 4540 if x$="j"thenso(1)=1:ko(3,fe,11)=0:gosub4600
  628. 4541 if so(1)=1andfe=0thenko(sp,0,4)=0
  629. 4550 au$="schneider(j/n)":gosub2700
  630. 4560 getx$:ifx$=""then4560
  631. 4570 if x$="j"thenso(2)=1:gosub4600
  632. 4580 if x$="n"then4593
  633. 4590 au$="schwarz (j/n)":gosub2700
  634. 4591 getx$:ifx$=""then4591
  635. 4592 if x$="j"thenso(3)=1:gosub4600
  636. 4593 au$="":gosub2700:return
  637. 4600 if au$="kontra"thenau$=au$+str$(i7)
  638. 4601 if right$(au$,1)<>")"andright$(au$,1)<>" "thenau$=au$+"     "
  639. 4602 if 26-mm<len(au$)-5thenmm=14:cf$=cf$+""
  640. 4603 if au$="schwarz (j/n)"thenau$="schn./schw.     ":cf$=left$(cf$,len(cf$)-1)
  641. 4610 print""+cf$;tab(mm);"[144]"+left$(au$,len(au$)-5)
  642. 4611 mm=mm+len(au$)-5+1
  643. 4630 return
  644. 4700 :
  645. 4701 if so(4)=1ornq=1ornk=1thenreturn
  646. 4705 au$="kontra(j/n)":gosub2700
  647. 4706 getx$:ifx$=""then4706
  648. 4707 if x$="j"thenso(4)=1:gosub4600
  649. 4708 au$="":gosub2700:return
  650. 4800 :
  651. 4810 for fa=1to4
  652. 4815 if g1(n1,sp,fa)=2then4840
  653. 4820 if g3(n1,fa)=8thenaa$="-3-3001008":gosub6500:ifyy=2thenfa=df:return
  654. 4824 if g3(n1,fa)=8then4840
  655. 4825 if ko(n1,fa,g5(n1,fa))=1thenaa$="-3-300-3-3":gosub6500:fa=df:return
  656. 4829 hl=g1(n1,sp,fa)
  657. 4830 ifg3(n1,fa)<8andg3(n1,fa)>2andhl<2thenaa$="-3-3001107":gosub6500:ifyy=2then4860
  658. 4840 nextfa:fa=df
  659. 4850 ur=1
  660. 4851 for in=11to4step-1:in$=right$(str$(in),2)
  661. 4852 for fa=1to4
  662. 4853 hl=g1(n1,sp,fa)
  663. 4854 if(hl=2andur=0)org1(n1,sp,fa)<2thenaa$="-3-30011"+in$:gosub6500:ifyy=2thenreturn
  664. 4855 nextfa
  665. 4856 nextin
  666. 4857 ifur=1thenur=0:goto4851
  667. 4860 fa=df:return
  668. 4900 :
  669. 4905 if fa(sp)=5thenreturn
  670. 4910 yy=ko(sp,1,0):bh=1+1
  671. 4920 for i2=2to4
  672. 4930 if ko(sp,i2,0)=yythenbh=bh+1:goto4950
  673. 4940 goto4960
  674. 4950 nexti2
  675. 4955 ll=len(cf$)
  676. 4960 hb=ho(fe)*bh
  677. 4970 ifhb<rzthenfe=fa(sp):so(2)=0:so(3)=0:ifso(1)=1thencf$=left$(cf$,ll-1):so(1)=0
  678. 4980 hb=ho(fe)*bh
  679. 4990 if hb<rzandko(sp,fe,11)=1thenso(1)=1:ko(sp,fe,11)=0:au$="spitze":gosub4600
  680. 4995 return
  681. 5000 :
  682. 5010 aa$="-3-301-2-21107":gosub6500
  683. 5020 return
  684. 5100 :
  685. 5110 ta=2:ifn1=2thenta=31
  686. 5120 gg=i3:g1=i2
  687. 5121 gosub9000
  688. 5131 ko(n1,i3,g1)=0
  689. 5139 print""
  690. 5140 for i=1to9
  691. 5150 printtab(ta);"       "
  692. 5160 nexti
  693. 5165 print""
  694. 5170 for i=1to9
  695. 5180 printtab(ta);ff$+ka$(gn,i)
  696. 5190 nexti
  697. 5191 gosub7200
  698. 5195 return
  699. 5200 :
  700. 5210 aa$="0104011105":gosub6500:ifyy=2thenreturn
  701. 5220 aa$="-4-400110704010605":gosub6500:ifyy=2thenreturn
  702. 5300 :
  703. 5320 ifk(ha)>5thenaa$="-3-30005-1-101110704010605"
  704. 5321 if k(ha)<6thenaa$="-3-300-101110704010605"
  705. 5330 gosub6500:ifyy<2thenstop
  706. 5340 return
  707. 5400 :
  708. 5410 aa$="-4-40005110401":gosub6500:return
  709. 5500 :
  710. 5505 df=fa
  711. 5510 for fa=1to4
  712. 5515 if fa=fethengoto5530
  713. 5520 if g1(n1,sp,fa)=2thenaa$="-3-3000508":gosub6500:ifyy=2thenfa=df:return
  714. 5525 if ko(n1,fa,6)=1andan(n1,fa)=1thenaa$="-3-3000606":gosub6500:ifyy=2thenfa=df:return
  715. 5530 nextfa
  716. 5531 ifru>4and(su(1)+su(2)+su(3)-su(sp))<25thenaa$="0104010608":gosub6500:ifyy=2thenreturn
  717. 5540 fa=df:return
  718. 5600 :
  719. 5610 aa$="0104011108":gosub6500:ifyy=2thenreturn
  720. 5620 aa$="-4-400050704010811":gosub6500:ifyy=2thenreturn
  721. 5630 aa$="0104010705":gosub6500:ifyy=2thenreturn
  722. 5640 stop
  723. 5700 :
  724. 5705 aa$="-3-300110704010605"
  725. 5710 if k(up)=g4(n1,f(up))andg1(n1,op,fa)<>2andfa<>fethenaa$="-3-3000511"
  726. 5720 if k(up)=g4(n1,f(up))andg1(n1,op,fa)<>2andfa=fethen aa$="-4-40005110401"
  727. 5730 if k(up)<>g4(n1,fa)andko(n1,fa,g4(n1,fa))=1thenaa$="-3-300-2-2"
  728. 5740 gosub6500:return
  729. 5800 :
  730. 5810 if (ko(n1,fe,5)=1orko(n1,fe,6)=1)and g1(n1,op,fa)<2thenaa$="-4-4000506"
  731. 5819 hl=g1(n1,op,fa)
  732. 5820 ifkv>6and(g2(n1,fa,5)=0org2(n1,fa,6)=0)andhl<2thenaa$="-4-400110704010605"
  733. 5821 if(kv=6orkv=7)andkv<>g4(n1,fa)andg1(n1,sp,fe)<2thenaa$="-4-400050611070401"
  734. 5830 gosub6500
  735. 5840 return
  736. 5900 :
  737. 5910 if kv>7andg1(n1,sp,fa)=2andfa<>feandg1(n1,sp,fe)<2thengoto5600
  738. 5915 if g1(n1,sp,fa)=2andg1(n1,sp,fe)=2thengosub5500:ifyy=2thenreturn
  739. 5920 if an(n1,fe)=0andkv<>g4(n1,fa)thengosub5600:ifyy=2thenreturn
  740. 5930 return
  741. 6100 :
  742. 6110 if f(ha)=feandfa<>feandha=spthenaa$="-3-3001105"
  743. 6115 if f(ha)=feandfa<>feandha<>spthenaa$="-3-3000511"
  744. 6120 iff(ha)=faandfa<>feandk(ha)>6andg2(n1,fa,6)=0then rt=1
  745. 6121 if rt=1andko(n1,fa,6)=0thenaa$="-3-300-11105-1":rt=0
  746. 6122 if rt=1andko(n1,fa,6)=1thenaa$="-3-3000511":rt=0
  747. 6123 if f(ha)=faandfa<>feandk(ha)>6andg2(n1,fa,6)=1thenaa$="-3-30005-111-1"
  748. 6125 if f(ha)=faandfa<>feandk(ha)<7andha=spthenaa$="-3-30005-111-1"
  749. 6126 if f(ha)=faandfa<>feandk(ha)<7andha<>spthenaa$="-3-30006110505"
  750. 6130 if fa=fe and ha=spand k(ha)=g4(n1,fa)thenaa$="-4-400110704010605"
  751. 6140 if fa=fe and ha<>spthenaa$="-4-40005110401"
  752. 6145 kp=k(op)
  753. 6149 hl=g4(n1,fa)
  754. 6150 iffa=feandha=spandk(ha)<>hlandww(kv)+ww(kp)>2thenaa$="-4-400-101110704010605"
  755. 6151 iffa=feandha=spandk(ha)<>hlandww(kv)+ww(k(op))<3thenaa$="-4-4001108-101-111"
  756. 6155 gosub6500:ifyy=2thenreturn
  757. 6160 stop
  758. 6200 :
  759. 6210 if f(ha)<>feandha=spthengosub5400:ifyy=2thenreturn
  760. 6220 aa$="-4-400-101":gosub6500
  761. 6230 return
  762. 6500 :
  763. 6501 a(0,1)=(len(aa$)-6)/4
  764. 6503 a(0,4)=val(mid$(aa$,5,2))
  765. 6504 a(0,2)=val(mid$(aa$,1,2))
  766. 6505 a(0,3)=val(mid$(aa$,3,2))
  767. 6506 if a(0,2)=-3thena(0,2)=fa:a(0,3)=fa
  768. 6507 if a(0,2)=-4thena(0,2)=fe:a(0,3)=fe
  769. 6508 for i1=1toa(0,1)
  770. 6509 a(i1,1)=val(mid$(aa$,7+(i1-1)*4,2))
  771. 6510 a(i1,2)=val(mid$(aa$,9+(i1-1)*4,2))
  772. 6511 if a(i1,1)=-1thena(i1,1)=k(ha)
  773. 6512 if a(i1,2)=-1thena(i1,2)=k(ha)
  774. 6513 if a(i1,1)=-2thena(i1,1)=g4(n1,a(0,2))
  775. 6514 if a(i1,2)=-2thena(i1,2)=g4(n1,a(0,2))
  776. 6515 if a(i1,1)=-3thena(i1,1)=g5(n1,a(0,2))
  777. 6516 if a(i1,2)=-3thena(i1,2)=g5(n1,a(0,2))
  778. 6517 nexti1
  779. 6518 for i1=1toa(0,1)
  780. 6530 for i2=a(i1,1)toa(i1,2)stepsgn(a(i1,2)-a(i1,1))
  781. 6532 for i3=a(0,2)toa(0,3)
  782. 6538 if g1(n1,sp,i3)=2anda(0,4)=2then6550
  783. 6539 if i3=feanda(0,4)=1then6550
  784. 6540 if ko(n1,i3,i2)=1thenyy=2:gosub5100:return
  785. 6550 nexti3,i2,i1
  786. 6560 yy=0:return
  787. 7000 :
  788. 7005 au$="":gosub2700
  789. 7006 n1=ha:ru=ru+1
  790. 7007 fori=1to2
  791. 7008 an(i,f(i))=an(i,f(i))-1
  792. 7009 nexti
  793. 7010 for i1=1to2:fori4=1to3
  794. 7011 if k(i4)<>g4(i1,f(i4))then7014
  795. 7012 ifg4(i1,f(i4))<11theng4(i1,f(i4))=g4(i1,f(i4))+1
  796. 7013 ifg2(i1,f(i4),g4(i1,f(i4)))=1andg4(i1,f(i4))<11then7012
  797. 7014 if k(i4)<>g5(i1,f(i4))then7017
  798. 7015 ifg5(i1,f(i4))>1theng5(i1,f(i4))=g5(i1,f(i4))-1
  799. 7016 ifg2(i1,f(i4),g5(i1,f(i4)))=1andg5(i1,f(i4))>1then7015
  800. 7017 nexti4
  801. 7018 fori2=0to4:if g3(i1,i2)-an(i1,i2)=0thenfori3=1to3:g1(i1,i3,i2)=2:nexti3
  802. 7019 nexti2
  803. 7020 nexti1
  804. 7021 :
  805. 7027 su(ha)=su(ha)+ww(k(1))+ww(k(2))+ww(k(3))
  806. 7028 au$="> leertaste <":gosub2700
  807. 7029 wait203,60:au$="":gosub2700
  808. 7030 gosub 7100
  809. 7040 gosub 3286:ifru<11andso(1)=0thengosub3200
  810. 7045 ifru<10andso(1)=1thengosub3200
  811. 7060 return
  812. 7100 :
  813. 7110 print""
  814. 7115 for i=1to9
  815. 7120 printtab(2);"       ";tab(31);"       "
  816. 7130 nexti
  817. 7140 return
  818. 7200 :
  819. 7201 fa=df:k(n1)=g1:f(n1)=gg
  820. 7202 if k(n1)<5andfe<5thenf(n1)=fe
  821. 7203 if az=1thenfa=f(n1):df=fa
  822. 7204 fori1=1to2
  823. 7205 if g3(i1,f(n1))=0thenfori2=1to3:g1(i1,i2,f(n1))=2:nexti2
  824. 7206 g2(i1,f(n1),k(n1))=1:g1(i1,n1,f(n1))=1:iff(n1)<>fatheng1(i1,n1,fa)=2
  825. 7207 iffe=5then7210
  826. 7208 gt=ww(k(1))+ww(k(2))+ww(k(3))
  827. 7209 ifaz=3andgt>3andf(sp)<>faandf(sp)<>fetheng1(i1,sp,fe)=2
  828. 7210 for i9=1to3:rem blanke zehn
  829. 7211 if i9=spthen7213
  830. 7212 gosub55555
  831. 7213 nexti9
  832. 7214 g3(i1,f(n1))=g3(i1,f(n1))-1
  833. 7215 nexti1
  834. 7219 if az>1andf(n1)=faandk(n1)<k(ha)andf(ha)<>feandfa<>fethenha=n1
  835. 7220 if az>1andfa<>feandf(n1)=feand f(ha)<>fethen ha=n1
  836. 7250 if az>1andf(n1)=feandf(ha)=feandk(ha)>k(n1)thenha=n1
  837. 7251 if az=1thenha=n1
  838. 7259 fori8=1to4:tf(i8)=0:nexti8
  839. 7260 if ha<>spandso(3)=1andaz=3thenha=sp:goto7265
  840. 7261 iffe<5thenreturn
  841. 7265 if az=3andha=spthensu(sp)=0:au$="> leertaste <":gosub2700:wait203,60:goto7400
  842. 7270 return
  843. 7400 :
  844. 7401 if fe=5thenbh=1:ifso(5)=1thenho(5)=35
  845. 7402 if fe=5andru=11thensu(sp)=120
  846. 7403 if fe=5then7467
  847. 7404 if nq<1then7410
  848. 7405 ra=-2
  849. 7406 fori=1to3:ifsu(i)>rathenra=su(i):sp=i
  850. 7407 nexti:su(sp)=0
  851. 7408 tr$=" ramsch gibt 60 punkte! "
  852. 7409 poke49990,peek(49990)+1:ss=60:goto7470
  853. 7410 bh=2
  854. 7420 for i=2to4
  855. 7430 ifko(sp,i,0)<>ko(sp,1,0)then7441
  856. 7435 bh=bh+1
  857. 7440 nexti
  858. 7441 su(sp)=su(sp)+(120-(su(1)+su(2)+su(3)))
  859. 7459 if su(sp)<31 or su(sp)>90thenbh=bh+1:ifsu(sp)=0orsu(sp)=120thenbh=bh+1
  860. 7460 if so(5)=1thenbh=bh+1
  861. 7461 if so(1)=1thenbh=bh+2
  862. 7462 if so(2)=1thenbh=bh+1
  863. 7463 if so(3)=1thenbh=bh+1
  864. 7464 if so(2)=1andsu(sp)<91thensu(sp)=0:tr$=tr$+"nicht schneider! "
  865. 7465 if so(3)=1andsu(sp)<120thensu(sp)=0:tr$=tr$+" nicht schwarz! "
  866. 7466 if so(1)=1andg3(1,fe)>1thensu(sp)=0:tr$=tr$+"spitze nicht durch! "
  867. 7467 ss=bh*ho(fe):ifss<rzthensu(sp)=0:tr$=tr$+" ueberreizt! "
  868. 7468 poke49990,peek(49990)+1:ifsu(sp)<61andso(5)=0thenss=ss*2
  869. 7469 if so(4)=1 thenss=ss*2
  870. 7470 if peek(49991)>0thenpoke49991,peek(49991)-1:ss=ss*2:tr$=tr$+" bock"
  871. 7471 if so(4)=1 and su(sp)<61thenpoke 49991,peek(49991)+3
  872. 7482 s3=peek(49990)
  873. 7483 gosub7600
  874. 7490 fori=1to5step2
  875. 7491 poke 50000+i-1+(s3-1)*8,h((i+1)/2)
  876. 7492 poke 50000+i+(s3-1)*8,l((i+1)/2)
  877. 7493 nexti
  878. 7494 poke 50006+(s3-1)*8,ss/256
  879. 7495 poke 50007+(s3-1)*8,ss-int(ss/256)*256
  880. 7496 print"[147]   spieler:[146]";su(sp);tab(20):su(sp)=0
  881. 7497 print"   team:   [146]";su(1)+su(2)+su(3)
  882. 7498 print "[144]";tr$;""
  883. 7499 print"  [176][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][174]"
  884. 7500 print"  [221]spiel.1[221]spiel.2[221]  sie  [221] spiel [221]"
  885. 7510 print"  [171][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][179]"
  886. 7520 print"  [221]       [221]       [221]       [221]       [221]"
  887. 7525 s4=s3-10:ifs4<1thens4=1
  888. 7530 for i1=s4tos3
  889. 7540 for i2=0to7step2:r=int(i2/2)
  890. 7550 a1=peek(50000+(i1-1)*8+i2)*256+peek(50001+(i1-1)*8+i2)
  891. 7555 av=peek(50000+(i1-2)*8+i2)*256+peek(50001+(i1-2)*8+i2)
  892. 7556 a1$=right$(str$(a1),len(str$(a1))-1)
  893. 7557 if a1=avandi2<6thena1$="--"
  894. 7560 a2=2+r*8+7-len(a1$)
  895. 7570 printtab(2+r*8);"[221]";tab(a2);"[144]"+a1$;"[145]"
  896. 7575 nexti2
  897. 7576 printtab(34)"[221]":nexti1
  898. 7577 print"  [173][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][189]"
  899. 7578 print"   bitte f1 druecken!
  900. 7580 [146]203,4:[161]l$:[156]:[138]110
  901. 7600 [143] spieler gew.
  902. 7601 [134] h(3):[134]l(3)
  903. 7605 m[178]1:[139] su(sp)[177]60[167]m[178]2
  904. 7615 [129] i[178]1[164]5[169]2:r[178](i[170]1)[173]2
  905. 7616 [139] r[178]sp[175]m[178]1[167]7620
  906. 7617 [139] r[179][177]sp[175]m[178]2[167]7620
  907. 7618 h(r)[178][194](50000[170]i[171]1[170](s3[171]2)[172]8)
  908. 7619 l(r)[178][194](50000[170]i[170](s3[171]2)[172]8)
  909. 7620 [130]i
  910. 7622 [129]i[178]1[164]5[169]2:r[178](i[170]1)[173]2
  911. 7623 [139] r[178]sp[175]m[178]2[167]7628
  912. 7624 [139] r[179][177]sp[175]m[178]1[167]7628
  913. 7625 q1[178][194](50000[170]i[171]1[170](s3[171]2)[172]8)[172]256[170][194](50000[170]i[170](s3[171]2)[172]8)
  914. 7626 q1[178]q1[170]ss
  915. 7627 h(r)[178][181](q1[173]256):l(r)[178]q1[171]h(r)[172]256
  916. 7628 [130]i
  917. 7630 [142]
  918. 8000 :
  919. 8010 au$[178]">karte nr.?<":[141]2700
  920. 8015 [139] ru[178]10[176](ru[178]9[175]so(1)[178]1[175]sp[178]3)[167]x[178]1:[137]8062
  921. 8020 [161]x$:[139]x$[178]""[167]8020
  922. 8030 x[178][197](x$):[139]x$[178]"0"[167]x[178]10
  923. 8040 [139] x[178]0[167]8020
  924. 8050 [139] x[177]11[171]ru[167]8020
  925. 8060 [139] kg(x,1)[179][177]fa[175]az[177]1[167][137]8080
  926. 8062 g1[178]kg(x,2):gg[178]kg(x,1)
  927. 8065 [141] 8100
  928. 8066 ko(3,kg(x,1),kg(x,2))[178]0
  929. 8067 kg(x,1)[178]0:kg(x,2)[178]0
  930. 8070 au$[178]"":[141]2700
  931. 8071 [141]7200
  932. 8075 [142]
  933. 8080 [129] i1[178]1[164](11[171]ru[171]so(1))
  934. 8085 [139] kg(i1,1)[178]fa[167]8020
  935. 8090 [130]i1
  936. 8095 [137]8062
  937. 8100 :
  938. 8120 [141] 3286
  939. 8121 g1[178]kg(x,2):gg[178]kg(x,1)
  940. 8125 [141]9000
  941. 8130 [153]""[166]15);"stop(NULL)tantantantantantantanright$"
  942. 8140 [129] i1[178]1[164]9
  943. 8150 [153][166]15);"stop(NULL)";ff$;ka$(gn,i1);"stop(NULL)"
  944. 8160 [130]i1
  945. 8170 [153][166]15);"stopmid$tantantantantantantan(NULL)onon"
  946. 9000 :
  947. 9001 :
  948. 9002 :
  949. 9003 gn[178]g1:[139]fe[179][177]5[176]g1[177]8[167]9010
  950. 9004 [139] g1[178]8[167]gn[178]6
  951. 9005 [139] g1[178]7[167]gn[178]gg
  952. 9006 [139] g1[178]6[176]g1[178]5[167]gn[178]g1[170]2
  953. 9007 [139] g1[178]4[167]gn[178]5
  954. 9010 [139]gn[179]5[167]gg[178]gn
  955. 9020 [139] gg[178]1[167]d$[178]"(NULL)"
  956. 9030 [139] gg[178]2[167]d$[178]"atn"
  957. 9040 [139] gg[178]3[167]d$[178]"(NULL)"
  958. 9050 [139] gg[178]4[167]d$[178]"(NULL)"
  959. 9051 ff$[178]"":[139] gg[179]3[167]ff$[178]"stop"
  960. 9053 [145]gn[137]9060,9060,9060,9060,9370,9470,9170,9270,9570,9670,9770
  961. 9060 ka$(gn,1)[178]"b     b"
  962. 9070 ka$(gn,2)[178]d$[170]"     "[170]d$
  963. 9080 ka$(gn,3)[178]" (NULL)tantantanright$ "
  964. 9090 ka$(gn,4)[178]" (NULL)(NULL) (NULL)(NULL) "
  965. 9110 ka$(gn,5)[178]" (NULL) (NULL) (NULL) "
  966. 9130 ka$(gn,6)[178]" (NULL)mid$tan(NULL)(NULL) "
  967. 9140 ka$(gn,7)[178]" mid$tantantan(NULL) "
  968. 9150 ka$(gn,8)[178]d$[170]"     "[170]d$
  969. 9160 ka$(gn,9)[178]"b     b"
  970. 9165 [142]
  971. 9170 ka$(7,1)[178]"k     k"
  972. 9180 ka$(7,2)[178]d$[170]"     "[170]d$
  973. 9190 ka$(7,3)[178]" (NULL)(NULL)(NULL)(NULL)right$ "
  974. 9200 ka$(7,4)[178]" (NULL)(NULL) (NULL)(NULL) "
  975. 9210 ka$(7,5)[178]" (NULL) (NULL) (NULL) "
  976. 9220 ka$(7,6)[178]" (NULL)(NULL)tanright$(NULL) "
  977. 9230 ka$(7,7)[178]" mid$tantantan(NULL) "
  978. 9240 ka$(7,8)[178]d$[170]"     "[170]d$
  979. 9250 ka$(7,9)[178]"k     k"
  980. 9260 [142]
  981. 9270 ka$(8,1)[178]"d     d"
  982. 9280 ka$(8,2)[178]d$[170]"     "[170]d$
  983. 9290 ka$(8,3)[178]" (NULL)(NULL)(NULL)(NULL)right$ "
  984. 9300 ka$(8,4)[178]" (NULL)(NULL) (NULL)(NULL) "
  985. 9310 ka$(8,5)[178]" (NULL) o (NULL) "
  986. 9320 ka$(8,6)[178]" (NULL)mid$tan(NULL)(NULL) "
  987. 9330 ka$(8,7)[178]" mid$tantantan(NULL) "
  988. 9340 ka$(8,8)[178]d$[170]"     "[170]d$
  989. 9350 ka$(8,9)[178]"d     d"
  990. 9360 [142]
  991. 9370 ka$(5,1)[178]"a     a"
  992. 9380 ka$(5,2)[178]d$[170]"     "[170]d$
  993. 9390 ka$(5,3)[178]"       "
  994. 9400 ka$(5,4)[178]"       "
  995. 9410 ka$(5,5)[178]"   "[170]d$[170]"   "
  996. 9420 ka$(5,6)[178]"       "
  997. 9430 ka$(5,7)[178]"       "
  998. 9440 ka$(5,8)[178]d$[170]"     "[170]d$
  999. 9450 ka$(5,9)[178]"a     a"
  1000. 9460 [142]
  1001. 9470 ka$(6,1)[178]"10   10"
  1002. 9480 ka$(6,2)[178]d$[170]d$[170]"   "[170]d$[170]d$
  1003. 9490 ka$(6,3)[178]d$[170]"     "[170]d$
  1004. 9500 ka$(6,4)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1005. 9510 ka$(6,5)[178]"  "[170]d$[170]" "[170]d$[170]"  "
  1006. 9520 ka$(6,6)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1007. 9530 ka$(6,7)[178]d$[170]"     "[170]d$
  1008. 9540 ka$(6,8)[178]d$[170]d$[170]"   "[170]d$[170]d$
  1009. 9550 ka$(6,9)[178]"10   10"
  1010. 9560 [142]
  1011. 9570 ka$(9,1)[178]"9     9"
  1012. 9580 ka$(9,2)[178]d$[170]"     "[170]d$
  1013. 9590 ka$(9,3)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1014. 9600 ka$(9,4)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1015. 9610 ka$(9,5)[178]"   "[170]d$[170]"   "
  1016. 9620 ka$(9,6)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1017. 9630 ka$(9,7)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1018. 9640 ka$(9,8)[178]d$[170]"     "[170]d$
  1019. 9650 ka$(9,9)[178]"9     9"
  1020. 9660 [142]
  1021. 9670 ka$(10,1)[178]"8     8"
  1022. 9680 ka$(10,2)[178]d$[170]"     "[170]d$
  1023. 9690 ka$(10,3)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1024. 9700 ka$(10,4)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1025. 9710 ka$(10,5)[178]"       "
  1026. 9720 ka$(10,6)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1027. 9730 ka$(10,7)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1028. 9740 ka$(10,8)[178]d$[170]"     "[170]d$
  1029. 9750 ka$(10,9)[178]"8     8"
  1030. 9760 [142]
  1031. 9770 ka$(11,1)[178]"7     7"
  1032. 9780 ka$(11,2)[178]d$[170]"     "[170]d$
  1033. 9790 ka$(11,3)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1034. 9800 ka$(11,4)[178]"   "[170]d$[170]"   "
  1035. 9810 ka$(11,5)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1036. 9820 ka$(11,6)[178]"       "
  1037. 9830 ka$(11,7)[178]" "[170]d$[170]"   "[170]d$[170]" "
  1038. 9840 ka$(11,8)[178]d$[170]"     "[170]d$
  1039. 9850 ka$(11,9)[178]"7     7"
  1040. 9860 [142]
  1041. 10000 [143] ramschen  pos1
  1042. 10005 [139] g3(n1,0)[171]an(n1,0)[177]0[167]aa$[178]"0000000401":[141]6500:[139]yy[178]2[167][142]
  1043. 10010 aa$[178]"010400-3-3":[141]6500:[139]yy[178]2[167][142]
  1044. 10020 aa$[178]"0104001105":[141]6500:[139]yy[178]2[167][142]
  1045. 10030 aa$[178]"0000000401":[141]6500:[142]
  1046. 10100 [143] ramschen pos 2
  1047. 10110 [139] an(n1,fa)[177]0[167]aa$[178]"-3-300-111-101":[141]6500:[142]
  1048. 10120 [139] ww(kv)[178]0[167]aa$[178]"-4-4000104":[141]6500:[139]yy[178]2[167][142]
  1049. 10130 [129]i1[178]1[164]2:[129]fa[178]1[164]4
  1050. 10131 [139] an(n1,fa)[178]i1[167]aa$[178]"-3-3000511":[141]6500:fa[178]df:[142]
  1051. 10132 [130]fa,i1:fa[178]df
  1052. 10133 aa$[178]"0104010511":[141]6500:[139]yy[178]2[167][142]
  1053. 10140 aa$[178]"0000000104":[141]6500:[142]
  1054. 10200 [143] ramschen pos 3
  1055. 10201 gh[178]ww(k(op))[170]ww(kv)
  1056. 10205 [139] an(n1,fa)[178]0[167]10230
  1057. 10210 [139] gh[177]7 [167]aa$[178]"-3-300-111-101":[141]6500:[139]yy[178]2[167][142]
  1058. 10220 [139] gh[179]8 [167]aa$[178]"-3-300-101-111":[141]6500:[139]yy[178]2[167][142]
  1059. 10230 [139] gh[179]8[167]aa$[178]"000000-2-2":[141]6500:[139]yy[178]2[167][142]
  1060. 10240 [137]10130
  1061. 20000 [151] 53280,5:[151]53281,8
  1062. 20001 [153]"load";
  1063. 20010 [153]"  (NULL)tantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantanright$"
  1064. 20020 [153]"  (NULL)(NULL)tantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantanright$(NULL)"
  1065. 20030 [153]"  (NULL)(NULL)                                 (NULL)(NULL)"
  1066. 20040 [153]"  (NULL)(NULL)  step  (NULL)step  (NULL) stepwaitstepstep   (NULL)     wait(NULL)(NULL)"
  1067. 20050 [153]"  (NULL)(NULL)   waitstep (NULL) waitstep (NULL) stepwaitstep     wait(NULL)(NULL)"
  1068. 20060 [153]"  (NULL)(NULL)   (NULL) (NULL) stepwaitstep   wait(NULL)(NULL)"
  1069. 20070 [153]"  (NULL)(NULL)  (NULL)  (NULL) wait(NULL)  (NULL)        wait(NULL)(NULL)"
  1070. 20080 [153]"  (NULL)(NULL)    (NULL) wait(NULL)  wait(NULL)(NULL)   wait(NULL)(NULL)"
  1071. 20090 [153]"  (NULL)(NULL)  (NULL)step (NULL)step  wait(NULL)(NULL)   wait(NULL)(NULL)"
  1072. 20100 [153]"  (NULL)(NULL)  (NULL)  waitstep(NULL)  waitstep wait(NULL)(NULL)   wait(NULL)(NULL)"
  1073. 20110 [153]"  (NULL)(NULL)                                 (NULL)(NULL)"
  1074. 20120 [153]"  (NULL)(NULL)    (w) joern scheller 1984      (NULL)(NULL)"
  1075. 20130 [153]"  (NULL)(NULL)            stoptotototototo               (NULL)(NULL)"
  1076. 20140 [153]"  (NULL)(NULL)            stopfn    then               (NULL)(NULL)"
  1077. 20150 [153]"  (NULL)(NULL)       stop (NULL)(NULL)  fn(NULL)  (NULL)then   (NULL)(NULL)          (NULL)(NULL)"
  1078. 20160 [153]"  (NULL)(NULL)stop       (NULL)  (NULL) fn    +  (NULL)  (NULL)         (NULL)(NULL)"
  1079. 20170 [153]"  (NULL)(NULL)stop      (NULL)  (NULL) (NULL)sgn(NULL)right$(NULL)right$then (NULL) (NULL)  (NULL)        (NULL)(NULL)"
  1080. 20180 [153]"  (NULL)(NULL)stop     (NULL)      fn    +(NULL)      (NULL)       (NULL)(NULL)"
  1081. 20190 [153]"  (NULL)(NULL)stop    (NULL)    (NULL)(NULL) fn (NULL)right$ (NULL)  (NULL)(NULL)    (NULL)      (NULL)(NULL)"
  1082. 20200 [153]"  (NULL)(NULL)stop    (NULL) (NULL) (NULL) (NULL)(NULL)fn mid$(NULL)(NULL)  (NULL)right$ (NULL) (NULL) (NULL)      (NULL)(NULL)"
  1083. 20210 [153]"  (NULL)(NULL)stop     (NULL)  (NULL)(NULL)(NULL)right$fn (NULL)(NULL)  (NULL)(NULL)right$right$(NULL)  (NULL)       (NULL)(NULL)"
  1084. 20220 [153]"  (NULL)(NULL)stop      (NULL)  (NULL)mid$(NULL)fn (NULL)  (NULL)thenmid$(NULL)(NULL)  (NULL)        (NULL)(NULL)"
  1085. 20230 [153]"  (NULL)(NULL)stop       (NULL)  (NULL)tab(fn(NULL)  (NULL)  tab((NULL)  (NULL)         (NULL)(NULL)onon"
  1086. 20250 [142]
  1087. 55555 [139] az[179][177]3[167][142]
  1088. 55556 [139] g3(i1,fa)[179][177]5[167][142]
  1089. 55557 [139] k(sp)[179][177]5[167][142]
  1090. 55558 [139] k(i9)[179][177]6[167][142]
  1091. 55559 g1(i1,i9,fa)[178]2:[142]
  1092. 60000 [135]a:[153]a,:[137]60000
  1093.