64'er Special 17/64er_Magazin_Sonderheft_17_19xx_Markt__Technik_de_Side_B.d64/solitaire

Commodore BASIC | 1990-01-01 | 4.0 KB | 166 lines

1000 rem *************************
1010 rem *                       *
1020 rem *   s o l i t a i r e   *
1030 rem *                       *
1040 rem *  von dirk eumann      *
1050 rem *      itzehoer str. 7c *
1060 rem *      2300 kiel - 1    *
1070 rem *                       *
1080 rem *************************
1090 :
1100 rem --- farben -------------------
1110 :
1120 hf =11 :rem hintergrund/rahmen
1130 f0$="":rem cursor
1140 f1$="[144]":rem leere felder
1150 f2$="[152]":rem gitter
1160 f3$="[155]":rem besetzte felder
1170 :
1180 rem --- spielfeldelemente --------
1190 :
1200 x$ =f3$+"[209]"+f2$+"[192]"
1210 x1$=x$+x$+x$+x$+f3$+"[209]"
1220 x2$=f2$+"[221] [221] [221][160][221][160][221]"
1230 x3$=x$+x$+x$+x$+x$+x$+x$+x$+x1$
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]"
1250 x5$=left$(x3$,24)+f1$+"[215]"+mid$(x3$,27)
1260 :
1270 rem --- weitere variable ---------
1280 :
1290 bs=1024 :rem video-ram
1300 fs=55296:rem farb-ram
1310 js=56320:rem joystick port#2
1320 r =104  :rem restliche steine
1330 wa=600  :rem dauer warteschleife
1340 :
1350 poke53280,hf:poke53281,hf
1360 printchr$(9)chr$(142)chr$(8)chr$(147);
1370 gosub2410:rem spielfeld
1380 :
1390 rem ------------------------------
1400 rem  steuerung
1410 rem ------------------------------
1420 fori=1to100:next
1430 poke204,0:geta$
1440 j=peek(js):if(jand31)=31 and a$=""then1430
1450 poke205,2
1460 ifpeek(207)then1460
1470 poke204,1:cz=peek(214):cs=peek(211)
1480 ifa$=" "thenf=1:poke53281,15:goto1360
1490 if(jand16)=0thengosub1830:goto1420
1500 if(jand1) =0thengosub1580:goto1420
1510 if(jand2) =0thengosub1640:goto1420
1520 if(jand4) =0thengosub1760:goto1420
1530 if(jand8) =0thengosub1700:goto1420
1540 goto1420
1550 :
1560 rem --- oben ---------------------
1570 :
1580 if cz<=0 then return
1590 if cz<=8 thenif cs<15 or cs>23 thenreturn
1600 printf0$"[145][145]";:return
1610 :
1620 rem --- unten --------------------
1630 :
1640 if cz>=24 then return
1650 if cz>=16 thenif cs<15 or cs>23 thenreturn
1660 printf0$"";:return
1670 :
1680 rem --- rechts -------------------
1690 :
1700 if cs>=31 then return
1710 if cs>=23 thenif cz<8 or cz>16 thenreturn
1720 printf0$"";:return
1730 :
1740 rem --- links --------------------
1750 :
1760 if cs<=7 then return
1770 if cs<=15 thenif cz<8 or cz>16 then return
1780 printf0$"[157][157]";:return
1790 :
1800 rem ------------------------------
1810 rem  sprung
1820 rem ------------------------------
1830 z=peek(bs+40*cz+cs):if z<>81 thenreturn
1840 if(jand1)=0then1920
1850 if(jand2)=0then2020
1860 if(jand4)=0then2220
1870 if(jand8)=0then2120
1880 return
1890 :
1900 rem --- oben ---------------------
1910 :
1920 z1=peek(bs+40*(cz-2)+cs)
1930 z2=peek(bs+40*(cz-4)+cs):gosub2330
1940 if f then f=0:goto2350
1950 fori=0to2:x=40*(cz-2*i)+cs:pokebs+x,86:pokefs+x,abs(i>1):next
1960 fori=1towa:next
1970 printf1$"[215]";:poke214,cz-2:poke211,cs:sys58640:print"[215]";
1980 poke214,cz-4:poke211,cs:sys58640:printf3$"[209][157]"f0$;:return
1990 :
2000 rem --- unten --------------------
2010 :
2020 z1=peek(bs+40*(cz+2)+cs)
2030 z2=peek(bs+40*(cz+4)+cs):gosub2330
2040 if f then f=0:goto2350
2050 fori=0to2:x=40*(cz+2*i)+cs:pokebs+x,86:pokefs+x,abs(i>1):next
2060 fori=1towa:next
2070 printf1$"[215]";:poke214,cz+2:poke211,cs:sys58640:print"[215]";
2080 poke214,cz+4:poke211,cs:sys58640:printf3$"[209][157]"f0$;:return
2090 :
2100 rem --- rechts -------------------
2110 :
2120 z1=peek(bs+40*cz+(cs+2))
2130 z2=peek(bs+40*cz+(cs+4)):gosub2330
2140 if f then f=0:goto2350
2150 fori=0to2:x=40*cz+(cs+2*i):pokebs+x,86:pokefs+x,abs(i>1):next
2160 fori=1towa:next
2170 printf1$"[215]";:poke214,cz:poke211,cs+2:sys58640:print"[215]";
2180 poke214,cz:poke211,cs+4:sys58640:printf3$"[209][157]"f0$;:return
2190 :
2200 rem --- links --------------------
2210 :
2220 z1=peek(bs+40*cz+(cs-2))
2230 z2=peek(bs+40*cz+(cs-4)):gosub2330
2240 if f then f=0:goto2350
2250 fori=0to2:x=40*cz+(cs-2*i):pokebs+x,86:pokefs+x,abs(i>1):next
2260 fori=1towa:next
2270 printf1$"[215]";:poke214,cz:poke211,cs-2:sys58640:print"[215]";
2280 poke214,cz:poke211,cs-4:sys58640:printf3$"[209][157]"f0$;:return
2290 :
2300 rem ------------------------------
2310 rem  eingabefehler/rest
2320 rem ------------------------------
2330 if z1<>81 or z2<>87 thenf=1:return
2340 r=r-1:print""f2$;tab(32)r"[157] "
2350 poke214,cz:poke211,cs:sys58640
2360 return
2370 :
2380 rem -----------------------------
2390 rem  spielfeld ausgeben
2400 rem -----------------------------
2410 printtab(15)x1$f2$"   rest:";r
2420 printtab(15)x2$
2430 printtab(15)x1$:printtab(15)x2$
2440 printtab(15)x1$:printtab(15)x2$
2450 printtab(15)x1$:printtab(15)x2$
2460 printtab( 7)x3$:printtab( 7)x4$
2470 printtab( 7)x3$:printtab( 7)x4$
2480 printtab( 7)x5$:printtab( 7)x4$
2490 printtab( 7)x3$:printtab( 7)x4$
2500 printtab( 7)x3$:printtab(15)x2$
2510 printtab(15)x1$:printtab(15)x2$
2520 printtab(15)x1$:printtab(15)x2$
2530 printtab(15)x1$:printtab(15)x2$
2540 printtab(15)x1$;f0$;
2550 iffthenf=0:goto 2630
2560 f=1:print"":fori=1to9:print:next
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]"
2580 printtab(9)"[221]"f0$" *** solitaire *** "f1$"[221]"
2590 printtab(9)"[221]                   [221]"
2600 printtab(9)"[221]"f2$"(c)1986 dirk eumann"f1$"[221]"
2610 printtab(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
2620 fori=1to3000:next:print"";:poke53281,15:goto2410
2630 poke214,12:poke211,19:sys58640
2640 poke53281,hf:return