10 '######################################################
20 '#####                                            #####
30 '#####           Eberhard Fischer                 #####
40 '#####           Weizenkamp 37                    #####
50 '#####           2110 Buchholz i.d.Heide          #####
60 '#####           Tel.: 04181 - 38859              #####
70 '#####                                            #####
80 '#####           (c) Juni 1989                    #####
90 '#####                                            #####
100 '#####################################################
110 '
120 '######### Benutzerfunktionen definieren ############
130 '
140 escape$       =   CHR$(27)
150 home$         =   escape$     +    "H"
160 cls$          =   escape$     +    "E"  +  home$
170 DEF FNloc$(x,y) = escape$ + "Y" + CHR$(32 + y) + CHR$(32 + x)
180 window$ = escape$ + "X" + CHR$(32 + n)+CHR$(32 + n) + CHR$(32 + n)+ CHR$(32 + n)
190 inkan$        = escape$       +    "p" 
200 inkaus$       = escape$       +    "q"
210 '
220 '---------- Bildschirm - Anweisungen ----------------
230 '
240 B1$  =   escape$     +     "1"       :'Statuszeile an
250 B2$  =   escape$     +     "0"       :'statuszeile aus
260 B3$  =   escape$     +     "K"       :' Zeile L|schen
270 B4$  =   escape$     +     "A"       :' Cursor hoch
280 B5$  =   escape$     +     "B"       :' Cursor runter
290 B6$  =   escape$     +     "f"       :' Cursor aus
300 B7$  =   escape$     +     "e"       :' Cursor an
310 B8$  =   escape$     +     "C"       :' Cursor um 1 nach Rechts
320 B9$  =   escape$     +     "D"       :' Cursor um 1 nach Links
330 B10$ = escape$ + "c" + CHR$(0) + escape$ + "b" + CHR$(63):' Bildschirm hell
340 B11$ = escape$ + "c" + CHR$(63) + escape$ + "b" + CHR$(0):' Bildschirm dunkel
350 B12$ =   escape$     +     "y"       :' Bildschirm normal Modus
360 '
640 PRINT cls$;b6$
1000 '
1010 '############# Hauptprogramm ########################
1020 '
1030 runde = 1
1040 GOSUB 2000:' Spielerkl{rung
1050 DIM f(43):DIM p(50,50)
1060 x = 12:s = 1:l(1) = 1:r(1)	= 6:b(1) = 13:l(2) = 97:r(2) = 115:b(2) = 32:chip$(1) = CHR$(187):chip$(2) = CHR$(188):
1070 GOSUB 3000 :'Bildaufbau
1080 GOSUB 4000:'Tabelle schreiben
1090 '
1100 ' --------------- Pfeil bewegen ---------------------
1110 '
1120 sn = 112:text$ = STRING$(LEN(s$(s))+20," "):x% = 13:y% = 30:GOSUB 3500
1130 PRINT CHR$(7):sn = 112:text$ = s$(s) + " ist am Zug ":x% = 13:y% = 30:GOSUB 3500
1140 t$ = INKEY$:IF t$ = CHR$(l(s)) AND x > 12 THEN x = x - 4 ELSE IF t$ = CHR$(r(s)) AND x < 45 THEN x = x + 4 ELSE IF t$ = CHR$(b(s)) THEN GOTO 1160
1150  PRINT FNLOC$(x-4,5);"    ";chip$(s);"    ":GOTO 1140
1160 '
1170 '---------------- Chip einwerfen -----------------
1180 '
1190 a = x - 5:y = f(a):IF y < 19 THEN FOR sz = 7 TO 25-y STEP 2:PRINT FNLOC$(x,sz);chip$(s);FNloc$(x,sz-2);" ":NEXT
1200 p(a,y) = s:r = s:s = s + 1:IF s > 2 THEN s = 1
1210 IF f(a) < 20 THEN f(a) = f(a) + 2
1220 '
1230 ' --------- Senkrechte Reihen auswerten ----------
1240 '
1250 t = 0: FOR szz = 7 TO 43 STEP 4
1260 FOR sz = 0 TO f(szz) STEP 2
1270 IF p(szz,sz) < 1  THEN t = 0:GOTO 1290
1280 IF p(szz,sz) <> r THEN t = 0 ELSE t = t + 1
1290 IF t > 3 THEN GOTO 1800
1300 NEXT
1310 NEXT
1320 '
1330 ' ------- Waagerechte Reihen auswerten ------------
1340 '
1350 t = 0:FOR sz = 0 TO MAX(f(a)) STEP 2
1360 FOR szz = 7 TO 43 STEP 4
1370 IF p(szz,sz) <> r THEN t = 0 ELSE t = t + 1
1380 IF t > 3 THEN GOTO 1800
1390 NEXT
1400 NEXT
1410 'GOTO 1120
1420 '
1430 '------ Schr{ge von links unten nach rechts oben --
1440 '
1450 sx1 = 7:sy1 = 0:sx = sx1:sy = sy1
1460 FOR sz1 = 1 TO 7
1470 IF f(sx1) < 1 THEN GOTO 1580
1480 FOR sz2 = 1 TO 7
1490 IF p(sx1,sy1) < 1 THEN 1560
1500 t = 0
1510 FOR sz3 = 1 TO 4
1520 IF p(sx,sy) <> r THEN t = 0 ELSE t = t + 1
1530 sx = sx + 4:sy = sy + 2
1540 IF t > 3 THEN GOTO 1800
1550 NEXT sz3
1560 sx = sx1:sy1 = sy1 + 2:sy = sy1
1570 NEXT sz2
1580 sx1 = sx1 + 4:sx = sx1:sy1 = 0:sy = sy1
1590 NEXT sz1
1600 '
1610 '---- Schr{ge von recht unten nach links oben ---
1620 '
1630 sx1 = 43:sy1 = 0:sx = sx1:sy = sy1
1640 FOR sz1 = 1 TO 7
1650 IF f(sx1) < 1 THEN GOTO 1760
1660 FOR sz2 = 1 TO 7
1670 IF p(sx1,sy1) < 1 THEN 1740
1680 t = 0
1690 FOR sz3 = 1 TO 4
1700 IF p(sx,sy) <> r THEN t = 0 ELSE t = t + 1
1710 sx = sx - 4:sy = sy + 2
1720 IF t > 3 THEN GOTO 1800
1730 NEXT sz3
1740 sx = sx1:sy1 = sy1 + 2:sy = sy1
1750 NEXT sz2
1760 sx1 = sx1 - 4:sx = sx1:sy1 = 0:sy = sy1
1770 NEXT sz1
1780 GOTO 1120
1790 '
1800 '------------ Gewinner anzeigen --------------
1810 '
1820 sn = 167:text$ = STRING$(LEN(s$(s))+l2," "):x% = 13:y% = 30:GOSUB 3500
1830 sn = 49:text$ = ">>> "+ s$(r)+" hat g e w o n n e n <<<":x% = 13:y% = 30:GOSUB 3500
1840 gew(r) = gew(r) + 1
1850 FOR sz = 0 TO 300:OUT 248,11:OUT 248,12:NEXT
1860 GOSUB 4000:' Tabellenstand anzeigen
1870 '
1880 '----------- Neues Spiel abfragen ----------
1890 '
1900 sn = 16:text$ = "Neues Spiel  J - N":x% = 53:y% = 24:GOSUB 3500
1910 t$ = INKEY$:IF UPPER$(t$) = "J" THEN sn = 16:text$ = STRING$(20," "):x% = 53:y% = 24:GOSUB 3500:ERASE f:ERASE p:runde = runde + 1:PRINT cls$:GOTO 1050
1920 IF UPPER$(t$) = "N" THEN END
1930 GOTO 1910
1940 '
2000 '################ Spielerkl{rungen #################
2010 '
2020 PRINT FNloc$(25,2);" ****  V I E R    G E W I N N T  **** "
2030 PRINT FNloc$(5,5);" Spielerkl{rung :"
2040 PRINT FNloc$(5,6);"================="
2050 PRINT FNLOC$(2,7);" Es ist die Version eines oft umgesetzten Strategiespiels,indem man versucht,"
2060 PRINT FNLOC$(2,8);" durch Einwerfen von Spielsteinen in ein Raster,eine senkrechte oder waagerechte "
2070 PRINT FNLOC$(2,9);" Vierer-Reihe zu bekommen.Es ist f}r zwei Spieler ausgelegt,wobei f}r jeden Spieler"
2080 PRINT FNLOC$(2,10);" eine seperate Steuerung zur Verf}gung steht."
2090 PRINT FNLOC$(2,12);" Diese ist f}r Spieler 1 auf die Cursortasten und Return gelegt."
2100 PRINT FNLOC$(2,13);" F}r Spieler 2 wurden die Tasten A / S und Space vorgesehen."
2110 PRINT FNLOC$(2,14);" Auf Wunsch kann nat}rlich die Tastaturbelegung f}r Spieler 2 frei gew{hlt werden."
2120 PRINT FNLOC$(2,15);" In Zeile 1060 die ASCII-Werte {ndern:L und R f}r links und rechts sowie "
2130 PRINT FNLOC$(2,16);" B f}r Feuer."
2140 PRINT FNLOC$(2,18);" Man steuert nun den Spielchip auf die Reihe,in die man diesen einwerfen"
2150 PRINT FNLOC$(2,19);" m|chte und dr}ckt Feuer.Zum unterscheiden werden die Chips in Form eines hohlen "
2160 PRINT FNLOC$(2,20);" Kreises ";CHR$(187);" sowie des ausgef}llten Kreises ";CHR$(188);" ausgegeben."
2170 PRINT FNLOC$(2,21);" Wer zuerst eine oben genannte Reihe erreicht,ist Sieger des Spiels."
2180 PRINT FNLOC$(2,23);" Sollte auf die Eingabe nach dem Namen der Mitspieler verzichtet werden,"
2190 PRINT FNLOC$(2,24);" wird nach bet{tigen der RETURN-TASTE automatisch eine Defination vorgenommen."
2200 PRINT FNLOC$(25,29);" Weiter ?   Bitte Taste dr}cken "
2210 GOSUB 5000	:' MC - Programm laden
2220 '---------- Taste ----------
2230 t$ = INKEY$
2240 IF t$ <> CHR$(32) THEN 2230 ELSE PRINT cls$:RETURN
2250 '
3000 '############ Bildaufbau #######################
3010 '
3020 sn = 115:Text$ = " * VIER GEWINNT * ":x% = 28:y% = 2:GOSUB 3500
3030 '
3040 '------------------- Reihe oben ----------------
3050 '
3060 zei = 10:spa = 6
3070 PRINT FNloc$(zei,spa);CHR$(134);FNloc$(zei+40,spa);CHR$(140):zei = zei + 1
3080 FOR sz = 1 TO 9
3090 PRINT FNloc$(zei,spa);STRING$(3,CHR$(138));CHR$(132);STRING$(3,CHR$(138))
3100 zei = zei + 4
3110 NEXT
3120 '
3130 '------------------ Reihe senkrecht --------------
3140 '
3150 FOR szz = 1 TO 19
3160 zei = 10:spa = spa + 1
3170 PRINT FNloc$(zei,spa);CHR$(133);FNloc$(zei + 40,spa);CHR$(133):zei = zei + 4
3180 FOR sz = 1 TO 8
3190 PRINT FNloc$(zei,spa);CHR$(149);"   ";CHR$(149)
3200 zei = zei + 4
3210 NEXT
3220 NEXT
3230 '
3240 ' ------------------- Reihe unten ----------------
3250 '
3260 zei = 10:spa = spa + 1
3270 PRINT FNloc$(zei,spa);CHR$(131);FNloc$(zei+40,spa);CHR$(137):zei = zei + 1
3280 FOR sz = 1 TO 9
3290 PRINT FNloc$(zei,spa);STRING$(3,CHR$(138));CHR$(129);STRING$(3,CHR$(138))
3300 zei = zei + 4
3310 NEXT
3320 '
3330 '------------------ Reihe waagerecht -----------
3340 '
3350 zei = 10:spa = 6
3360 FOR szz = 1 TO 9
3370 spa = spa + 2
3380 PRINT FNloc$(zei,spa);CHR$(130);FNloc$(zei+40,spa);CHR$(136):zei = zei + 1
3390 FOR sz = 1 TO 9
3400 PRINT FNloc$(zei,spa);STRING$(3,CHR$(154));CHR$(159);STRING$(3,CHR$(154))
3410 zei = zei + 4
3420 NEXT
3430 zei = 10
3440 NEXT
3450 IF s$(1) = "" THEN PRINT FNLOC$(52,10);:INPUT " Name Spieler 1 : ";s$(1):PRINT FNLOC$(52,14);:INPUT " Name Spieler 2 : ";s$(2):PRINT FNloc$(52,10);STRING$(35," ");FNLOC$(52,14);STRING$(35," ")
3460 s$(1) = LEFT$(s$(1),12):s$(2) = LEFT$(s$(2),12)
3470 IF s$(1)="" THEN s$(1) = "Spieler 1" ELSE s$(1)=UPPER$(s$(1))
3480 IF s$(2)="" THEN s$(2) = "Spieler 2" ELSE s$(2)=UPPER$(s$(2))
3490 RETURN
3500 '
3510 '----------------- Texte schreiben ---------
3520 '
3530 titel$ = CHR$(27) + CHR$(sn):schrift$ = titel$ + text$:CALL script(x%,y%,schrift$)
3540 RETURN
3550 '
4000 ' #################### Tabelle ###################
4010 '
4020 sn = 49:text$ = "Runde : "+ STR$(runde):x% = 54:y% = 9:GOSUB 3500
4030 sn = 49:text$ = "=== GEWONNEN ===":x% = 54:y% = 15:GOSUB 3500
4040 sn = 49:text$ = s$(1)+ STRING$(12-LEN(s$(1))," ")+": ":x% = 54:y% = 18:GOSUB 3500
4050 sn = 49:text$ = s$(2)+ STRING$(12-LEN(s$(2))," ")+": ":x% = 54:y% = 20:GOSUB 3500
4060 IF gew(1) < 10 THEN sn = 49:text$ = STR$(gew(1)):x% = 82:y% = 18:GOSUB 3500
4070 IF	gew(1) > 9 THEN sn = 49:text$ = STR$(gew(1)):x% = 80:y% = 18:GOSUB 3500
4080 IF gew(2) < 10 THEN sn = 49:text$ = STR$(gew(2)):x% = 82:y% = 20:GOSUB 3500
4090 IF	gew(2) > 9 THEN sn = 49:text$ = STR$(gew(2)):x% = 80:y%	20:GOSUB 3500
4100 RETURN
4110 '
5000 '####### Script - MC.Lader ##################
5010 '
5020 MEMORY &HEFFF
5030 FOR adr=&HF000 TO &HF1C9
5040 READ byte$:v=VAL("&H"+byte$):s=s+v:POKE adr,v
5050 NEXT
5060 IF s<>55722! THEN PRINT"DATAFEHLER !!!":END
5070 '
5080 DATA 6E,1A,67,2D,25,22,BD,F1
5090 DATA 69,60,7E,B7,C8,4F,06,00
5100 DATA 32,BC,F1,23,7E,23,66,6F
5110 DATA 11,E9,F1,ED,B0,01,26,F0
5120 DATA CD,5A,FC,E9,00,C9,3A,BC
5130 DATA F1,47,21,E9,F1,7E,FE,1B
5140 DATA 20,0B,23,05,C8,7E,32,BB
5150 DATA F1,23,05,C8,7E,C5,E5,6F
5160 DATA 26,00,29,29,29,11,00,B8
5170 DATA 19,11,C9,F1,01,08,00,ED
5180 DATA B0,21,01,01,22,BF,F1,3A
5190 DATA BB,F1,FE,FF,28,29,1F,DC
5200 DATA BC,F0,1F,DC,CE,F0,1F,DC
5210 DATA B6,F0,1F,DC,DE,F0,1F,DC
5220 DATA EC,F0,1F,DC,17,F1,1F,DC
5230 DATA 3D,F1,1F,DC,3A,F1,CD,66
5240 DATA F1,E1,C1,23,10,A7,C9,21
5250 DATA C9,F1,06,08,ED,5B,BD,F1
5260 DATA 7A,90,57,14,C5,D5,E5,06
5270 DATA 08,4E,CB,01,21,C9,F1,38
5280 DATA 03,21,C1,F1,CD,92,F1,1C
5290 DATA 7B,10,EF,E1,D1,C1,23,10
5300 DATA E2,32,BD,F1,18,CB,21,D0
5310 DATA F1,36,FF,C9,F5,21,C9,F1
5320 DATA 06,08,7E,CB,3F,A6,77,23
5330 DATA 10,F8,F1,CB,87,C9,F5,21
5340 DATA C9,F1,06,08,7E,CB,3F,B6
5350 DATA 77,23,10,F8,F1,C9,F5,21
5360 DATA C9,F1,06,08,7E,2F,77,23
5370 DATA 10,FA,F1,C9,F5,3E,02,32
5380 DATA BF,F1,DD,21,C9,F1,0E,08
5390 DATA 06,08,DD,7E,00,1F,DD,CB
5400 DATA 00,1E,DD,CB,10,1E,DD,CB
5410 DATA 00,2E,DD,CB,10,1E,10,ED
5420 DATA DD,23,0D,20,E3,F1,C9,3E
5430 DATA 02,32,C0,F1,11,D0,F1,CD
5440 DATA 2A,F1,3A,BF,F1,3D,C8,11
5450 DATA E0,F1,21,08,00,19,06,08
5460 DATA 1A,1B,77,2B,77,2B,10,F8
5470 DATA AF,C9,AF,18,02,3E,02,32
5480 DATA C0,F1,11,D8,F1,CD,50,F1
5490 DATA 3A,BF,F1,3D,C8,11,E8,F1
5500 DATA CD,5C,F1,21,FC,FF,19,01
5510 DATA 08,00,ED,B8,AF,12,1B,12
5520 DATA 1B,12,1B,12,1B,C9,21,C9
5530 DATA F1,ED,4B,BF,F1,ED,5B,BD
5540 DATA F1,D5,E5,15,05,05,CC,92
5550 DATA F1,14,CD,92,F1,14,04,04
5560 DATA CC,92,F1,E1,11,10,00,19
5570 DATA D1,1C,0D,20,E4,ED,53,BD
5580 DATA F1,C9,7B,FE,5A,D0,7A,FE
5590 DATA 20,D0,C5,D5,E5,16,00,07
5600 DATA 17,17,17,6F,7A,CE,B6,67
5610 DATA 7E,23,66,6F,EB,29,29,19
5620 DATA 29,EB,E1,01,08,00,ED,B0
5630 DATA D1,C1,C9,00,00,00,00,00
5640 DATA 00,00,00,00,00,00,00,00
5650 DATA 00,00
5660 '
5670 script=&HF000
5680 '
5690 RETURN