home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 17 / 64er_Magazin_Sonderheft_17_19xx_Markt__Technik_de_Side_B.d64 / solitaire (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  4KB  |  166 lines
  1. 1000 rem *************************
  2. 1010 rem *                       *
  3. 1020 rem *   s o l i t a i r e   *
  4. 1030 rem *                       *
  5. 1040 rem *  von dirk eumann      *
  6. 1050 rem *      itzehoer str. 7c *
  7. 1060 rem *      2300 kiel - 1    *
  8. 1070 rem *                       *
  9. 1080 rem *************************
  10. 1090 :
  11. 1100 rem --- farben -------------------
  12. 1110 :
  13. 1120 hf =11 :rem hintergrund/rahmen
  14. 1130 f0$="":rem cursor
  15. 1140 f1$="[144]":rem leere felder
  16. 1150 f2$="[152]":rem gitter
  17. 1160 f3$="[155]":rem besetzte felder
  18. 1170 :
  19. 1180 rem --- spielfeldelemente --------
  20. 1190 :
  21. 1200 x$ =f3$+"[209]"+f2$+"[192]"
  22. 1210 x1$=x$+x$+x$+x$+f3$+"[209]"
  23. 1220 x2$=f2$+"[221] [221] [221][160][221][160][221]"
  24. 1230 x3$=x$+x$+x$+x$+x$+x$+x$+x$+x1$
  25. 1240 x4$=f2$+"[221] [221] [221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221] [221]"
  26. 1250 x5$=left$(x3$,24)+f1$+"[215]"+mid$(x3$,27)
  27. 1260 :
  28. 1270 rem --- weitere variable ---------
  29. 1280 :
  30. 1290 bs=1024 :rem video-ram
  31. 1300 fs=55296:rem farb-ram
  32. 1310 js=56320:rem joystick port#2
  33. 1320 r =104  :rem restliche steine
  34. 1330 wa=600  :rem dauer warteschleife
  35. 1340 :
  36. 1350 poke53280,hf:poke53281,hf
  37. 1360 printchr$(9)chr$(142)chr$(8)chr$(147);
  38. 1370 gosub2410:rem spielfeld
  39. 1380 :
  40. 1390 rem ------------------------------
  41. 1400 rem  steuerung
  42. 1410 rem ------------------------------
  43. 1420 fori=1to100:next
  44. 1430 poke204,0:geta$
  45. 1440 j=peek(js):if(jand31)=31 and a$=""then1430
  46. 1450 poke205,2
  47. 1460 ifpeek(207)then1460
  48. 1470 poke204,1:cz=peek(214):cs=peek(211)
  49. 1480 ifa$=" "thenf=1:poke53281,15:goto1360
  50. 1490 if(jand16)=0thengosub1830:goto1420
  51. 1500 if(jand1) =0thengosub1580:goto1420
  52. 1510 if(jand2) =0thengosub1640:goto1420
  53. 1520 if(jand4) =0thengosub1760:goto1420
  54. 1530 if(jand8) =0thengosub1700:goto1420
  55. 1540 goto1420
  56. 1550 :
  57. 1560 rem --- oben ---------------------
  58. 1570 :
  59. 1580 if cz<=0 then return
  60. 1590 if cz<=8 thenif cs<15 or cs>23 thenreturn
  61. 1600 printf0$"[145][145]";:return
  62. 1610 :
  63. 1620 rem --- unten --------------------
  64. 1630 :
  65. 1640 if cz>=24 then return
  66. 1650 if cz>=16 thenif cs<15 or cs>23 thenreturn
  67. 1660 printf0$"";:return
  68. 1670 :
  69. 1680 rem --- rechts -------------------
  70. 1690 :
  71. 1700 if cs>=31 then return
  72. 1710 if cs>=23 thenif cz<8 or cz>16 thenreturn
  73. 1720 printf0$"";:return
  74. 1730 :
  75. 1740 rem --- links --------------------
  76. 1750 :
  77. 1760 if cs<=7 then return
  78. 1770 if cs<=15 thenif cz<8 or cz>16 then return
  79. 1780 printf0$"[157][157]";:return
  80. 1790 :
  81. 1800 rem ------------------------------
  82. 1810 rem  sprung
  83. 1820 rem ------------------------------
  84. 1830 z=peek(bs+40*cz+cs):if z<>81 thenreturn
  85. 1840 if(jand1)=0then1920
  86. 1850 if(jand2)=0then2020
  87. 1860 if(jand4)=0then2220
  88. 1870 if(jand8)=0then2120
  89. 1880 return
  90. 1890 :
  91. 1900 rem --- oben ---------------------
  92. 1910 :
  93. 1920 z1=peek(bs+40*(cz-2)+cs)
  94. 1930 z2=peek(bs+40*(cz-4)+cs):gosub2330
  95. 1940 if f then f=0:goto2350
  96. 1950 fori=0to2:x=40*(cz-2*i)+cs:pokebs+x,86:pokefs+x,abs(i>1):next
  97. 1960 fori=1towa:next
  98. 1970 printf1$"[215]";:poke214,cz-2:poke211,cs:sys58640:print"[215]";
  99. 1980 poke214,cz-4:poke211,cs:sys58640:printf3$"[209][157]"f0$;:return
  100. 1990 :
  101. 2000 rem --- unten --------------------
  102. 2010 :
  103. 2020 z1=peek(bs+40*(cz+2)+cs)
  104. 2030 z2=peek(bs+40*(cz+4)+cs):gosub2330
  105. 2040 if f then f=0:goto2350
  106. 2050 fori=0to2:x=40*(cz+2*i)+cs:pokebs+x,86:pokefs+x,abs(i>1):next
  107. 2060 fori=1towa:next
  108. 2070 printf1$"[215]";:poke214,cz+2:poke211,cs:sys58640:print"[215]";
  109. 2080 poke214,cz+4:poke211,cs:sys58640:printf3$"[209][157]"f0$;:return
  110. 2090 :
  111. 2100 rem --- rechts -------------------
  112. 2110 :
  113. 2120 z1=peek(bs+40*cz+(cs+2))
  114. 2130 z2=peek(bs+40*cz+(cs+4)):gosub2330
  115. 2140 if f then f=0:goto2350
  116. 2150 fori=0to2:x=40*cz+(cs+2*i):pokebs+x,86:pokefs+x,abs(i>1):next
  117. 2160 fori=1towa:next
  118. 2170 printf1$"[215]";:poke214,cz:poke211,cs+2:sys58640:print"[215]";
  119. 2180 poke214,cz:poke211,cs+4:sys58640:printf3$"[209][157]"f0$;:return
  120. 2190 :
  121. 2200 rem --- links --------------------
  122. 2210 :
  123. 2220 z1=peek(bs+40*cz+(cs-2))
  124. 2230 z2=peek(bs+40*cz+(cs-4)):gosub2330
  125. 2240 if f then f=0:goto2350
  126. 2250 fori=0to2:x=40*cz+(cs-2*i):pokebs+x,86:pokefs+x,abs(i>1):next
  127. 2260 fori=1towa:next
  128. 2270 printf1$"[215]";:poke214,cz:poke211,cs-2:sys58640:print"[215]";
  129. 2280 poke214,cz:poke211,cs-4:sys58640:printf3$"[209][157]"f0$;:return
  130. 2290 :
  131. 2300 rem ------------------------------
  132. 2310 rem  eingabefehler/rest
  133. 2320 rem ------------------------------
  134. 2330 if z1<>81 or z2<>87 thenf=1:return
  135. 2340 r=r-1:print""f2$;tab(32)r"[157] "
  136. 2350 poke214,cz:poke211,cs:sys58640
  137. 2360 return
  138. 2370 :
  139. 2380 rem -----------------------------
  140. 2390 rem  spielfeld ausgeben
  141. 2400 rem -----------------------------
  142. 2410 printtab(15)x1$f2$"   rest:";r
  143. 2420 printtab(15)x2$
  144. 2430 printtab(15)x1$:printtab(15)x2$
  145. 2440 printtab(15)x1$:printtab(15)x2$
  146. 2450 printtab(15)x1$:printtab(15)x2$
  147. 2460 printtab( 7)x3$:printtab( 7)x4$
  148. 2470 printtab( 7)x3$:printtab( 7)x4$
  149. 2480 printtab( 7)x5$:printtab( 7)x4$
  150. 2490 printtab( 7)x3$:printtab( 7)x4$
  151. 2500 printtab( 7)x3$:printtab(15)x2$
  152. 2510 printtab(15)x1$:printtab(15)x2$
  153. 2520 printtab(15)x1$:printtab(15)x2$
  154. 2530 printtab(15)x1$:printtab(15)x2$
  155. 2540 printtab(15)x1$;f0$;
  156. 2550 iffthenf=0:goto 2630
  157. 2560 f=1:print"":fori=1to9:print:next
  158. 2570 printtab(9)f1$"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  159. 2580 printtab(9)"[221]"f0$" *** solitaire *** "f1$"[221]"
  160. 2590 printtab(9)"[221]                   [221]"
  161. 2600 printtab(9)"[221]"f2$"(c)1986 dirk eumann"f1$"[221]"
  162. 2610 printtab(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  163. 2620 fori=1to3000:next:print"";:poke53281,15:goto2410
  164. 2630 poke214,12:poke211,19:sys58640
  165. 2640 poke53281,hf:return
  166.