Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Laser 2.1 für QBASIC (ohne Level)
| Uploader: |  nemored |
| Datum/Zeit: | 27.07.2009 18:16:09 |
DEFINT A-Z
DECLARE SUB vertausche (x, y)
DECLARE SUB hilfe ()
DECLARE FUNCTION inputt (x, y, ret)
DECLARE SUB warte (zeit)
DECLARE SUB laden (nr) : DECLARE SUB speichern (nr)
DECLARE SUB alleladen () : DECLARE SUB allespeichern ()
DECLARE SUB neu () : DECLARE SUB laserweg (opt)
DECLARE SUB hin (x, y) : DECLARE SUB introrech (x, y, r)
DECLARE SUB rechne () : DECLARE SUB rech (x, y, r, zaehl)
DECLARE SUB fort (x, y) : DECLARE SUB weg (x, y, r)
DECLARE SUB zeichne () : DECLARE SUB ueberblick (beginn, wo)
DECLARE SUB st (x, y) : DECLARE SUB stklein (wo, nrr, xx, yy)
DECLARE SUB Editor () : DECLARE SUB GesamtEditor ()
DECLARE FUNCTION Spiel () : DECLARE SUB Spiellauf (nr)
DECLARE FUNCTION MIN (x1, x2) : DECLARE FUNCTION MAX (x1, x2)
DIM f(0 TO 33, 0 TO 25), f2(1 TO 32, 5 TO 24), las(1 TO 32, 5 TO 24)
COMMON SHARED f()
CLEAR , , 10000
DIM feld(1 TO 50, 1 TO 32, 5 TO 24), optionen(0 TO 50, 1 TO 10)
DIM Leute(1 TO 2, 0 TO 50), Spielfolge(99)
'OPEN "LASER.LEV" FOR BINARY AS #1 LEN = 2
'levanz = 0: PUT #1, 1, levanz: CLOSE
'END
SCREEN 12
'D A T E N
FOR i = 0 TO 33: f(i, 5) = 30: f(i, 25) = 30: NEXT
FOR i = 6 TO 24: f(0, i) = 30: f(33, i) = 30: NEXT
DIM schnell$(2): schnell$(0) = "schnell": schnell$(1) = "normal": schnell$(2) = "langsam"
OPEN "LASER.LEV" FOR BINARY AS #1: GET #1, 1, levanz: CLOSE
wmax = 50: DIM wx(wmax), wy(wmax), wt(wmax)
READ anz: DIM Spiegel$(anz), leer(1 TO 199), leerklein(1 TO 99), dat(anz, 1 TO 6)
CLS : GET (0, 0)-(19, 19), leer: GET (0, 0)-(4, 4), leerklein
FOR i = 0 TO anz: FOR k = 1 TO 6: READ dat(i, k): NEXT: READ Spiegel$(i): NEXT
'dat(x,6): betretbar + 2*(Laser sichtbar waag) + 4*(Laser sichtbar senk)
DATA 37
DATA 1,2,4,8,0,7,"C15BM+10,+8D4BH2R4" : 'leer (+)
DATA 0,0,0,0,1,2,"C4BM+7,+17U14R2U3R1D3R1U3D3R2D6M+6,-3M-6,+3D2M+6,+3M-6,-3D6L6" : 'LaserO
DATA 0,0,0,0,2,2,"C4BM+13,+3D14L2D3L1U3L1D3U3L2U6M-6,+3M+6,-3U2M-6,-3M+6,+3U6R6" : 'LaserU
DATA 0,0,0,0,3,2,"C4BM+17,+13L14U2L3U1R3U1L3R3U2R6M-3,-6M+3,+6R2M+3,-6M-3,+6R6D6": 'LaserL
DATA 0,0,0,0,4,2,"C4BM+3,+7R14D2R3D1L3D1R3L3D2L6M+3,+6M-3,-6L2M-3,+6M+3,-6L6U6" : 'LaserR
DATA 0,0,0,0,5,0,"C8BM+10,+1RFDGLHUEBDP6,8BM+0,+2DC4R2FD5L5U5EBDP14,4BM-1,+7C1D6R2M+0,-4M+1,+4R2U7L5BFP3,1": 'Mann 1
DATA 1,2,4,8,36,7,"" : 'Loch zu
DATA 0,0,0,0,7,0,"C15BM+10,+19M-5,-10M+3,+2M+2,+8M+2,-8NL4M+3,-2NM-5,+10M-2,-2L5M-3,+2": 'Diamant 2
DATA 1,2,4,8,8,6,"C8BM+8,+2RFDGLHUEBDP6,8BM+0,+2DC4R2FD5L5U5EBDP14,4BM-1,+7C1D2FR8U4L8BDP3,1": 'Sitzer1
DATA 1,2,4,8,9,6,"C8BM+12,+2RFDGLHUEBDP6,8BM+0,+2DC2R2FD5L5U5EBDP10,2BM-1,+7C4L4D3R8EU2L4BDP14,4": 'Sitzer2
DATA 0,0,0,0,10,0,"C8BM+10,+1RFDGLHUEBDP6,8BM+0,+2DC2R2FD5L5U5EBDP10,2BM-1,+7C4D6R2M+0,-4M+1,+4R2U7L5BFP14,4": 'Mann 2
DATA 4,8,1,2,0,0,"C3BM+2,+6F12E4H12G4BM+8,+4P3,3" : 'SpiegOL
DATA 8,4,2,1,0,0,"C3BM+17,+6G12H4E12F4BM-9,+4P3,3" : 'SpiegOR
DATA 4,8,1,2,14,0,"C3BM+2,+6F12E4H12G4BM+8,+4P3,3C0RDLU" : 'SpiegOLfest
DATA 8,4,2,1,13,0,"C3BM+17,+6G12H4E12F4BM-9,+4P3,3C0RDLU": 'SpiegORfest
DATA 5,10,5,10,0,0,"C3BM+2,+6F12E4H12G4" : 'DurchOL
DATA 9,6,6,9,0,0,"C3BM+17,+6G12H4E12F4" : 'DurchOR
DATA 5,10,5,10,18,0,"C3BM+2,+6F12E4H12G4BM+8,+4RDLU" : 'DurchOLfest
DATA 9,6,6,9,17,0,"C3BM+17,+6G12H4E12F4BM-9,+4RDLU" : 'DurchORfest
DATA 0,12,1,1,0,0,"C2BM+11,+6F8L17E8F7L13E7" : 'EckO
DATA 8,8,3,0,0,0,"C2BM+15,+11G8U17F8G7U13F7" : 'EckR
DATA 12,0,2,2,0,0,"C2BM+10,+15H8R17G8H7R13G7" : 'EckU
DATA 4,4,0,3,0,0,"C2BM+6,+10E8D17H8E7D13H7" : 'EckL
DATA 0,12,1,1,24,0,"C2BM+11,+6F8L17E8F7L13E7BM+0,+4DLUR" : 'EckOfest
DATA 8,8,3,0,25,0,"C2BM+15,+11G8U17F8G7U13F7BM-4,+0LURD" : 'EckRfest
DATA 12,0,2,2,26,0,"C2BM+10,+15H8R17G8H7R13G7BM+0,-4URDL" : 'EckUfest
DATA 4,4,0,3,23,0,"C2BM+6,+10E8D17H8E7D13H7BM+4,+0RDLU" : 'EckLfest
DATA 0,0,0,0,0,0,"C6BFR18D18L18U18BFP6,6" : 'Schieb
DATA 1,2,0,0,0,4,"C6BFR7D18L7U18BFP6,6BHBR11R7D18L7U18BFP6,6" : 'SchiebSenk
DATA 0,0,4,8,0,2,"C6BFR18D7L18U7BFP6,6BHBD11R18D7L18U7BFP6,6" : 'SchiebWaag
DATA 0,0,0,0,30,0,"C8BFR18D18L18U18BFP8,8" : 'Stein
DATA 1,2,0,0,32,4,"C8BFR7D18L7U18BFP8,8BHBR11R7D18L7U18BFP8,8": 'SteinSenk
DATA 0,0,4,8,31,2,"C8BFR18D7L18U7BFP8,8BHBD11R18D7L18U7BFP8,8": 'SteinWaag
DATA 1,2,4,8,33,6,"C8BFR18D18L18U18" : 'Glas
DATA 1,2,4,8,34,0,"C7BFR18D18L18U18BFP7,7EC0M+3,+5M+1,-2F4BM+10,+0G8M+1,-3M-6,+3" : 'Brech
DATA 1,2,4,8,35,7,"BFC8RGUBM+18,+0DHRBM+0,+18LEDBM-18,+0UFL" : 'Durchgang
DATA 1,2,4,8,6,7,"BFC8R18D18L18U18F5ND13NR13LBHP8,8BR2P8,8DC0H4": 'Loch
DATA 0,0,0,0,37,0,"C8BM+10,+19M-5,-10M+3,+2M+2,+8M+2,-8NL4M+3,-2NM-5,+10M-2,-2L5M-3,+2": 'Diamant
'I N T R O
intro:
langsam = 1: schwer = 1: level = 1
DO: RESTORE intro
laserweg (0): neu: CLS
FOR k = 10 TO 14: FOR i = 1 TO 32
READ f(i, k): st i, k
NEXT: NEXT
IF langsam = 1 THEN SLEEP 1
f(2, 5) = 2: st 2, 5: IF langsam = 1 THEN SLEEP 1
introrech 2, 6, 2
DATA ,31, , ,,14,32,13,,12,32,32,,17,32,30,,12,32,11,,,12,30,11,,37,, , ,23,
DATA ,31, , ,,31, ,31,,31, , ,,31, , ,,31, ,31,,, , ,30,,34,, ,12,33,
DATA ,28, , ,,18,29,28,,11,29,21,,33,29,27,,28,29,16,,, ,12, ,,34,,12, ,33,
DATA ,31, , ,,31, ,31,, , ,31,,31, , ,,31, ,31,,,12, , ,,34,, , ,33,
DATA ,11,32,32,,14, ,13,,32,32,12,,11,32,32,,14, ,13,,,32,32,32,,16,, , ,12,
IF langsam = 1 THEN SLEEP 2
langsam = 0: level = 1
LOCATE 21, 30: PRINT "1) Einzelspiel"
LOCATE 22, 30: PRINT "2) Partnerspiel"
LOCATE 23, 30: PRINT "3) Laser-Schlacht"
LOCATE 26, 30: PRINT "9) Spiel beenden"
DO: modus = VAL(INPUT$(1)): LOOP UNTIL modus > 0 AND (modus < 4 OR modus = 9)
IF modus = 9 THEN EXIT DO
ERASE las
DO
CLS : mx = 0: ON modus GOSUB einzel, doppel, schlacht
FOR k = 10 TO 14: FOR i = 1 TO 32
READ f(i, k): st i, k
NEXT: NEXT
OPEN n$ FOR BINARY AS #1: GET #1, 1, levanz: CLOSE
LOCATE 21, 30: PRINT "1) Starten (Level" + STR$(level) + ")"
LOCATE 22, 30: PRINT "2) Neues Spiel"
LOCATE 23, 30: PRINT "3) Level editieren"
LOCATE 24, 30: PRINT "4) Geschwindigkeit: "; schnell$(schwer)
LOCATE 26, 30: PRINT "9) zum Hauptmen"
DO
a$ = INPUT$(1)
SELECT CASE a$
CASE "1": Spiellauf (level)
CASE "2": Spiellauf (1)
CASE "3": L = level: GesamtEditor: level = L
CASE "4"
a$ = "": schwer = schwer + 1: IF schwer > 2 THEN schwer = 0
LOCATE 24, 30: PRINT "4) Geschwindigkeit: "; schnell$(schwer); " "
CASE IS <> "9": a$ = ""
END SELECT
LOOP UNTIL a$ <> ""
LOOP UNTIL a$ = "9"
LOOP
END
einzel:
RESTORE einzel: n$ = "EINZEL.LEV": RETURN
DATA , ,30,,,,14,30,30,,30,30,13,, 7,,30,30,30,,30, , ,,30,30,30,,30,30,13,
DATA ,14,30,,,,30, , ,,30, ,30,, ,,30, , ,,30, , ,,30, , ,,30, ,30,
DATA 14, ,27,,,,13,27,13,,27,27,14,,28,,27,27, ,,27, , ,,27,27, ,,27,27,14,
DATA , ,30,,,, , ,30,,30, , ,,31,,30, , ,,30, , ,,30, , ,,30, ,13,
DATA , ,30,,,,30,30,14,,30, , ,,31,,30,30,30,,30,30,30,,30,30,30,,30, ,30,
doppel:
RESTORE doppel: n$ = "DOPPEL.LEV": RETURN
DATA ,14,30,13,,,,14,30,30,,30,30,13,, 7,,30,30,30,,30, , ,,30,30,30,,30,30,13
DATA , , ,30,,,,30, , ,,30, ,30,, ,,30, , ,,30, , ,,30, , ,,30, ,30
DATA , ,14, ,,,,13,27,13,,27,27,14,,28,,27,27, ,,27, , ,,27,27, ,,27,27,14
DATA ,14, , ,,,, , ,30,,30, , ,,31,,30, , ,,30, , ,,30, , ,,30, ,13
DATA ,30,30,30,,,,30,30,14,,30, , ,,31,,30,30,30,,30,30,30,,30,30,30,,30, ,30
schlacht:
RESTORE schlacht: n$ = "SCHLACHT.LEV": RETURN
DATA ,14,30,30,,14,30,13,,30, ,30,,30, , ,,14,30,13,,14,30,13,,30, ,30,,32,32,32
DATA ,30, , ,,30, , ,,30, ,30,,30, , ,,30, ,30,,30, , ,,30, ,30,, ,30,
DATA ,13,33,13,,33, , ,,33,33,33,,33, , ,,33,33,33,,33, , ,,33,33,33,, ,33,
DATA , , ,30,,30, , ,,30, ,30,,30, , ,,30, ,30,,30, , ,,30, ,30,, ,30,
DATA ,30,30,14,,13,30,14,,30, ,30,,11,30,30,,30, ,30,,13,30,14,,30, ,30,, ,30,
SUB alleladen
SHARED feld(), optionen(), levanz, modus, n$
OPEN n$ FOR BINARY AS #1
FOR i = 1 TO 10: GET #1, , optionen(0, i): NEXT
levanz = optionen(0, 1)
FOR nr = 1 TO levanz
FOR i = 1 TO 10: GET #1, , optionen(nr, i): NEXT
FOR i = 1 TO 32: FOR k = 5 TO 24: GET #1, , feld(nr, i, k): NEXT: NEXT
NEXT
CLOSE
END SUB
SUB allespeichern
SHARED feld(), optionen(), levanz, modus, n$
KILL "LASLEVEL.BAK":
NAME n$ AS "LASLEVEL.BAK"
OPEN n$ FOR BINARY AS #1
optionen(0, 1) = levanz
FOR i = 1 TO 10: PUT #1, , optionen(0, i): NEXT
FOR nr = 1 TO levanz
FOR i = 1 TO 10: PUT #1, , optionen(nr, i): NEXT
FOR i = 1 TO 32: FOR k = 5 TO 24: PUT #1, , feld(nr, i, k): NEXT: NEXT
NEXT
CLOSE
END SUB
' Editor
'
SUB Editor
SHARED anz, edit, box1x, box1y, box2x, box2y, schirm, f2(), dat()
SHARED level, levanz, wechselanz, wmax, zeit, schwer, punkte&, modus
edit = 1: box1x = 1: box1y = 3: box2x = 16: box2y = 14
CLS : schirm = 0: zeichne
DO: a$ = INKEY$: a = 0: b = 0
'IF a$ <> "" THEN PRINT ASC(a$), LEN(a$)
IF LEN(a$) = 2 THEN a = ASC(RIGHT$(a$, 1)) ELSE IF a$ <> "" THEN b = ASC(a$)
a$ = LCASE$(a$)
IF a$ = "t" THEN
FOR i = 1 TO 32: FOR k = 5 TO 24: f2(i, k) = f(i, k): NEXT: NEXT
s = schwer: schwer = 0: z = zeit: zeit = -1: punkte& = 0
edit = 2: zeichne: a = Spiel: zeit = z: edit = 1: schwer = s
FOR i = 1 TO 32: FOR k = 5 TO 24: f(i, k) = f2(i, k): NEXT: NEXT: zeichne
END IF
IF a$ = "l" THEN
LOCATE 1, 55: PRINT "Lade Level __"
lev = inputt(1, 66, -1): IF lev > 0 AND lev <= levanz THEN level = lev: laden level
zeichne
END IF
IF a$ = "s" THEN
LOCATE 1, 50: PRINT "Speichere Level"; USING " ##"; level
lev = inputt(1, 66, level): IF lev > 0 THEN level = lev: speichern level
LOCATE 1, 50: PRINT " Level"; USING " ##"; level;
PRINT " von"; USING " ##"; levanz
END IF
IF a$ = "n" THEN neu: level = levanz + 1: zeichne
IF b = 9 THEN
schirm = schirm + 1: IF schirm = 2 THEN schirm = 0
st box1x, box1y: st box2x, box2y
END IF
IF a$ = "+" THEN
SELECT CASE f(box2x, box2y)
CASE 256 TO 256 * 99 - 1: f(box2x, box2y) = f(box2x, box2y) + 256: LOCATE 1, 50: PRINT "DREH"; USING " ## "; INT(f(box2x, box2y) / 256)
CASE IS < 256: IF zeit < 500 THEN zeit = zeit + 5: LOCATE 1, 50: PRINT "ZEIT"; USING " ###"; zeit
END SELECT
END IF
IF a$ = "-" THEN
SELECT CASE f(box2x, box2y)
CASE IS > 256 * 2: f(box2x, box2y) = f(box2x, box2y) - 256: LOCATE 1, 50: PRINT "DREH"; USING " ## "; INT(f(box2x, box2y) / 256)
CASE IS < 256: IF zeit > 20 THEN zeit = zeit - 5: LOCATE 1, 50: PRINT "ZEIT"; USING " ###"; zeit
END SELECT
END IF
IF b = 13 THEN
IF box1x = 7 AND box1y = 2 THEN
f = f(box2x, box2y)
IF f > 255 THEN
IF (f AND 127) = 6 THEN f = 0
f(box2x, box2y) = f AND 127: wechselanz = wechselanz - 1
LOCATE 1, 50: PRINT STRING$(7, 32)
ELSE
IF ((dat(f, 5) > 0 AND dat(f, 5) <> f) OR f = 0) AND wechselanz < wmax THEN
IF f = 0 THEN f = 6
f(box2x, box2y) = f + 256 * 11: wechselanz = wechselanz + 1
LOCATE 1, 50: PRINT "DREH 11 "
ELSE BEEP
END IF
END IF
st box2x, box2y
ELSE
IF f(box2x, box2y) > 255 THEN wechselanz = wechselanz - 1: LOCATE 1, 50: PRINT STRING$(7, 32)
f(box2x, box2y) = f(box1x, box1y): st box2x, box2y
END IF
LOCATE 2, 59: PRINT wechselanz; " Wechsler "
END IF
IF a = 59 THEN hilfe: zeichne
IF schirm = 0 THEN
IF a = 72 AND box1y = 3 THEN box1y = 2: st box1x, 3: box1x = MIN(box1x, 7): st box1x, 2
IF a = 80 AND box1y = 2 THEN box1y = 3: st box1x, 2: st box1x, 3
IF a = 77 THEN
box1x = box1x + 1: st box1x - 1, box1y
IF (box1y = 2 AND box1x > 7 - (modus = 3)) OR (box1y = 3 AND box1x > anz - 10) THEN box1x = 1
st box1x, box1y
ELSEIF a = 75 THEN
box1x = box1x - 1: st box1x + 1, box1y
IF box1x < 1 THEN IF box1y = 2 THEN box1x = 7 - (modus = 3) ELSE box1x = anz - 10
st box1x, box1y
END IF
ELSEIF schirm = 1 THEN
IF a = 72 THEN
box2y = box2y - 1: st box2x, box2y + 1
IF box2y < 5 THEN box2y = 24
st box2x, box2y
ELSEIF a = 80 THEN
box2y = box2y + 1: st box2x, box2y - 1
IF box2y > 24 THEN box2y = 5
st box2x, box2y
ELSEIF a = 77 THEN
box2x = box2x + 1: st box2x - 1, box2y
IF box2x > 32 THEN box2x = 1
st box2x, box2y
ELSEIF a = 75 THEN
box2x = box2x - 1: st box2x + 1, box2y
IF box2x < 1 THEN box2x = 32
st box2x, box2y
END IF
END IF
LOCATE 1, 50
IF f(box2x, box2y) > 255 THEN
PRINT "DREH"; USING " ## "; INT(f(box2x, box2y) / 256)
ELSE PRINT "ZEIT"; USING " ###"; zeit
END IF
LOOP UNTIL a$ = CHR$(27)
edit = 0
END SUB
' startet Routine zum Laserl”schen
'
SUB fort (x, y)
SHARED las()
IF y < 24 THEN IF las(x, y + 1) AND 1 THEN weg x, y, 1
IF y > 5 THEN IF las(x, y - 1) AND 2 THEN weg x, y, 2
IF x < 32 THEN IF las(x + 1, y) AND 4 THEN weg x, y, 4
IF x > 1 THEN IF las(x - 1, y) AND 8 THEN weg x, y, 8
END SUB
SUB GesamtEditor
SHARED feld(), optionen(), levanz, level, zeit
alleladen
beginn = 1: wo = 1: ueberblick beginn, wo
DO
a$ = INKEY$: a = 0: b = 0: IF a$ <> "" THEN IF LEN(a$) = 2 THEN a = ASC(RIGHT$(a$, 1)) ELSE b = ASC(a$)
IF a$ = "+" AND wo + beginn - 1 < levanz THEN
vertausche wo + beginn - 1, wo + beginn
a = 77: IF wo < 16 THEN ueberblick beginn, wo
END IF
IF a$ = "-" AND wo + beginn > 2 THEN
vertausche wo + beginn - 1, wo + beginn - 2
a = 75: IF wo > 1 THEN ueberblick beginn, wo
END IF
IF b = 11 AND wo + beginn - 2 < levanz THEN
LOCATE 3, 28: PRINT "WIRKLICH L™SCHEN ? (J/N)";
DO: b$ = LCASE$(INPUT$(1)): LOOP UNTIL b$ = "j" OR b$ = "n"
LOCATE 3, 28: PRINT STRING$(24, 32)
IF b$ = "j" THEN
i = wo + beginn - 1
DO WHILE i < levanz: vertausche i, i + 1: i = i + 1: LOOP
levanz = levanz - 1
IF beginn > 1 AND levanz - beginn < 14 THEN beginn = beginn - 1: wo = wo + 1
ueberblick beginn, wo
END IF
END IF
IF b = 32 THEN
IF wo + beginn - 1 > levanz THEN
BEEP
ELSEIF verschieb = 0 THEN
DRAW "S4C12BM" + STR$(((wo - 1) MOD 4) * 160 + 2) + "," + STR$(62 + INT((wo - 1) / 4) * 100) + "R155D95L155U95"
verschieb = wo + beginn - 1: LOCATE 2, 5: PRINT "Verschiebe Level"; USING " ##"; verschieb
ELSEIF verschieb <> wo + beginn - 1 THEN
FOR i = verschieb TO wo + beginn - 1 - SGN(wo + beginn - 1 - verschieb) STEP SGN(wo + beginn - 1 - verschieb)
vertausche i, i + SGN(wo + beginn - 1 - verschieb)
NEXT
verschieb = 0: ueberblick beginn, wo
ELSE
BEEP: verschieb = 0: ueberblick beginn, wo
END IF
END IF
IF b = 27 AND verschieb <> 0 THEN BEEP: b = 0: verschieb = 0: ueberblick beginn, wo
IF a = 77 AND wo + beginn - 2 < levanz THEN
DRAW "S4C14BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
wo = wo + 1
IF wo = 17 THEN
plus = MIN(12, levanz - 14 - beginn): beginn = beginn + plus
wo = wo - plus: ueberblick beginn, wo
END IF
DRAW "S4C9BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
IF verschieb <> 0 THEN LOCATE 2, 26: PRINT "zu Level"; USING " ##"; wo + beginn - 1
END IF
IF a = 75 AND (wo > 1 OR beginn > 1) THEN
DRAW "S4C14BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
wo = wo - 1
IF wo = 0 THEN
minus = MIN(12, beginn - 1): beginn = beginn - minus
wo = wo + minus: ueberblick beginn, wo
END IF
DRAW "S4C9BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
IF verschieb <> 0 THEN LOCATE 2, 26: PRINT "zu Level"; USING " ##"; wo + beginn - 1
END IF
IF a = 72 AND (wo > 1 OR beginn > 1) THEN
DRAW "S4C14BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
wo = wo - 4
IF beginn + wo - 1 < 1 THEN wo = 1: IF beginn > 1 THEN beginn = 1: ueberblick 1, 1
IF wo < 1 THEN
minus = MIN(12, beginn - 1): beginn = beginn - minus
wo = wo + minus: ueberblick beginn, wo
END IF
DRAW "S4C9BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
IF verschieb <> 0 THEN LOCATE 2, 26: PRINT "zu Level"; USING " ##"; wo + beginn - 1
END IF
IF a = 80 AND wo + beginn - 2 < levanz THEN
DRAW "S4C14BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
wo = wo + 4
IF beginn + wo - 2 > levanz THEN wo = levanz - beginn + 2
IF wo > 16 THEN
plus = MIN(12, levanz - 14 - beginn): beginn = beginn + plus
wo = wo - plus: ueberblick beginn, wo
END IF
DRAW "S4C9BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "R159D99L159U99"
IF verschieb <> 0 THEN LOCATE 2, 26: PRINT "zu Level"; USING " ##"; wo + beginn - 1
END IF
IF a = 59 THEN
IF verschieb <> 0 THEN BEEP: verschieb = 0
hilfe
ueberblick beginn, wo
END IF
IF b = 13 AND verschieb = 0 THEN
allespeichern
level = beginn + wo - 1
IF level > levanz THEN
neu
ELSE
FOR i = 1 TO 32: FOR k = 5 TO 24
IF level <= levanz THEN f(i, k) = feld(level, i, k) ELSE f(i, k) = 0
NEXT: NEXT
zeit = optionen(level, 1)
END IF
Editor
alleladen
ueberblick beginn, wo
END IF
LOOP UNTIL b = 27
allespeichern
END SUB
SUB hilfe
CLS
LOCATE 1, 26: PRINT "TASTATURBELEGUNG BEIM EDITOR"
LOCATE 4, 1: PRINT " Gesamteditor": PRINT
PRINT " RETURN einzelnes Level editieren"
PRINT " SPACE Level zum Verschieben ausw„hlen"
PRINT " bzw. an gew„hlter Stelle ablegen"
PRINT " + Level mit nachfolgendem vertauschen"
PRINT " - Level mit vorangehendem vertauschen"
PRINT " STRG+K: Level l”schen"
PRINT " ESC zum Startbild zurckkehren"
LOCATE 15, 1: PRINT " Einzeleditor": PRINT
PRINT " TAB zwischen Men und Feld springen"
PRINT " RETURN gew„hlten Menstein auf dem Feld setzen"
PRINT " L Level laden"
PRINT " S Level speichern"
PRINT " +, - Zeit bzw. Drehdauer ver„ndern"
PRINT " T Testspiel starten"
PRINT " ESC zum Gesamteditor zurckkehren"
a$ = INPUT$(1)
END SUB
' startet Routine zum Laserzeichnen
'
SUB hin (x, y)
SHARED las()
IF y < 24 THEN IF las(x, y + 1) AND 1 THEN rech x, y, 1, 0
IF y > 5 THEN IF las(x, y - 1) AND 2 THEN rech x, y, 2, 0
IF x < 32 THEN IF las(x + 1, y) AND 4 THEN rech x, y, 4, 0
IF x > 1 THEN IF las(x - 1, y) AND 8 THEN rech x, y, 8, 0
END SUB
' Eingabe einer zweistelligen Zahl an der Stelle (x,y)
'
FUNCTION inputt (x, y, ret)
LOCATE x, y
DO: a$ = INPUT$(1)
LOOP UNTIL VAL(a$) > 0 OR a$ = "0" OR a$ = CHR$(27) OR a$ = CHR$(13)
IF a$ = CHR$(13) THEN
inputt = ret
ELSEIF a$ = CHR$(27) THEN
inputt = -1
ELSE
PRINT a$ + "_"
DO: b$ = INPUT$(1)
LOOP UNTIL VAL(b$) > 0 OR b$ = "0" OR b$ = CHR$(27) OR b$ = CHR$(13)
IF b$ = CHR$(13) THEN
inputt = VAL(a$)
ELSEIF b$ = CHR$(27) THEN
inputt = -1
ELSE
inputt = VAL(a$ + b$)
END IF
END IF
END FUNCTION
' Routine zum Laserzeichnen beim Intro
'
SUB introrech (x, y, r)
SHARED las(), dat(), langsam
DO
IF x < 1 OR x > 32 OR y < 5 OR y > 24 OR r = 0 THEN EXIT DO
f = f(x, y)
IF f = 34 THEN f(x, y) = 0: f = 0: st x, y
IF f = 37 THEN f(x, y) = 7: f = 7: st x, y
IF (r = 1 OR r = 2) THEN
IF dat(f, 6) AND 4 THEN DRAW "C4BM" + STR$(x * 20 - 10) + "," + STR$(y * 20 - 20) + "D20"
ELSE IF dat(f, 6) AND 2 THEN DRAW "C4BM" + STR$(x * 20 - 20) + "," + STR$(y * 20 - 10) + "R20"
END IF
IF langsam = 1 AND (((dat(f, 6) AND 2) = 2 AND (r = 4 OR r = 8)) OR ((dat(f, 6) AND 4) = 4 AND (r = 1 OR r = 2))) THEN
FOR L = 1 TO 4
IF INKEY$ <> "" THEN langsam = 0: EXIT FOR
warte 1
NEXT
END IF
r = r + (r > 2) + 3 * (r > 4): r = dat(f(x, y), r)
w = 2: rn = 0: xn = x: yn = y
IF (r AND 1) = 1 AND (las(x, y) AND 1) = 0 THEN
las(x, y) = las(x, y) + 1: IF w = 2 THEN yn = y - 1: rn = 1: w = 1 ELSE introrech x, y - 1, 1
END IF
IF (r AND 2) = 2 AND (las(x, y) AND 2) = 0 THEN
las(x, y) = las(x, y) + 2: IF w = 2 THEN yn = y + 1: rn = 2: w = 1 ELSE introrech x, y + 1, 2
END IF
IF (r AND 4) = 4 AND (las(x, y) AND 4) = 0 THEN
las(x, y) = las(x, y) + 4: IF w = 2 THEN xn = x - 1: rn = 4: w = 1 ELSE introrech x - 1, y, 4
END IF
IF (r AND 8) = 8 AND (las(x, y) AND 8) = 0 THEN
las(x, y) = las(x, y) + 8: IF w = 2 THEN xn = x + 1: rn = 8: w = 1 ELSE introrech x + 1, y, 8
END IF
x = xn: y = yn: r = rn
LOOP
END SUB
' laden eines Levels
'
SUB laden (nr)
SHARED levanz, zeit, modus, n$
IF nr <= levanz THEN
SELECT CASE modus
END SELECT
OPEN n$ FOR BINARY AS #1
SEEK #1, 2 * (nr * 650 - 640) + 1
GET #1, , zeit
FOR i = 2 TO 10: GET #1, , a: NEXT
FOR i = 1 TO 32: FOR k = 5 TO 24: GET #1, , f(i, k): NEXT: NEXT
CLOSE
END IF
END SUB
' l”scht alle Laserstrahlen
'
SUB laserweg (opt)
SHARED las()
FOR i = 1 TO 32: FOR k = 5 TO 24
las(i, k) = 0: IF opt = 1 THEN st i, k
NEXT: NEXT
END SUB
' gibt grӇeren Wert von (x1,x2) zurck
'
FUNCTION MAX (x1, x2)
IF x1 > x2 THEN MAX = x1 ELSE MAX = x2
END FUNCTION
' gibt kleineren Wert von (x1,x2) zurck
'
FUNCTION MIN (x1, x2)
IF x1 < x2 THEN MIN = x1 ELSE MIN = x2
END FUNCTION
' l”scht ganzes Feld (alle Steine)
'
SUB neu
SHARED zeit, modus: zeit = 100 + 40 * (modus = 3)
FOR i = 1 TO 32: FOR k = 1 TO 24: f(i, k) = 0: NEXT: NEXT
END SUB
' Routine zum Laserzeichnen
'
SUB rech (m, n, r, zaehl)
SHARED las(), dat(), laseranz, sx, sy, mx, my, m2x, m2y, modus
SHARED Leute(), Mann1, Mann2
SHARED zeit, punkte&, laspunkte, laszeit, diamant
SHARED diam1, diam2, las1, las2, akteur
x = m: y = n
DO
IF x < 1 OR x > 32 OR y < 5 OR y > 24 OR r = 0 OR zaehl > 250 OR (sx = x AND sy = y) THEN EXIT DO
f = f(x, y) AND 63
IF f > 0 AND f < 5 THEN
f(x, y) = 0: weg x, y, 2 ^ (f - 1): f = 0: laseranz = laseranz - 1
IF modus = 3 THEN
IF akteur = 1 THEN las1 = las1 + 1
IF akteur = 2 THEN las2 = las2 + 1
ELSE
punkte& = punkte& + laspunkte: IF zeit > 0 THEN zeit = zeit + laszeit
LOCATE 1, 32: PRINT punkte&
END IF
hin x, y: EXIT DO
END IF
IF f = 34 THEN f(x, y) = 0: f = 0: st x, y
IF f = 37 THEN
IF modus = 3 THEN
IF akteur = 1 THEN diam1 = diam1 + 1
IF akteur = 2 THEN diam2 = diam2 + 1
ELSE
punkte& = punkte& + diamant: LOCATE 1, 32: PRINT punkte&
END IF
f(x, y) = 7: st x, y: hin x, y: EXIT DO
END IF
IF (r = 1 OR r = 2) THEN
IF dat(f, 6) AND 4 THEN DRAW "C4BM" + STR$(x * 20 - 10) + "," + STR$(y * 20 - 20) + "D19"
ELSE
IF dat(f, 6) AND 2 THEN DRAW "C4BM" + STR$(x * 20 - 20) + "," + STR$(y * 20 - 10) + "R19"
END IF
r = r + (r > 2) + 3 * (r > 4): r = dat(f, r)
w = 2: rn = 0: xn = x: yn = y
IF (r AND 1) = 1 AND (las(x, y) AND 1) = 0 THEN
las(x, y) = las(x, y) + 1: IF w = 2 THEN yn = y - 1: rn = 1: w = 1 ELSE rech x, y - 1, 1, zaehl + 1
END IF
IF (r AND 2) = 2 AND (las(x, y) AND 2) = 0 THEN
las(x, y) = las(x, y) + 2: IF w = 2 THEN yn = y + 1: rn = 2: w = 1 ELSE rech x, y + 1, 2, zaehl + 1
END IF
IF (r AND 4) = 4 AND (las(x, y) AND 4) = 0 THEN
las(x, y) = las(x, y) + 4: IF w = 2 THEN xn = x - 1: rn = 4: w = 1 ELSE rech x - 1, y, 4, zaehl + 1
END IF
IF (r AND 8) = 8 AND (las(x, y) AND 8) = 0 THEN
las(x, y) = las(x, y) + 8: IF w = 2 THEN xn = x + 1: rn = 8: w = 1 ELSE rech x + 1, y, 8, zaehl + 1
END IF
IF las(x, y) = 0 THEN EXIT DO
IF modus <> 3 THEN
IF (mx = x AND my = y) OR (modus > 1 AND m2x = x AND m2y = y) THEN EXIT DO
END IF
x = xn: y = yn: r = rn
LOOP
END SUB
' startet Routine zum Laserzeichnen
'
SUB rechne
SHARED las(), laseranz
laserweg (0): laseranz = 0
FOR x = 1 TO 32: FOR y = 5 TO 24
SELECT CASE f(x, y)
CASE 1: rech x, y - 1, 1, 0
CASE 2: rech x, y + 1, 2, 0
CASE 3: rech x - 1, y, 4, 0
CASE 4: rech x + 1, y, 8, 0
END SELECT
IF f(x, y) > 0 AND f(x, y) < 5 THEN
las(x, y) = 2 ^ (f(x, y) - 1): laseranz = laseranz + 1
END IF
NEXT: NEXT
END SUB
' speichert ein Level
'
SUB speichern (nr)
SHARED levanz, zeit, modus, n$
OPEN n$ FOR BINARY AS #1
IF nr > levanz THEN nr = levanz + 1: levanz = nr: PUT #1, 1, levanz
SEEK #1, 2 * (nr * 650 - 640) + 1
PUT #1, , zeit
a = 0: FOR i = 2 TO 10: PUT #1, , a: NEXT
FOR i = 1 TO 32: FOR k = 5 TO 24: PUT #1, , f(i, k): NEXT: NEXT
CLOSE
END SUB
' Level spielen (Test und normal)
'
FUNCTION Spiel
SHARED las(), suchx, suchy, such2x, such2y, dat(), Leute(), Mann1, Mann2
SHARED mx, my, m2x, m2y, edit, sx, sy, Spiegel$()
SHARED laseranz, wx(), wy(), wt(), wechselanz, schwer, modus
SHARED zeit, punkte&, laspunkte, laszeit, diamant
SHARED geg1, geg2, diam1, diam2, las1, las2, akteur
Mann1 = 1: Mann2 = 1
laserweg (0): sx = 0: sy = 0
mx = suchx: my = suchy: f(mx, my) = 0: m2x = 0
IF modus = 2 THEN m2x = such2x: m2y = such2y: f(m2x, m2y) = 0
IF modus = 3 THEN
FOR i = 2 TO Leute(1, 0)
f = Leute(1, i): x = (f MOD 32) + 1: y = INT(f / 32): f(x, y) = 8: st x, y
NEXT
FOR i = 2 TO Leute(2, 0)
f = Leute(2, i): x = (f MOD 32) + 1: y = INT(f / 32): f(x, y) = 9: st x, y
NEXT
f = Leute(1, 1): mx = (f MOD 32) + 1: my = INT(f / 32): f(mx, my) = 0: st mx, my
f = Leute(2, 1): m2x = (f MOD 32) + 1: m2y = INT(f / 32): f(m2x, m2y) = 0: st m2x, m2y
END IF
lauf = 0: rechne
SELECT CASE schwer
CASE 0
schnell! = .25: laspunkte = 50: endpunkte = 5: laszeit = 10: diamant = 200
CASE 1
schnell! = .3: laspunkte = 20: endpunkte = 2: laszeit = 15: diamant = 120
CASE 2
schnell! = .4: laspunkte = 10: endpunkte = 1: laszeit = 20: diamant = 75
END SELECT
LOCATE 1, 5: PRINT "RESTZEIT:"; zeit;
IF modus <> 3 THEN PRINT TAB(25); "PUNKTE:"; punkte&
t! = TIMER
DO: a$ = INKEY$: a = 0: b = 0: lauf = lauf + 1
IF LEN(a$) = 2 THEN a = ASC(RIGHT$(a$, 1)) ELSE IF a$ <> "" THEN b = ASC(a$)
SELECT CASE a
CASE 72: xplus = 0: yplus = -1
CASE 80: xplus = 0: yplus = 1
CASE 75: xplus = -1: yplus = 0
CASE 77: xplus = 1: yplus = 0
CASE ELSE: xplus = 0: yplus = 0
END SELECT
IF xplus + yplus <> 0 AND Mann1 > 0 THEN
akteur = 1
sx = mx + xplus: sy = my + yplus: f = f(sx, sy) AND 127
IF dat(f, 6) AND 1 THEN
IF sx <> m2x OR sy <> m2y THEN mx = mx + xplus: my = my + yplus: st mx - xplus, my - yplus: st mx, my
ELSEIF dat(f, 5) > 0 AND dat(f, 5) <> f THEN
fort sx, sy: f(sx, sy) = dat(f, 5): st sx, sy: sx = sx - 99: hin sx + 99, sy
ELSEIF dat(f, 5) = 0 THEN
IF sx + xplus <> m2x OR sy + yplus <> m2y THEN
IF f(mx + 2 * xplus, my + 2 * yplus) = 0 OR f(mx + 2 * xplus, my + 2 * yplus) = 6 THEN
fort sx, sy: f(sx, sy) = -6 * (f(sx, sy) > 127)
mx = mx + xplus: my = my + yplus: st mx - xplus, my - yplus
st mx, my: sx = sx - 99: hin sx + 99, sy: : sx = sx + xplus + 99: sy = sy + yplus
IF f(mx + xplus, my + yplus) = 6 THEN f = f + 128
fort sx, sy: f(sx, sy) = f: st sx, sy: sx = sx - 99: hin sx + 99, sy
ELSEIF f(mx + 2 * xplus, my + 2 * yplus) = 36 THEN
fort sx, sy: f(sx, sy) = 0: mx = mx + xplus: my = my + yplus: st mx - xplus, my - yplus
st mx, my: sx = sx - 99: hin sx + 99, sy: sx = sx + xplus + 99: sy = sy + yplus
fort sx, sy: f(sx, sy) = f: st sx, sy: sx = sx - 99: hin sx + 99, sy
IF f = 27 OR f = 28 OR f = 29 THEN
f(sx + 99, sy) = 0: st sx + 99, sy: hin sx + 99, sy
ELSE
IF lochzeit > 0 THEN
sx = lochx: sy = lochy: fort sx, sy: f(sx, sy) = 36
st sx, sy: sx = sx - 99: hin sx + 99, sy
END IF
lochzeit = 1: lochx = mx + xplus: lochy = my + yplus: lochst = f
END IF
END IF
END IF
END IF
Leute(1, Mann1) = mx + my * 32 - 1
akteur = 0
END IF
IF modus > 1 THEN
SELECT CASE VAL(a$)
CASE 8: x2plus = 0: y2plus = -1
CASE 2, 5: x2plus = 0: y2plus = 1
CASE 4: x2plus = -1: y2plus = 0
CASE 6: x2plus = 1: y2plus = 0
CASE ELSE: x2plus = 0: y2plus = 0
END SELECT
IF x2plus + y2plus <> 0 AND Mann2 > 0 THEN
akteur = 2
sx = m2x + x2plus: sy = m2y + y2plus: f = f(sx, sy) AND 127
IF dat(f, 6) AND 1 THEN
IF sx <> mx OR sy <> my THEN m2x = m2x + x2plus: m2y = m2y + y2plus: st m2x - x2plus, m2y - y2plus: st m2x, m2y
ELSEIF dat(f, 5) > 0 AND dat(f, 5) <> f THEN
fort sx, sy: f(sx, sy) = dat(f, 5): st sx, sy: sx = sx - 99: hin sx + 99, sy
ELSEIF dat(f, 5) = 0 THEN
IF sx + x2plus <> mx OR sy + y2plus <> my THEN
IF f(m2x + 2 * x2plus, m2y + 2 * y2plus) = 0 OR f(m2x + 2 * x2plus, m2y + 2 * y2plus) = 6 THEN
fort sx, sy: f(sx, sy) = -6 * (f(sx, sy) > 127)
m2x = m2x + x2plus: m2y = m2y + y2plus: st m2x - x2plus, m2y - y2plus
st m2x, m2y: sx = sx - 99: hin sx + 99, sy: : sx = sx + x2plus + 99: sy = sy + y2plus
IF f(mx + xplus, my + yplus) = 6 THEN f = f + 128
fort sx, sy: f(sx, sy) = f: st sx, sy: sx = sx - 99: hin sx + 99, sy
ELSEIF f(m2x + 2 * x2plus, m2y + 2 * y2plus) = 36 THEN
fort sx, sy: f(sx, sy) = 0: m2x = m2x + x2plus: m2y = m2y + y2plus: st m2x - x2plus, m2y - y2plus
st m2x, m2y: sx = sx - 99: hin sx + 99, sy: sx = sx + x2plus + 99: sy = sy + y2plus
fort sx, sy: f(sx, sy) = f: st sx, sy: sx = sx - 99: hin sx + 99, sy
IF f = 27 OR f = 28 OR f = 29 THEN
f(sx + 99, sy) = 0: st sx + 99, sy: hin sx + 99, sy
ELSE
IF lochzeit > 0 THEN
sx = lochx: sy = lochy: fort sx, sy: f(sx, sy) = 36
st sx, sy: sx = sx - 99: hin sx + 99, sy
END IF
lochzeit = 1: lochx = m2x + x2plus: lochy = m2y + y2plus: lochst = f
END IF
END IF
END IF
END IF
Leute(2, Mann2) = m2x + m2y * 32 - 1
akteur = 0
END IF
END IF
IF modus = 3 THEN
IF b = 9 AND Leute(1, 0) > 0 THEN
Mann1 = Mann1 + 1: IF Mann1 > Leute(1, 0) THEN Mann1 = 1
f(mx, my) = 8: mmx = mx: mx = 0: st mmx, my
f = Leute(1, Mann1): mx = (f MOD 32) + 1: my = INT(f / 32)
f(mx, my) = 0: st mx, my
END IF
IF b = 13 AND Leute(2, 0) > 0 THEN
Mann2 = Mann2 + 1: IF Mann2 > Leute(2, 0) THEN Mann2 = 1
f(m2x, m2y) = 9: mmx = m2x: m2x = 0: st mmx, m2y
f = Leute(2, Mann2): m2x = (f MOD 32) + 1: m2y = INT(f / 32)
f(m2x, m2y) = 0: st m2x, m2y
END IF
END IF
'Zeiteinheit
IF t! < TIMER - schnell! OR TIMER < t! THEN
t! = TIMER
test& = test& + 1: lauf = 0
FOR i = 1 TO wechselanz
IF (test& MOD wt(i)) = 0 THEN
sx = wx(i): sy = wy(i): fort sx, sy
IF f(sx, sy) > 127 THEN
IF lochzeit > 0 THEN
sx = lochx: sy = lochy: fort sx, sy: f(sx, sy) = 36
st sx, sy: sx = sx - 99: hin sx + 99, sy: sx = wx(i): sy = wy(i)
END IF
lochst = f(sx, sy) AND 127: f(sx, sy) = dat(6, 5)
lochx = sx: lochy = sy: lochzeit = 1
IF lochst = 27 OR lochst = 28 OR lochst = 29 THEN
fort sx, sy: f(sx, sy) = 0: st sx, sy
sx = sx - 99: hin sx + 99, sy: lochzeit = 0: lochx = 0
END IF
ELSEIF lochx = sx AND lochy = sy THEN
fort sx, sy: f(sx, sy) = dat(36, 5)
st sx, sy: sx = sx - 99: hin sx + 99, sy: lochzeit = 0: lochx = 0
ELSE
f(sx, sy) = dat(f(sx, sy), 5)
st sx, sy: sx = 0: hin wx(i), sy
END IF
END IF
NEXT
IF (test& MOD 5) = 0 THEN
zeit = zeit - 1: LOCATE 1, 14: PRINT zeit; " "
IF zeit < 11 AND zeit > -1 THEN SOUND 600, 3
END IF
END IF
'Loch
IF f(mx, my) = 36 THEN
mx = mx + 1
FOR i = 3 TO 1 STEP -1
t$ = "BM" + STR$(mx * 20 - 28 - i * 3) + "," + STR$(my * 20 - 8 - i * 3)
warte 1: st mx - 1, my: DRAW "s" + STR$(i) + t$ + Spiegel$(1)
NEXT
warte 1: st mx - 1, my: mx = mx - 1: las(mx, my) = 1
END IF
IF lochzeit > 0 THEN lochzeit = lochzeit + 1
sx = lochx: sy = lochy
SELECT CASE lochzeit
CASE 2
DRAW "S4BM" + STR$(lochx * 20 - 20) + "," + STR$(lochy * 20 - 20) + Spiegel$(36)
CASE 2000
fort sx, sy: f(sx, sy) = 36
st sx, sy: sx = sx - 99: hin sx + 99, sy
DRAW "S3BM" + STR$(lochx * 20 - 17) + "," + STR$(lochy * 20 - 17) + Spiegel$(lochst)
CASE 4000
st sx, sy: DRAW "S2BM" + STR$(lochx * 20 - 14) + "," + STR$(lochy * 20 - 14) + Spiegel$(lochst)
CASE 6000
st sx, sy: DRAW "S1BM" + STR$(lochx * 20 - 11) + "," + STR$(lochy * 20 - 11) + Spiegel$(lochst)
CASE 8000
lochzeit = 0: st lochx, lochy: lochx = 0
END SELECT
sx = 0
IF modus = 3 THEN
FOR i = Leute(1, 0) TO 1 STEP -1
il = Leute(1, i): ix = (il MOD 32) + 1: iy = INT(il / 32)
IF las(ix, iy) <> 0 THEN
geg2 = geg2 + 1: f(ix, iy) = 0: mx = 0: st ix, iy
FOR k = i TO Leute(1, 0): Leute(1, k) = Leute(1, k + 1): NEXT
IF i < Mann1 THEN Mann1 = Mann1 - 1
IF i <= Leute(1, 0) THEN Leute(1, 0) = Leute(1, 0) - 1
IF Mann1 > Leute(1, 0) THEN Mann1 = Leute(1, 0)
il = Leute(1, Mann1): mx = (il MOD 32) + 1: my = INT(il / 32)
f(mx, my) = 0: st mx, my
END IF
NEXT
FOR i = Leute(2, 0) TO 1 STEP -1
il = Leute(2, i): ix = (il MOD 32) + 1: iy = INT(il / 32)
IF las(ix, iy) <> 0 THEN
geg1 = geg1 + 1: f(ix, iy) = 0: m2x = 0: st ix, iy
FOR k = i TO Leute(2, 0): Leute(2, k) = Leute(2, k + 1): NEXT
IF i < Mann2 THEN Mann2 = Mann2 - 1
IF i <= Leute(2, 0) THEN Leute(2, 0) = Leute(2, 0) - 1
IF Mann2 > Leute(2, 0) THEN Mann2 = Leute(2, 0)
il = Leute(2, Mann2): m2x = (il MOD 32) + 1: m2y = INT(il / 32)
f(m2x, m2y) = 0: st m2x, m2y
END IF
NEXT
END IF
'Level-Ende
IF modus <> 3 THEN IF las(mx, my) <> 0 THEN EXIT DO
IF modus = 2 THEN IF las(m2x, m2y) <> 0 THEN EXIT DO
IF laseranz = 0 OR b = 27 THEN EXIT DO
IF modus = 3 AND Leute(1, 0) + Leute(2, 0) = 0 THEN EXIT DO
LOOP UNTIL (zeit = 0 AND (test& MOD 5) = 4) OR zeit < -9999
IF modus < 3 THEN
IF laseranz = 0 AND las(mx, my) = 0 THEN
FOR i = zeit - 1 TO 0 STEP -1
punkte& = punkte& + endpunkte
LOCATE 1, 14: PRINT i; " "; TAB(25); "PUNKTE:"; punkte&: warte 1
NEXT
Spiel = 1
ELSEIF b = 27 THEN Spiel = 3
ELSE Spiel = 2: FOR i = 500 TO 40 STEP -5: SOUND i, 25 / i: NEXT
END IF
END IF
IF b <> 27 THEN
DO WHILE INKEY$ <> "": LOOP
a$ = INPUT$(1): IF a$ = CHR$(27) THEN Spiel = 3
END IF
edit = 0: laserweg (0)
END FUNCTION
' alle vorhandenen Level durchspielen
'
SUB Spiellauf (nr)
SHARED level, levanz, zeit, edit, sx, schwer, punkte&, modus
SHARED geg1, geg2, diam1, diam2, las1, las2, Spielfolge()
leben = 2: punkte& = 0: ret = -1: p1 = 0: p2 = 0
IF modus = 3 THEN
CLS
n1$ = "SPIELER 1": n2$ = "SPIELER 2": anz = 6
LOCATE 3, 3: PRINT "Name des 1. Spielers (max 10 Zeichen):"
LOCATE 4, 3: PRINT "Name des 2. Spielers (max 10 Zeichen):"
LOCATE 6, 3: PRINT "Anzahl der zu spielenden Wettk„mpfe:"
LOCATE 3, 43: INPUT "", n1$
LOCATE 4, 43: INPUT "", n2$
LOCATE 6, 43: PRINT "-"; anz; "+ ";
LOCATE 8, 3: PRINT "Drcken Sie '-' oder '+', um die Spielanzahl zu senken oder zu erh”hen."
PRINT " Durch Druck auf die Leertaste startet das Spiel!"
DO
a$ = INPUT$(1)
IF a$ = "+" AND anz < 20 AND anz < levanz * 2 THEN anz = anz + 2
IF a$ = "-" AND anz > 2 THEN anz = anz - 2
LOCATE 6, 43: PRINT "-"; anz; "+ ";
LOOP UNTIL a$ = " "
IF LEN(n1$) > 10 THEN n1$ = LEFT$(n1$, 10)
IF LEN(n2$) > 10 THEN n2$ = LEFT$(n2$, 10)
FOR i = 1 TO levanz: Spielfolge(i) = i: NEXT
FOR i = levanz TO 1 STEP -1
k = INT(RND * i) + 1: SWAP Spielfolge(i), Spielfolge(k)
NEXT
'Bezeichnung: geg?g - Anzahl aller besiegten Gegner
' geg?w - gewonnene Spiele im Bereich "Gegner" usw;
' s? - gewonnene Bereiche dieses Spieles
geg1g = 0: geg2g = 0: diam1g = 0: diam2g = 0: las1g = 0: las2g = 0
geg1w = 0: geg2w = 0: diam1w = 0: diam2w = 0: las1w = 0: las2w = 0
FOR i = 1 TO anz
level = Spielfolge(((i - 1) MOD anz / 2) + 1)
laden level: edit = 2
IF i > anz / 2 THEN
FOR k = 1 TO 32: FOR j = 5 TO 24
IF f(k, j) = 5 OR f(k, j) = 10 THEN f(k, j) = 15 - f(k, j)
NEXT: NEXT
END IF
zeichne
geg1 = 0: geg2 = 0: diam1 = 0: diam2 = 0: las1 = 0: las2 = 0
LOCATE 1, 5: PRINT "RESTZEIT:"; zeit;
PRINT TAB(45); "SPIEL"; level; " von"; levanz
ret = Spiel: CLS
geg1g = geg1g + geg1: diam1g = diam1g + diam1: las1g = las1g + las1
geg2g = geg2g + geg2: diam2g = diam2g + diam2: las2g = las2g + las2
s1 = 0: s2 = 0
IF geg1 > geg2 THEN geg1w = geg1w + 1: s1 = s1 + 1
IF geg1 < geg2 THEN geg2w = geg2w + 1: s2 = s2 + 1
IF diam1 > diam2 THEN diam1w = diam1w + 1: s1 = s1 + 1
IF diam1 < diam2 THEN diam2w = diam2w + 1: s2 = s2 + 1
IF las1 > las2 THEN las1w = las1w + 1: s1 = s1 + 1
IF las1 < las2 THEN las2w = las2w + 1: s2 = s2 + 1
LOCATE 2, 28: PRINT "S P I E L W E R T U N G"
LOCATE 4, 15: PRINT "Wertungsbereich"; TAB(37); n1$; TAB(52); n2$
LOCATE 6, 15: PRINT "besiegte Gegner:"; TAB(40); geg1; TAB(55); geg2
LOCATE 7, 15: PRINT "gesammelte Diamanten:"; TAB(40); diam1; TAB(55); diam2
LOCATE 8, 15: PRINT "zerst”rte Laser:"; TAB(40); las1; TAB(55); las2
LOCATE 9, 15: PRINT "gewonnene Bereiche:"; TAB(40); s1; TAB(55); s2
LOCATE 11, 15: PRINT "Gesamtpunktzahl:"; TAB(40); geg1 + diam1 + las1 + s1;
PRINT TAB(55); geg2 + diam2 + las2 + s2
LOCATE 15, 27: PRINT "G E S A M T W E R T U N G"
LOCATE 17, 15: PRINT "Wertungsbereich"; TAB(37); n1$; TAB(52); n2$
LOCATE 19, 15: PRINT "Gegner: gesamt"; TAB(40); geg1g; TAB(55); geg2g
LOCATE 20, 26: PRINT "Siege"; TAB(40); geg1w; TAB(55); geg2w
LOCATE 21, 15: PRINT "Diamanten: gesamt"; TAB(40); diam1g; TAB(55); diam2g
LOCATE 22, 26: PRINT "Siege"; TAB(40); diam1w; TAB(55); diam2w
LOCATE 23, 15: PRINT "Laser: gesamt"; TAB(40); las1g; TAB(55); las2g
LOCATE 24, 26: PRINT "Siege"; TAB(40); las1w; TAB(55); las2w
LOCATE 26, 15: PRINT "Gesamtpunktzahl:"; TAB(40); geg1g + geg1w + diam1g + diam1w + las1g + las1w;
PRINT TAB(55); geg2g + geg2w + diam2g + diam2w + las2g + las2w
IF i = anz THEN
a$ = INPUT$(1): CLS
samm1 = geg1g + geg1w + MAX(0, geg1w - geg2w) ^ 2
samm1 = samm1 + diam1g + diam1w + MAX(0, diam1w - diam2w) ^ 2
samm1 = samm1 + las1g + las1w + MAX(0, las1w - las2w) ^ 2
samm2 = geg2g + geg2w + MAX(0, geg2w - geg1w) ^ 2
samm2 = samm2 + diam2g + diam2w + MAX(0, diam2w - diam1w) ^ 2
samm2 = samm2 + las2g + las2w + MAX(0, las2w - las1w) ^ 2
LOCATE 5, 27: PRINT "G E S A M T W E R T U N G"
LOCATE 8, 15: PRINT "Wertungsbereich"; TAB(37); n1$; TAB(52); n2$
LOCATE 10, 15: PRINT "Gegner: gesamt"; TAB(40); geg1g; TAB(55); geg2g
LOCATE 11, 26: PRINT "Siege"; TAB(40); geg1w; TAB(55); geg2w
LOCATE 12, 26: PRINT "Bonus"; TAB(40); MAX(0, geg1w - geg2w) ^ 2;
PRINT TAB(55); MAX(0, geg2w - geg1w) ^ 2;
LOCATE 14, 15: PRINT "Diamanten: gesamt"; TAB(40); diam1g; TAB(55); diam2g
LOCATE 15, 26: PRINT "Siege"; TAB(40); diam1w; TAB(55); diam2w
LOCATE 16, 26: PRINT "Bonus"; TAB(40); MAX(0, diam1w - diam2w) ^ 2;
PRINT TAB(55); MAX(0, diam2w - diam1w) ^ 2;
LOCATE 18, 15: PRINT "Laser: gesamt"; TAB(40); las1g; TAB(55); las2g
LOCATE 19, 26: PRINT "Siege"; TAB(40); las1w; TAB(55); las2w
LOCATE 20, 26: PRINT "Bonus"; TAB(40); MAX(0, las1w - las2w) ^ 2;
PRINT TAB(55); MAX(0, las2w - las1w) ^ 2;
LOCATE 22, 15: PRINT "Gesamtpunktzahl:"; TAB(40); samm1; TAB(55); samm2
END IF
a$ = INPUT$(1)
NEXT
ELSE
FOR level = nr TO levanz
laden level: edit = 2: zeichne
IF schwer = 1 THEN zeit = INT(zeit * 1.5)
IF schwer = 2 THEN zeit = zeit * 2
PRINT TAB(25); "PUNKTE:"; punkte&; TAB(45); "LEBEN:"; leben
a$ = INPUT$(1): IF a$ = CHR$(27) THEN ret = 3 ELSE ret = Spiel: sx = 0
SELECT CASE ret
CASE 3: EXIT FOR
CASE 2: leben = leben - 1: IF leben < 0 THEN EXIT FOR ELSE level = level - 1
END SELECT
NEXT
IF level > levanz THEN level = 1
END IF
END SUB
' Steine zeichnen
'
SUB st (x, y)
SHARED Spiegel$(), leer(), edit, box1x, box1y, box2x, box2y, schirm
SHARED mx, my, m2x, m2y, modus, las(), dat()
IF x < 1 OR x > 32 OR y < 1 OR y > 24 THEN EXIT SUB
nr = f(x, y): IF (nr = 5 OR nr = 10) AND edit = 2 AND modus <> 3 THEN nr = 0
PUT (x * 20 - 20, y * 20 - 20), leer, PSET
t$ = "S4BM" + STR$(x * 20 - 20) + "," + STR$(y * 20 - 20)
IF (nr AND 63) > 0 OR (edit = 1 AND nr < 256) THEN DRAW t$ + Spiegel$(nr AND 63)
IF nr > 255 THEN DRAW t$ + "C14BFR2LD3"
IF edit = 2 THEN
IF x = mx AND y = my THEN DRAW t$ + Spiegel$(5)
IF modus > 1 AND x = m2x AND y = m2y THEN DRAW t$ + Spiegel$(10)
END IF
IF y > 4 THEN
IF (las(x, y) AND 3) THEN
IF dat(f(x, y), 6) AND 4 THEN DRAW "C4BM" + STR$(x * 20 - 10) + "," + STR$(y * 20 - 20) + "D19"
END IF
IF (las(x, y) AND 12) THEN
IF dat(f(x, y), 6) AND 2 THEN DRAW "C4BM" + STR$(x * 20 - 20) + "," + STR$(y * 20 - 10) + "R19"
END IF
END IF
IF edit = 1 THEN
IF ((box1x = x AND box1y = y AND schirm = 0) OR (box2x = x AND box2y = y AND schirm = 1)) THEN DRAW t$ + "C2R19D19L19U19"
IF ((box1x = x AND box1y = y AND schirm = 1) OR (box2x = x AND box2y = y AND schirm = 0)) THEN DRAW t$ + "C4R19D19L19U19"
END IF
END SUB
SUB stklein (wo, nrr, xx, yy)
SHARED Spiegel$(), leerklein(), feld()
nr = feld(nrr, xx, yy)
x = xx + ((wo - 1) MOD 4) * 32
y = yy + 8 + INT((wo - 1) / 4) * 20
PUT (x * 5 - 5, y * 5 - 5), leerklein, PSET
t$ = "S1BM" + STR$(x * 5 - 5) + "," + STR$(y * 5 - 5)
IF (nr AND 63) > 0 OR (edit = 1 AND nr < 256) THEN DRAW t$ + Spiegel$(nr AND 63)
IF nr > 255 THEN DRAW t$ + "C14BFR2LD3"
IF edit = 2 AND x = mx AND y = my THEN DRAW t$ + Spiegel$(5)
IF edit = 1 THEN
IF ((box1x = x AND box1y = y AND schirm = 0) OR (box2x = x AND box2y = y AND schirm = 1)) THEN DRAW t$ + "C2R19D19L19U19"
IF ((box1x = x AND box1y = y AND schirm = 1) OR (box2x = x AND box2y = y AND schirm = 0)) THEN DRAW t$ + "C4R19D19L19U19"
END IF
END SUB
SUB ueberblick (beginn, cursor)
SHARED feld(), levanz
CLS
FOR wo = 1 TO 16
nr = wo + beginn - 1: IF nr > levanz THEN EXIT FOR
FOR i = 1 TO 32: FOR k = 5 TO 24
stklein wo, nr, i, k
NEXT: NEXT
DRAW "S4BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "C14R159D99L159U99"
NEXT
IF wo < 17 THEN DRAW "S4BM" + STR$(((wo - 1) MOD 4) * 160) + "," + STR$(60 + INT((wo - 1) / 4) * 100) + "C14R159D99L159U99"
DRAW "S4C9BM" + STR$(((cursor - 1) MOD 4) * 160) + "," + STR$(60 + INT((cursor - 1) / 4) * 100) + "R159D99L159U99"
LOCATE 1, 5: PRINT "LEVEL"; beginn; "-"; MIN(beginn + 15, levanz)
END SUB
SUB vertausche (x, y)
SHARED optionen(), feld()
FOR i = 1 TO 10: SWAP optionen(x, i), optionen(y, i): NEXT
FOR i = 1 TO 32: FOR k = 5 TO 24: SWAP feld(x, i, k), feld(y, i, k): NEXT k, i
END SUB
' wartet (zeit/100) Sekunden
'
SUB warte (zeit)
t! = TIMER: DO: LOOP UNTIL TIMER > t! + zeit / 100 OR TIMER < t!
END SUB
' Routine zum Laserl”schen
'
SUB weg (m, n, r)
SHARED las(), dat(), sx, sy
x = m: y = n
DO
IF x < 1 OR x > 32 OR y < 5 OR y > 24 OR r = 0 THEN EXIT DO
IF (las(x, y) AND 15) = 0 THEN EXIT DO
f = f(x, y) AND 63
r = r + (r > 2) + 3 * (r > 4): r = dat(f(x, y) AND 63, r)
xn = x: yn = y
IF (r AND 1) = 1 AND (las(x, y) AND 1) = 1 THEN
las(x, y) = las(x, y) - 1: IF f < 5 THEN yn = y - 1 ELSE weg x, y - 1, 1: IF x <> sx OR y <> sy THEN hin x, y
END IF
IF (r AND 2) = 2 AND (las(x, y) AND 2) = 2 THEN
las(x, y) = las(x, y) - 2: IF f < 5 THEN yn = y + 1 ELSE weg x, y + 1, 2: IF x <> sx OR y <> sy THEN hin x, y
END IF
IF (r AND 4) = 4 AND (las(x, y) AND 4) = 4 THEN
las(x, y) = las(x, y) - 4: IF f < 5 THEN xn = x - 1 ELSE weg x - 1, y, 4: IF x <> sx OR y <> sy THEN hin x, y
END IF
IF (r AND 8) = 8 AND (las(x, y) AND 8) = 8 THEN
las(x, y) = las(x, y) - 8: IF f < 5 THEN xn = x + 1 ELSE weg x + 1, y, 8: IF x <> sx OR y <> sy THEN hin x, y
END IF
st x, y
IF (dat(f, 6) AND 4) = 4 AND las(x, y) AND 3 THEN DRAW "C4BM" + STR$(x * 20 - 10) + "," + STR$(y * 20 - 20) + "D20"
IF (dat(f, 6) AND 2) = 2 AND las(x, y) AND 12 THEN DRAW "C4BM" + STR$(x * 20 - 20) + "," + STR$(y * 20 - 10) + "R20"
IF x = xn AND y = yn THEN EXIT DO
x = xn: y = yn
LOOP UNTIL f <> 0
END SUB
' zeichnet ganzes Feld
'
SUB zeichne
SHARED edit, anz, level, levanz, wechselanz, wx(), wy(), wt()
SHARED mx, my, m2x, m2y, suchx, suchy, such2x, such2y, modus, Leute()
ERASE Leute
CLS : suchx = 0: mx = 0: such2x = 0: m2x = 0: wechselanz = 0
FOR i = 1 TO 32
IF edit = 1 THEN
IF i < 7 THEN f(i, 2) = i - 1: st i, 2
IF i < anz - 9 THEN f(i, 3) = i + 10: st i, 3
END IF
f(i, 4) = 30: st i, 4
FOR k = 5 TO 24
st i, k
IF modus = 3 THEN
IF f(i, k) = 5 AND Leute(1, 0) < 50 THEN
L = Leute(1, 0) + 1: Leute(1, 0) = L
Leute(1, L) = i + k * 32 - 1
END IF
IF f(i, k) = 10 AND Leute(2, 0) < 50 THEN
L = Leute(2, 0) + 1: Leute(2, 0) = L
Leute(2, L) = i + k * 32 - 1
END IF
END IF
IF f(i, k) = 5 AND modus <> 3 THEN
IF suchx = 0 THEN suchx = i: suchy = k ELSE such2x = i: such2y = k
END IF
IF f(i, k) > 255 THEN
wechselanz = wechselanz + 1: wx(wechselanz) = i: wy(wechselanz) = k
wt(wechselanz) = INT(f(i, k) / 256)
IF edit = 2 THEN f(i, k) = f(i, k) AND 63
END IF
NEXT
NEXT
IF edit = 1 AND modus = 3 THEN f(8, 2) = 10: st 8, 2
IF modus <> 3 THEN
IF suchx = 0 THEN suchx = 16: suchy = 14
IF such2x = 0 THEN such2x = 17: such2y = 15
mx = suchx: my = suchy: m2x = such2x: m2y = such2y
st mx, my: IF modus > 1 THEN st m2x, m2y
END IF
LOCATE 1, 60: PRINT "LEVEL"; USING " ##"; level;
IF edit = 1 THEN
f(7, 2) = 256: st 7, 2
PRINT " von"; USING " ##"; levanz
LOCATE 2, 59: PRINT wechselanz; " Wechsler"
END IF
END SUB