 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
 Verfasst am: 30.07.2006, 16:48 Titel: QB Schachprogramm |
 |
|
Hallo. Ich arbeite schon eine ganze Weile an meinem Schachprogramm
für QB. Ich wollte zuerst das Schachprogramm nur für 2 Spieler
programmieren, hab dann später aber noch eine KI hinzugefügt,das
hat mich wirklich sehr viel Zeit und Nerven gekostet. Jetzt bin ich fast
fertig, die aktuelle version läuft noch etwas instabil, aber das beheb ich noch. Wollt nur mal wissen was andere Programmierer bis jetzt von meinem Programm halten. Setzt an mein Programm aber nicht die
selben Maßstäbe wie an neue kommerzielle Spiele, das ist mir auch klar
das ich sowas nicht toppen kann. Ich hab so ein paar Bekannte die
nerven mich deswegen ständig aber das ist jetzt egal.
Hier der Code, einfach in den Texteditor kopieren und als bas datei
abspeichern:
Hinweis: das Prog läuft super mit Qb 45 und Vbdos,
compilieren lässt es sich aber nur mit VBDOS.
| Code: |
DECLARE FUNCTION fz% (depth%, sp%)
DECLARE FUNCTION zr% (min%, max%)
DECLARE FUNCTION pvalid% (posix%, posiy%)
DECLARE SUB setf (m%, t%, n%, x%, y%)
DEFINT A-Z
WIDTH 40, 25
CLEAR , , 30000
CONST true = -1
CONST false = 0
TYPE v2dd
x AS INTEGER
y AS INTEGER
END TYPE
TYPE fe
m AS INTEGER
t AS INTEGER
n AS INTEGER
END TYPE
DIM SHARED stemp
DIM SHARED feld(9, 9) AS fe
FOR co = 0 TO 9
feld(0, co).m = 3
feld(co, 0).m = 3
feld(9, co).m = 3
feld(co, 9).m = 3
NEXT co
DIM SHARED maxd: maxd = 10
DIM SHARED fragged(1 TO maxd)
DIM SHARED fout(1 TO 2, 1 TO 6, 1 TO 9)
DIM SHARED kis(1 TO 2)
DIM SHARED wb2(1 TO 2): wb2(1) = 2: wb2(2) = 7
DIM SHARED gg(1 TO 2)
gg(1) = 2: gg(2) = 1
DIM SHARED zg(1 TO 200, 1 TO 2) AS v2dd
DIM SHARED zuege
DIM SHARED score(200)
RANDOMIZE TIMER
DIM SHARED ri(1 TO 8) AS v2dd
ri(1).x = 0: ri(1).y = 1
ri(2).x = 0: ri(2).y = -1
ri(3).x = 1: ri(3).y = 0
ri(4).x = -1: ri(4).y = 0
ri(5).x = 1: ri(5).y = 1
ri(6).x = 1: ri(6).y = -1
ri(7).x = -1: ri(7).y = 1
ri(8).x = -1: ri(8).y = -1
DIM SHARED sri(1 TO 8) AS v2dd
sri(1).x = 1: sri(1).y = 2
sri(2).x = 1: sri(2).y = -2
sri(3).x = -1: sri(3).y = 2
sri(4).x = -1: sri(4).y = -2
sri(5).x = 2: sri(5).y = 1
sri(6).x = 2: sri(6).y = -1
sri(7).x = -2: sri(7).y = 1
sri(8).x = -2: sri(8).y = -1
DIM SHARED kk(6)
kk(1) = 10
kk(2) = 50
kk(3) = 60
kk(4) = 100
kk(5) = 150
kk(6) = 1000
DIM SHARED z(6) AS STRING * 1
DIM SHARED fig(1 TO 2, 1 TO 6, 1 TO 9) AS v2dd
z(1) = "B"
z(2) = "T"
z(3) = "S"
z(4) = "L"
z(5) = "Q"
z(6) = "K"
DIM SHARED opt(1 TO 4) AS STRING
DIM SHARED menu(1 TO 2)
opt(1) = "Mensch"
opt(2) = "Computer 1"
opt(3) = "Computer 2"
opt(4) = "Computer 3"
menu(1) = 1
menu(2) = 3
COLOR 14: PRINT "Wilkommmen zu SHI Schach 2006!!!!"
COLOR 15: PRINT "(1) Spieler 1:" + opt(menu(1))
PRINT "(2) Spieler 2:" + opt(menu(2))
PRINT "(3) Spiel starten"
DO
t$ = INKEY$
SELECT CASE t$
CASE CHR$(27): END
CASE "1"
menu(1) = menu(1) MOD 4 + 1
LOCATE 2, 15: PRINT opt(menu(1)) + " "
CASE "2"
menu(2) = menu(2) MOD 4 + 1
LOCATE 3, 15: PRINT opt(menu(2)) + " "
CASE "3"
kis(1) = menu(1) > 1
kis(2) = menu(2) > 1
EXIT DO
END SELECT
LOOP
CLS
COLOR 0
FOR co = 1 TO 8
FOR co2 = 1 TO 8
feld(co, co2).m = 0
LOCATE co, co2: PRINT "Û"
NEXT co2
NEXT co
COLOR 15: LOCATE 20, 1: PRINT "Hallo " + ENVIRON$("USERNAME") + "!!!!!"
COLOR 14: PRINT "Super Heizio Chess by SHI Softworks"
DIM SHARED numfig(1 TO 2, 6)
FOR co = 1 TO 2
numfig(co, 1) = 8
numfig(co, 2) = 2
numfig(co, 3) = 2
numfig(co, 4) = 2
numfig(co, 5) = 1
numfig(co, 6) = 1
NEXT co
FOR co = 1 TO 8
CALL setf(1, 1, co, co, 2)
CALL setf(2, 1, co, co, 7)
NEXT co
CALL setf(1, 2, 1, 1, 1)
CALL setf(2, 2, 1, 1, 8)
CALL setf(1, 2, 2, 8, 1)
CALL setf(2, 2, 2, 8, 8)
CALL setf(1, 3, 1, 2, 1)
CALL setf(2, 3, 1, 2, 8)
CALL setf(1, 3, 2, 7, 1)
CALL setf(2, 3, 2, 7, 8)
CALL setf(1, 4, 1, 3, 1)
CALL setf(2, 4, 1, 3, 8)
CALL setf(1, 4, 2, 6, 1)
CALL setf(2, 4, 2, 6, 8)
CALL setf(1, 5, 1, 4, 1)
CALL setf(2, 5, 1, 4, 8)
CALL setf(1, 6, 1, 5, 1)
CALL setf(2, 6, 1, 5, 8)
COLOR 15
FOR co3 = 1 TO 2
COLOR co3 + 8
FOR co2 = 1 TO 6
FOR co = 1 TO numfig(co3, co2)
LOCATE fig(co3, co2, co).y, fig(co3, co2, co).x: PRINT z(co2)
fout(co3, co2, co) = false
NEXT co
NEXT co2
NEXT co3
DIM cpos AS v2dd
DIM oldpos AS v2dd
DIM zug(1 TO 3) AS v2dd
cpos.x = 1: cpos.y = 1
zugr = 0
spieler = 1
IF kis(1) = true THEN
COLOR 4: GOTO bz
END IF
start:
DO
oldc = SCREEN(cpos.y, cpos.x, 1)
COLOR 5: LOCATE cpos.y, cpos.x: PRINT CHR$(SCREEN(cpos.y, cpos.x))
DO
t$ = INKEY$
oldpos = cpos
SELECT CASE t$
CASE CHR$(0) + "H"
IF cpos.y >= 2 THEN cpos.y = cpos.y - 1
CASE CHR$(0) + "P"
IF cpos.y <= 7 THEN cpos.y = cpos.y + 1
CASE CHR$(0) + "K"
IF cpos.x >= 2 THEN cpos.x = cpos.x - 1
CASE CHR$(0) + "M"
IF cpos.x <= 7 THEN cpos.x = cpos.x + 1
CASE CHR$(27): END
CASE " "
SELECT CASE zugr
CASE 0
IF feld(cpos.x, cpos.y).m = spieler THEN
zugr = 1
zug(1) = cpos
COLOR 4: LOCATE 3, 11: PRINT CHR$(64 + cpos.x) + LTRIM$(STR$(cpos.y)) + " "
END IF
CASE 1:
zug:
zugr = 0
SELECT CASE feld(zug(1).x, zug(1).y).t
CASE 1
IF ((zug(1).y = cpos.y + 1 - (spieler MOD 2) * 2 AND feld(cpos.x, cpos.y).m = 0) OR (zug(1).y = 7 AND spieler = 2 AND cpos.y = 5 AND feld(zug(1).x, 6).m = 0) OR (zug(1).y = 2 AND feld(zug(1).x, 3).m = 0 AND spieler = 1 AND cpos.y = 4)) AND zug(1). _
x = cpos.x THEN
IF cpos.y = 8 OR cpos.y = 1 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
fig(spieler, 1, feld(zug(1).x, zug(1).y).n) = fig(spieler, 1, numfig(spieler, 1))
numfig(spieler, 1) = numfig(spieler, 1) - 1
numfig(spieler, 5) = numfig(spieler, 5) + 1: BEEP
feld(zug(1).x, zug(1).y).t = 5
ELSE CALL setf(spieler, 1, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
END IF
'PRINT cpos.y
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF zug(1).y = cpos.y + 1 - 2 * (spieler MOD 2) AND feld(cpos.x, cpos.y).m = spieler MOD 2 + 1 AND ABS(cpos.x - zug(1).x) = 1 THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
IF cpos.y = 8 OR cpos.y = 1 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
fig(spieler, 1, feld(zug(1).x, zug(1).y).n) = fig(spieler, 1, numfig(spieler, 1))
numfig(spieler, 1) = numfig(spieler, 1) - 1
numfig(spieler, 5) = numfig(spieler, 5) + 1: BEEP
feld(zug(1).x, zug(1).y).t = 5
ELSE CALL setf(spieler, 1, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
END IF
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
LOCATE 3, 9: PRINT " "
CASE 2
IF (NOT feld(cpos.x, cpos.y).m = spieler) THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF zug(2).x = 0 THEN
zug(2).y = zug(2).y / ABS(zug(2).y)
ELSE
IF zug(2).y = 0 THEN zug(2).x = zug(2).x / ABS(zug(2).x)
END IF
IF zug(2).x = 0 OR zug(2).y = 0 THEN
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextt
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 2, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 2, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextt:
LOCATE 3, 9: PRINT " "
CASE 4:
IF feld(cpos.x, cpos.y).m <> spieler THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF ABS(zug(2).x) = ABS(zug(2).y) THEN
IF zug(2).x > 0 THEN zug(2).x = 1 ELSE zug(2).x = -1
IF zug(2).y > 0 THEN zug(2).y = 1 ELSE zug(2).y = -1
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
'SLEEP: LOCATE 1, 1: PRINT zug(3).x, zug(3).y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextl
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 4, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 4, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextl:
LOCATE 3, 9: PRINT " "
CASE 5:
IF (NOT feld(cpos.x, cpos.y).m = spieler) THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF ABS(zug(2).x) = ABS(zug(2).y) OR zug(2).x = 0 OR zug(2).y = 0 THEN
IF zug(2).x > 0 THEN zug(2).x = 1
IF zug(2).x < 0 THEN zug(2).x = -1
IF zug(2).y > 0 THEN zug(2).y = 1
IF zug(2).y < 0 THEN zug(2).y = -1
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextq
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextq:
LOCATE 3, 9: PRINT " "
CASE 3
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF (ABS(zug(2).x) = 2 AND ABS(zug(2).y) = 1) OR (ABS(zug(2).x) = 1 AND ABS(zug(2).y) = 2) THEN
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 3, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF NOT feld(cpos.x, cpos.y).m = spieler THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 3, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nexts:
LOCATE 3, 9: PRINT " "
CASE 6
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF (ABS(zug(2).x) = 1 OR zug(2).x = 0) AND (ABS(zug(2).y) = 1 OR zug(2).y = 0) THEN
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 6, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF NOT feld(cpos.x, cpos.y).m = spieler THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 6, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextk:
LOCATE 3, 9: PRINT " "
END SELECT
END SELECT
END SELECT
IF NOT (oldpos.x = cpos.x AND oldpos.y = cpos.y) THEN
COLOR oldc
LOCATE oldpos.y, oldpos.x: PRINT CHR$(SCREEN(oldpos.y, oldpos.x))
GOTO start
END IF
nextn:
LOOP
LOOP
zvalid:
COLOR 4: LOCATE 3, 14: PRINT CHR$(64 + cpos.x) + LTRIM$(STR$(cpos.y))
spieler = spieler MOD 2 + 1
IF kis(spieler) = true THEN
bz:
maxd = menu(spieler) + 1
zuege = 0
temp = fz(1, spieler)
LOCATE 10, 1: PRINT temp, zuege
IF temp > 0 OR true THEN
LOCATE 1, 20
FOR co = 1 TO zuege
IF score(co) = temp THEN
LOCATE CSRLIN + 1, 20: PRINT zg(co, 1).x; " "; zg(co, 1).y; " "; zg(co, 2).x; " "; zg(co, 2).y;
IF CSRLIN = 16 THEN
LOCATE 1, 20
SLEEP
END IF
END IF
NEXT co
FOR co = CSRLIN + 1 TO 16
LOCATE co, 20: PRINT " "
NEXT co
END IF
DO
co = zr(1, zuege)
t$ = INKEY$: IF t$ = CHR$(27) THEN END
LOOP UNTIL score(co) >= temp - (4 - menu(spieler)) * 5
zug(1) = zg(co, 1)
cpos = zg(co, 2)
DO
t$ = INKEY$: IF t$ = CHR$(27) THEN END
LOOP UNTIL t$ <> ""
COLOR 4: LOCATE 3, 11: PRINT CHR$(64 + zug(1).x) + LTRIM$(STR$(zug(1).y)) + " "
GOTO zug
END IF
RETURN
drawst:
COLOR spieler + 8: LOCATE cpos.y, cpos.x: PRINT z(feld(zug(1).x, zug(1).y).t)
COLOR 0: LOCATE zug(1).y, zug(1).x: PRINT "Û"
feld(zug(1).x, zug(1).y).m = 0: oldc = spieler + 8
RETURN
FUNCTION fz (depth, sp)
DIM sop AS v2dd
DIM sof AS fe
IF depth = maxd THEN
fz = 0
ELSE
zmin = 30000
zmax = -30000
FOR sco1 = 1 TO numfig(sp, 1)
IF fout(sp, 1, sco1) = false THEN
IF fig(sp, 1, sco1).y <> 8 - (sp - 1) * 7 THEN
IF fig(sp, 1, sco1).y = wb2(gg(sp)) AND false = true THEN
fout(sp, 1, sco1) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
IF feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
numfig(sp, 5) = numfig(sp, 5) + 1
fig(sp, 5, numfig(sp, 5)).y = fig(sp, 1, sco1).y + ri(sp).y
fig(sp, 5, numfig(sp, 5)).x = fig(sp, 1, sco1).x
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = sp
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).t = 5
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).n = numfig(sp, 5)
fragged(depth) = kk(5) - kk(1)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
'CALL fz(depth + 1, gg(sp))
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = 0
numfig(sp, 5) = numfig(sp, 5) - 1
END IF
IF fig(sp, 1, sco1).x - 1 > 0 THEN
IF feld(fig(sp, 1, sco1).x - 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
numfig(sp, 5) = numfig(sp, 5) + 1
fig(sp, 5, numfig(sp, 5)).y = fig(sp, 1, sco1).y + ri(sp).y
fig(sp, 5, numfig(sp, 5)).x = fig(sp, 1, sco1).x - 1
sof = feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(5) - kk(1) + kk(sof.t)
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = sp
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).t = 5
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).n = numfig(sp, 5)
LOCATE 20, 20: PRINT fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y: SLEEP
'CALL fz(depth + 1, gg(sp))
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y) = sof
numfig(sp, 5) = numfig(sp, 5) - 1
fout(sof.m, sof.t, sof.n) = false
END IF
END IF
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fout(sp, 1, sco1) = false
ELSE
IF feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
sop.y = fig(sp, 1, sco1).y
fig(sp, 1, sco1).y = sop.y + ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = feld(fig(sp, 1, sco1).x, sop.y)
feld(fig(sp, 1, sco1).x, sop.y).m = 0
fragged(depth) = 0:
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).y = sop.y
zg(zuege, 1).x = fig(sp, 1, sco1).x
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
END IF
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
IF wb2(sp) = sop.y AND feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).y = sop.y
zg(zuege, 1).x = fig(sp, 1, sco1).x
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
END IF
fig(sp, 1, sco1).y = sop.y
feld(fig(sp, 1, sco1).x, sop.y).m = sp
feld(fig(sp, 1, sco1).x, sop.y).t = 1
feld(fig(sp, 1, sco1).x, sop.y).n = sco1
END IF
IF fig(sp, 1, sco1).x - 1 > 0 THEN
IF feld(fig(sp, 1, sco1).x - 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x - 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
sof = feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: ' SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 1, sco1).x + 1
zg(zuege, 1).y = fig(sp, 1, sco1).y - ri(sp).y
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x + 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y - ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
END IF
END IF
IF fig(sp, 1, sco1).x + 1 <= 8 THEN
IF feld(fig(sp, 1, sco1).x + 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x + 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
sof = feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: ' SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 1, sco1).x - 1
zg(zuege, 1).y = fig(sp, 1, sco1).y - ri(sp).y
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x - 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y - ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
END IF
END IF
END IF
END IF
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 3)
IF fout(sp, 3, sco1) = false THEN
FOR sco2 = 1 TO 8
IF pvalid(fig(sp, 3, sco1).x + sri(sco2).x, fig(sp, 3, sco1).y + sri(sco2).y) = true THEN
SELECT CASE feld(fig(sp, 3, sco1).x + sri(sco2).x, fig(sp, 3, sco1).y + sri(sco2).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x + sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y + sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 3, sco1).x, fig(sp, 3, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 3, sco1).x - sri(sco2).x
zg(zuege, 1).y = fig(sp, 3, sco1).y - sri(sco2).y
zg(zuege, 2) = fig(sp, 3, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x - sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y - sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
CASE gg(sp)
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x + sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y + sri(sco2).y
sof = feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 3, sco1).x, fig(sp, 3, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 3, sco1).x - sri(sco2).x
zg(zuege, 1).y = fig(sp, 3, sco1).y - sri(sco2).y
zg(zuege, 2) = fig(sp, 3, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x - sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y - sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
END SELECT
END IF
NEXT sco2
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 2)
IF fout(sp, 2, sco1) = false THEN
sop = fig(sp, 2, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 4
fig(sp, 2, sco1).x = fig(sp, 2, sco1).x + ri(sco2).x
fig(sp, 2, sco1).y = fig(sp, 2, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y) = true
SELECT CASE feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = sp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).t = 2
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 2, sco1).x, fig(sp, 2, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 2, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = sp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).t = 2
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 2, sco1).x, fig(sp, 2, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 2, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 2, sco1).x = fig(sp, 2, sco1).x + ri(sco2).x
fig(sp, 2, sco1).y = fig(sp, 2, sco1).y + ri(sco2).y
LOOP
fig(sp, 2, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 2
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 4)
IF fout(sp, 4, sco1) = false THEN
sop = fig(sp, 4, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 5 TO 8
fig(sp, 4, sco1).x = fig(sp, 4, sco1).x + ri(sco2).x
fig(sp, 4, sco1).y = fig(sp, 4, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y) = true
SELECT CASE feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = sp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).t = 4
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 4, sco1).x, fig(sp, 4, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 4, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = sp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).t = 4
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp,4, sco1).x, fig(sp, 4, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 4, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 4, sco1).x = fig(sp, 4, sco1).x + ri(sco2).x
fig(sp, 4, sco1).y = fig(sp, 4, sco1).y + ri(sco2).y
LOOP
fig(sp, 4, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 4
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 5)
IF fout(sp, 5, sco1) = false THEN
sop = fig(sp, 5, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 8
fig(sp, 5, sco1).x = fig(sp, 5, sco1).x + ri(sco2).x
fig(sp, 5, sco1).y = fig(sp, 5, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y) = true
SELECT CASE feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = sp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).t = 5
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 5, sco1).x, fig(sp, 5, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 5, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = sp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).t = 5
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 5, sco1).x, fig(sp, 5, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 5, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 5, sco1).x = fig(sp, 5, sco1).x + ri(sco2).x
fig(sp, 5, sco1).y = fig(sp, 5, sco1).y + ri(sco2).y
LOOP
fig(sp, 5, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 5
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 6)
IF fout(sp, 6, sco1) = false THEN
sop = fig(sp, 6, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 8
fig(sp, 6, sco1).x = fig(sp, 6, sco1).x + ri(sco2).x
fig(sp, 6, sco1).y = fig(sp, 6, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y) = true
SELECT CASE feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = sp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).t = 6
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 6, sco1).x, fig(sp, 6, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 6, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = sp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).t = 6
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 6, sco1).x, fig(sp, 6, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 6, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
EXIT DO
LOOP
fig(sp, 6, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 6
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
IF depth MOD 2 = 1 THEN fz = zmax ELSE fz = zmin
END IF
END FUNCTION
FUNCTION pvalid (posix, posiy)
IF posiy <= 0 THEN pvalid = false: EXIT FUNCTION
IF posiy >= 9 THEN pvalid = false: EXIT FUNCTION
IF posix >= 9 THEN pvalid = false: EXIT FUNCTION
IF posix <= 0 THEN pvalid = false: EXIT FUNCTION
pvalid = true
END FUNCTION
SUB setf (m, t, n, x, y)
feld(x, y).m = m
feld(x, y).t = t
feld(x, y).n = n
fig(m, t, n).x = x
fig(m, t, n).y = y
END SUB
FUNCTION zr (min, max)
zr = min + RND * (max - min)
END FUNCTION
|
Zuletzt bearbeitet von Heizi am 30.07.2006, 18:00, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 30.07.2006, 16:53 Titel: |
|
|
es scheint fast so als ob 8 mit ) danach mit einem Smilie ersetzt
wurde. einfach ändern oder wo kann ich die Datei hochladen?? |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 30.07.2006, 16:57 Titel: |
|
|
Setze den Code zwischen code- Tags. füge dazu einfach ein [code] am Anfang und ein [/code] am Ende ein.
Also so:
[code]
Dein Code
[/code]
Dann machst du eine Haken bei "Smilies in diesem Beitrag deaktivieren".
Man kann Code bei http://www.freebasic.de/fbnp hochladen, aber der Server ist down...
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
|
|
| Nach oben |
|
|
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 30.07.2006, 18:11 Titel: |
|
|
Danke für deinen Tipp, jetzt sollte es funktionieren, hab es gerade
ausprobiert. Hat es auch schon wer anders ausprobiert???
Schreibt eure (vorzugsweise konstruktive) Meinung!!!! |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 30.07.2006, 18:50 Titel: |
|
|
Hi Heizi,
ich beherrsche bei Schach lediglich die Grundzüge und habe somit nicht den Drang, das Programm auszuprobieren..
..aber wenn du Vergleichsmöglichkeiten suchst, sich dir mal das Programm von Sysophon2001 an,
vielleicht kriegste ja da noch ein paar Denkanstöße
Andere FB-Games
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 30.07.2006, 18:58 Titel: |
|
|
Ich würde es gerne ausprobieren  .
Zumal da ich VBDOS habe  .
Uun zum anderen, weil ich Schach kann  .
Edit:
1. Der König kann nicht ins Schach
2. Seit wann kann man den König schlagen? Ist ja ganz was neues .
3. Man ist eigentlich GameOver wenn man den König "geschlagen" hat.
Aber sonst:
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
Zuletzt bearbeitet von raph ael am 30.07.2006, 19:18, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 30.07.2006, 19:10 Titel: |
|
|
@raphael:
Einfach den Code markieren indem du den Anfang des Codes anklickst
und die Maustaste nicht mehr loslässt und die Maus dann zum Ende
des Codes ziehst. Dann machst du einen Rechtsklick und klickst
auf kopieren. Dann Öffnest du den Texteditor von Windows
und klickst auf Bearbeiten-> Einfügen. Dann speicherst du
die Datei z.B. unter c:\chess.bas ab. WIchtig ist nur die Endung bas.
Dann öffnest du die Datei mit QB, den Rest solltest du kennen.
Tastaturbelegung: Pfeiltasten Steuerung, Leertaste:Figur asuwählen.
Viel Spass!!!!
@ytwinki:
Dieses Schachprogramm ist echt ziemlich gut, besonders die Grafik
ist um Einiges besser als bei meinem. Der einzige Vorteil meines
Programmes der mir da einfällt ist dass es unter Dos läuft. |
|
| Nach oben |
|
|
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 30.07.2006, 19:14 Titel: |
|
|
ich finde das ist ein gutes Feature. Das beschleunigt das Spiel gegen
Schachanfänger. Wenn die nichteinmal merken das ihr König im Schach steht dann würde das Spiel weiterzuspielen nicht besonders Spass machen. Die Spielbarkeit wird davon aber nicht beeinträchtigt,
da wenn man den König matt gesetzt hat man ihn auch schlagen kann. |
|
| Nach oben |
|
|
Dominik
Anmeldungsdatum: 22.12.2004
Beiträge: 172
|
| Verfasst am: 31.07.2006, 15:12 Titel: |
|
|
Ich finde dieses "Feature" nicht gut.
Den König zu schlagen und in's Schach zu ziehen sind unmögliche Züge und sollten von keinem Schachprogramm zugelassen werden.
Was du nöch hinzufügen solltest, wäre die Rochade und En passant. |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 31.07.2006, 15:29 Titel: |
|
|
| Heizi hat Folgendes geschrieben: | | Die aktuelle Version läuft noch etwas instabil |
Die nächste hoffentlich nicht mehr...
Aber Fritz zu viel Festplattenspeicher braucht, ist das schonmal ein Anfang.
MfG Raphael
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
|
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 31.07.2006, 15:29 Titel: |
|
|
Ich würd mal sagen die KI in deinem Spiel ist sehr gut... 
Ich finde allerdings, du könntest folgendes noch tun:
- Schachfiguren + Schachbrett grafisch darstellen (z.B. in SCREEN 12, also relativ hohe Auflösung)
- Beim Startbildschirm die Tastaturbelegung auflisten
Das würde das Spiel denke ich mal perfekt machen, denn ich finde mich auf dem Textbasierenden Schachbrett ehrlich gesagt nicht so gut zurecht...
Das ist ja nur noch Arbeit.
Wie gesagt: Sonst ist das Spiel gut...
Grüße, Elvis
_________________
Geforce 7300GT (256MB GDDR3, Gainward) -- 2x 512MB (DDR2 800, MDT) -- AMD Athlon64 X2 EE 3800+ -- Asrock ALiveNF5-eSATA2+ |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 31.07.2006, 16:04 Titel: |
|
|
Jepp, am wichtigsten ist mir aber jetzt das Schach- Matt.
Das Spiel ist nämlich erst zuende, wenn 1 Spieler alle Figuren vom Feld hat, und dadurch gibt es einen Laufzeitfehler, der das Programm abschießt.
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
|
|
| Nach oben |
|
|
SpionAtom
Anmeldungsdatum: 10.01.2005
Beiträge: 395
|
| Verfasst am: 31.07.2006, 17:43 Titel: |
|
|
Schaut, was ich gefunden habe: Eine Schachoberfläche, leider ganz ohne Funktionalität, und für den TEXTMODUS! Vielleicht kannst du da ja deinen Code einbetten 
Und ich weiß, das Pferd sieht nicht unbedingt aus wie ein Pferd, aber was soll man machen, wenn man nur Asciizeichen zur Verfügung hat... 
| Code: | ' Schach
' f?r den Text-Modus
' von Thomas Decker 11.1.2003
DEFINT A-Z
CONST curserColor = 1
CONST schwarzFigur = 0
CONST weissFigur = 15
CONST schwarzFeld = 6
CONST weissFeld = 7
DECLARE SUB Spiel.Laden (nr)
DECLARE SUB Spiel.Malen ()
DECLARE SUB MalFeld (zeile, spalte, c)
DECLARE SUB Spiel.Spielen ()
DECLARE SUB Ende ()
DECLARE FUNCTION richtigesFeld (pWahl, pDran, gew$)
DECLARE SUB PlaySound (nr)
DECLARE SUB InfoBox (nr, dran, p1, p2, g$)
DECLARE SUB Rahmen (n%, x1%, y1%, x2%, y2%)
COLOR 0, 1
1 CLS
DIM SHARED feld$(1 TO 8, 1 TO 8)
PlaySound -1
Spiel.Laden 1
Spiel.Malen
Spiel.Spielen
Spielstand.Normal:
DATA "tsldklst"
DATA "bbbbbbbb"
DATA " "
DATA " "
DATA " "
DATA " "
DATA "BBBBBBBB"
DATA "TSLDKLST"
SUB Ende
COLOR 7, 0
SYSTEM
END SUB
SUB InfoBox (nr, dran, p1, p2, g$)
SELECT CASE nr
CASE 1
COLOR 2, 1
Rahmen 1, 23, 51, 25, 80
text$ = CHR$(64 + p2) + "/" + LTRIM$(RTRIM$(STR$(9 - p1)))
IF g$ <> " " THEN
IF g$ = UCASE$(g$) THEN text$ = text$ + " - Weiss"
IF g$ = LCASE$(g$) THEN text$ = text$ + " - Schwarz"
END IF
SELECT CASE UCASE$(g$)
CASE "K": text$ = text$ + " - K”nig"
CASE "D": text$ = text$ + " - Dame"
CASE "L": text$ = text$ + " - L„ufer"
CASE "S": text$ = text$ + " - Springer"
CASE "T": text$ = text$ + " - Turm"
CASE "B": text$ = text$ + " - Bauer"
CASE ELSE: text$ = text$ + " - leeres Feld"
END SELECT
LOCATE 24, 52: PRINT text$ + SPACE$(27 - LEN(text$) + 1);
CASE ELSE
END SELECT
END SUB
SUB MalFeld (zeile, spalte, c)
IF (zeile + spalte) MOD 2 THEN bg = schwarzFeld ELSE bg = weissFeld
COLOR bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
SELECT CASE feld$(zeile, spalte)
CASE "k"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÅKINGÅ";
CASE "K"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÅKINGÅ";
CASE "d"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "DAME";
CASE "D"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "DAME";
CASE "t"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " Ü Ü ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "T"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " Ü Ü ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "s"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " ßÜÜ¿ ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ³³ ";
CASE "S"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " ßÜÜ¿ ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ³³ ";
CASE "l"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " LŽUF ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ER ";
CASE "L"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " LŽUF ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ER ";
CASE "b"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "B"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE ELSE
END SELECT
IF c = 0 THEN EXIT SUB
COLOR curserColor, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT "É";
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 6 + 1: PRINT "»";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 1 + 1: PRINT "È";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 6 + 1: PRINT "¼";
END SUB
SUB PlaySound (nr)
STATIC schalter 'wenn nummer = -1, dann schaltet der Schalter um auf an oder
' aus (je nachdem, wo er vorher war)
IF nr = -1 THEN IF schalter = 1 THEN schalter = 0 ELSE schalter = 1
IF schalter = 0 THEN EXIT SUB
PLAY "MB" 'Spiele die T”ne im Hintergrund
SELECT CASE nr
CASE 1 'Falsches Feld gew„hlt
PLAY "L32O1GFEDC"
CASE 2 'Richtiges Feld gew„hlt
PLAY "L26O5CCDG"
CASE ELSE
END SELECT
END SUB
SUB Rahmen (n, x1, y1, x2, y2)
SELECT CASE n
CASE 1
Ecke1$ = "À"
Ecke3$ = "Ù"
Ecke7$ = "Ú"
Ecke9$ = "¿"
Wager$ = "Ä"
Senkr$ = "³"
CASE 2
Ecke1$ = "È"
Ecke3$ = "¼"
Ecke7$ = "É"
Ecke9$ = "»"
Wager$ = "Í"
Senkr$ = "º"
CASE 3
Ecke1$ = "Û"
Ecke3$ = "Û"
Ecke7$ = "Û"
Ecke9$ = "Û"
Wager$ = "Û"
Senkr$ = "Û"
CASE 4
Ecke1$ = "Û"
Ecke3$ = "Û"
Ecke7$ = "Û"
Ecke9$ = "Û"
Wager$ = ""
Senkr$ = "Û"
FOR i = y1 + 1 TO y2 - 1
LOCATE x1, i: PRINT "ß";
LOCATE x2, i: PRINT "Ü";
NEXT i
CASE ELSE
EXIT SUB
END SELECT
LOCATE x1, y1: PRINT Ecke7$;
LOCATE x1, y2: PRINT Ecke9$;
LOCATE x2, y1: PRINT Ecke1$;
LOCATE x2, y2: PRINT Ecke3$;
FOR i = x1 + 1 TO x2 - 1
LOCATE i, y1: PRINT Senkr$;
LOCATE i, y2: PRINT Senkr$;
NEXT i
FOR i = y1 + 1 TO y2 - 1
LOCATE x1, i: PRINT Wager$;
LOCATE x2, i: PRINT Wager$;
NEXT i
END SUB
FUNCTION richtigesFeld (pWahl, pDran, gew$)
ret = 0
IF pWahl = 1 THEN
Figuren$ = "KDLSTB"
IF pDran = 1 THEN IF INSTR(UCASE$(Figuren$), gew$) THEN ret = 1
IF pDran = 2 THEN IF INSTR(LCASE$(Figuren$), gew$) THEN ret = 1
END IF
IF pWahl = 2 THEN
BEEP
END IF
richtigesFeld = ret
END FUNCTION
SUB Spiel.Laden (nr)
SELECT CASE nr
CASE ELSE
RESTORE Spielstand.Normal
END SELECT
FOR j = 1 TO 8
READ zeile$
FOR i = 1 TO 8
feld$(j, i) = MID$(zeile$, i, 1)
NEXT i, j
END SUB
SUB Spiel.Malen
FOR zeile = 1 TO 8
FOR spalte = 1 TO 8
MalFeld zeile, spalte, 0
IF spalte = 1 THEN COLOR 15, 1: LOCATE (zeile - 1) * 3 + 2, 1: PRINT LTRIM$(RTRIM$(STR$(9 - zeile)));
IF zeile = 1 THEN COLOR 15, 1: LOCATE 25, (spalte - 1) * 6 + 4: PRINT CHR$(65 + spalte - 1);
NEXT spalte, zeile
COLOR 15, 1: FOR i = 1 TO 25: LOCATE i, 50: PRINT "º"; : NEXT i
END SUB
SUB Spiel.Spielen
dran1 = 1
dran2 = 2
dranIst = dran1 'wer momentan am Zug ist
wahl = 0 'wenn wahl = 1, dann bedeutet das, dass eine Figur ausgew„hlt ist
'bei wahl = 2 ist das Zielfeld ausgew„hlt.
p1 = 1 'sind die Koordinaten des Cursers
p2 = 1
gew$ = " " 'gew„hlte Figur
von1 = 0 'Koordinaten der zu bewegenden Figur
von2 = 0
bis1 = 0 'Koordinaten des Zielfeldes
bis2 = 0
PlayNR = 0 'Sound, der gespielt werden soll
MalFeld p1, p2, 1
InfoBox 1, dranIst, p1, p2, feld$(p1, p2)
DO
a$ = INKEY$
IF a$ <> "" THEN MalFeld p1, p2, 0
SELECT CASE a$
CASE CHR$(0) + "H": IF p1 = 1 THEN p1 = 8 ELSE p1 = p1 - 1
CASE CHR$(0) + "P": IF p1 = 8 THEN p1 = 1 ELSE p1 = p1 + 1
CASE CHR$(0) + "K": IF p2 = 1 THEN p2 = 8 ELSE p2 = p2 - 1
CASE CHR$(0) + "M": IF p2 = 8 THEN p2 = 1 ELSE p2 = p2 + 1
CASE CHR$(13), CHR$(32)
IF wahl + 1 = 1 THEN
IF richtigesFeld(wahl + 1, dranIst, gew$) = 1 THEN
'wahl = wahl + 1
von1 = p1: von2 = p2
LOCATE 1, 60: PRINT gew$
PlayNR = 2
ELSE
PlayNR = 1
END IF
END IF
CASE "S", "s": PlaySound -1
CASE CHR$(27): Ende
CASE ELSE
END SELECT
IF a$ <> "" THEN
MalFeld p1, p2, 1: gew$ = feld$(p1, p2)
InfoBox 1, dranIst, p1, p2, gew$
END IF
IF PlayNR > 0 THEN PlaySound PlayNR: PlayNR = 0
LOOP
END SUB |
_________________
Inzwischen gehöre ich auch zu den BlitzBasicern. Also verzeiht mir, wenn mir mal ein LOCATE 100, 100 oder dergleichen rausrutscht. |
|
| Nach oben |
|
|
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 31.07.2006, 18:29 Titel: |
|
|
Mal schauen ob ich Zeit dafür finde und erst einmal muss
ich auch wissen ob sich das überhaupt lohnt das
Programm weoterzuentwickeln. Ich möchte nämlich
nicht viel Aufwand in ein Programm stecken das danach
niemand verwendet.
Um das Problem mit dem Schach zu lösen auf für mich
mit wenig Aufwand verbundene Art und Weise könnt ich das so programmieren das das Spiel zu Ende
ist wenn ein König geschlagen ist, was normalerweise
nach dem Matt setzten passiert, was die Spielbarkeit
nicht beeinträchtigt. Was haltet ihr davon??? |
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 31.07.2006, 20:27 Titel: |
|
|
Also ich fänds schade, wenn du das jetzt nicht zu Ende bringen würdest...
Denn immerhin hast du da eine sehr aufwendige KI reingesteckt!
Außerdem sind solche Kleinigkeiten wie gesagt kein Hinderniss, denn du brauchst in diesem Fall kein neues Konzept mehr...
=> Wenn du ein grafisch und funktionstechnisch ansprechendes Schachprogramm mit KI entwickelst, findet das garantiert ein paar begeisterte User...
Grüße, Elvis
_________________
Geforce 7300GT (256MB GDDR3, Gainward) -- 2x 512MB (DDR2 800, MDT) -- AMD Athlon64 X2 EE 3800+ -- Asrock ALiveNF5-eSATA2+ |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 31.07.2006, 20:37 Titel: |
|
|
Ich find's nachwievor toll, und für all die, die kein VB-DOS haben:
Download (Stand- alone EXE) - 86 KB
Ich hoffe, du entwickelst das weiter.
MfG Raphael
Edit: Dateigröße korrigiert
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
Zuletzt bearbeitet von raph ael am 31.07.2006, 21:49, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
Bad_King
gesperrt
Anmeldungsdatum: 15.04.2006
Beiträge: 455
Wohnort: nähe Stuttgart
|
| Verfasst am: 31.07.2006, 21:20 Titel: Re: QB Schachprogramm |
|
|
Sollte man für das
| Heizi hat Folgendes geschrieben: | Hallo. Ich arbeite schon eine ganze Weile an meinem Schachprogramm
für QB. Ich wollte zuerst das Schachprogramm nur für 2 Spieler
programmieren, hab dann später aber noch eine KI hinzugefügt,das
hat mich wirklich sehr viel Zeit und Nerven gekostet. Jetzt bin ich fast
fertig, die aktuelle version läuft noch etwas instabil, aber das beheb ich noch. Wollt nur mal wissen was andere Programmierer bis jetzt von meinem Programm halten. Setzt an mein Programm aber nicht die
selben Maßstäbe wie an neue kommerzielle Spiele, das ist mir auch klar
das ich sowas nicht toppen kann. Ich hab so ein paar Bekannte die
nerven mich deswegen ständig aber das ist jetzt egal.
Hier der Code, einfach in den Texteditor kopieren und als bas datei
abspeichern:
Hinweis: das Prog läuft super mit Qb 45 und Vbdos,
compilieren lässt es sich aber nur mit VBDOS.
| Code: |
DECLARE FUNCTION fz% (depth%, sp%)
DECLARE FUNCTION zr% (min%, max%)
DECLARE FUNCTION pvalid% (posix%, posiy%)
DECLARE SUB setf (m%, t%, n%, x%, y%)
DEFINT A-Z
WIDTH 40, 25
CLEAR , , 30000
CONST true = -1
CONST false = 0
TYPE v2dd
x AS INTEGER
y AS INTEGER
END TYPE
TYPE fe
m AS INTEGER
t AS INTEGER
n AS INTEGER
END TYPE
DIM SHARED stemp
DIM SHARED feld(9, 9) AS fe
FOR co = 0 TO 9
feld(0, co).m = 3
feld(co, 0).m = 3
feld(9, co).m = 3
feld(co, 9).m = 3
NEXT co
DIM SHARED maxd: maxd = 10
DIM SHARED fragged(1 TO maxd)
DIM SHARED fout(1 TO 2, 1 TO 6, 1 TO 9)
DIM SHARED kis(1 TO 2)
DIM SHARED wb2(1 TO 2): wb2(1) = 2: wb2(2) = 7
DIM SHARED gg(1 TO 2)
gg(1) = 2: gg(2) = 1
DIM SHARED zg(1 TO 200, 1 TO 2) AS v2dd
DIM SHARED zuege
DIM SHARED score(200)
RANDOMIZE TIMER
DIM SHARED ri(1 TO 8) AS v2dd
ri(1).x = 0: ri(1).y = 1
ri(2).x = 0: ri(2).y = -1
ri(3).x = 1: ri(3).y = 0
ri(4).x = -1: ri(4).y = 0
ri(5).x = 1: ri(5).y = 1
ri(6).x = 1: ri(6).y = -1
ri(7).x = -1: ri(7).y = 1
ri(8).x = -1: ri(8).y = -1
DIM SHARED sri(1 TO 8) AS v2dd
sri(1).x = 1: sri(1).y = 2
sri(2).x = 1: sri(2).y = -2
sri(3).x = -1: sri(3).y = 2
sri(4).x = -1: sri(4).y = -2
sri(5).x = 2: sri(5).y = 1
sri(6).x = 2: sri(6).y = -1
sri(7).x = -2: sri(7).y = 1
sri(8).x = -2: sri(8).y = -1
DIM SHARED kk(6)
kk(1) = 10
kk(2) = 50
kk(3) = 60
kk(4) = 100
kk(5) = 150
kk(6) = 1000
DIM SHARED z(6) AS STRING * 1
DIM SHARED fig(1 TO 2, 1 TO 6, 1 TO 9) AS v2dd
z(1) = "B"
z(2) = "T"
z(3) = "S"
z(4) = "L"
z(5) = "Q"
z(6) = "K"
DIM SHARED opt(1 TO 4) AS STRING
DIM SHARED menu(1 TO 2)
opt(1) = "Mensch"
opt(2) = "Computer 1"
opt(3) = "Computer 2"
opt(4) = "Computer 3"
menu(1) = 1
menu(2) = 3
COLOR 14: PRINT "Wilkommmen zu SHI Schach 2006!!!!"
COLOR 15: PRINT "(1) Spieler 1:" + opt(menu(1))
PRINT "(2) Spieler 2:" + opt(menu(2))
PRINT "(3) Spiel starten"
DO
t$ = INKEY$
SELECT CASE t$
CASE CHR$(27): END
CASE "1"
menu(1) = menu(1) MOD 4 + 1
LOCATE 2, 15: PRINT opt(menu(1)) + " "
CASE "2"
menu(2) = menu(2) MOD 4 + 1
LOCATE 3, 15: PRINT opt(menu(2)) + " "
CASE "3"
kis(1) = menu(1) > 1
kis(2) = menu(2) > 1
EXIT DO
END SELECT
LOOP
CLS
COLOR 0
FOR co = 1 TO 8
FOR co2 = 1 TO 8
feld(co, co2).m = 0
LOCATE co, co2: PRINT "Û"
NEXT co2
NEXT co
COLOR 15: LOCATE 20, 1: PRINT "Hallo " + ENVIRON$("USERNAME") + "!!!!!"
COLOR 14: PRINT "Super Heizio Chess by SHI Softworks"
DIM SHARED numfig(1 TO 2, 6)
FOR co = 1 TO 2
numfig(co, 1) = 8
numfig(co, 2) = 2
numfig(co, 3) = 2
numfig(co, 4) = 2
numfig(co, 5) = 1
numfig(co, 6) = 1
NEXT co
FOR co = 1 TO 8
CALL setf(1, 1, co, co, 2)
CALL setf(2, 1, co, co, 7)
NEXT co
CALL setf(1, 2, 1, 1, 1)
CALL setf(2, 2, 1, 1, 8)
CALL setf(1, 2, 2, 8, 1)
CALL setf(2, 2, 2, 8, 8)
CALL setf(1, 3, 1, 2, 1)
CALL setf(2, 3, 1, 2, 8)
CALL setf(1, 3, 2, 7, 1)
CALL setf(2, 3, 2, 7, 8)
CALL setf(1, 4, 1, 3, 1)
CALL setf(2, 4, 1, 3, 8)
CALL setf(1, 4, 2, 6, 1)
CALL setf(2, 4, 2, 6, 8)
CALL setf(1, 5, 1, 4, 1)
CALL setf(2, 5, 1, 4, 8)
CALL setf(1, 6, 1, 5, 1)
CALL setf(2, 6, 1, 5, 8)
COLOR 15
FOR co3 = 1 TO 2
COLOR co3 + 8
FOR co2 = 1 TO 6
FOR co = 1 TO numfig(co3, co2)
LOCATE fig(co3, co2, co).y, fig(co3, co2, co).x: PRINT z(co2)
fout(co3, co2, co) = false
NEXT co
NEXT co2
NEXT co3
DIM cpos AS v2dd
DIM oldpos AS v2dd
DIM zug(1 TO 3) AS v2dd
cpos.x = 1: cpos.y = 1
zugr = 0
spieler = 1
IF kis(1) = true THEN
COLOR 4: GOTO bz
END IF
start:
DO
oldc = SCREEN(cpos.y, cpos.x, 1)
COLOR 5: LOCATE cpos.y, cpos.x: PRINT CHR$(SCREEN(cpos.y, cpos.x))
DO
t$ = INKEY$
oldpos = cpos
SELECT CASE t$
CASE CHR$(0) + "H"
IF cpos.y >= 2 THEN cpos.y = cpos.y - 1
CASE CHR$(0) + "P"
IF cpos.y <= 7 THEN cpos.y = cpos.y + 1
CASE CHR$(0) + "K"
IF cpos.x >= 2 THEN cpos.x = cpos.x - 1
CASE CHR$(0) + "M"
IF cpos.x <= 7 THEN cpos.x = cpos.x + 1
CASE CHR$(27): END
CASE " "
SELECT CASE zugr
CASE 0
IF feld(cpos.x, cpos.y).m = spieler THEN
zugr = 1
zug(1) = cpos
COLOR 4: LOCATE 3, 11: PRINT CHR$(64 + cpos.x) + LTRIM$(STR$(cpos.y)) + " "
END IF
CASE 1:
zug:
zugr = 0
SELECT CASE feld(zug(1).x, zug(1).y).t
CASE 1
IF ((zug(1).y = cpos.y + 1 - (spieler MOD 2) * 2 AND feld(cpos.x, cpos.y).m = 0) OR (zug(1).y = 7 AND spieler = 2 AND cpos.y = 5 AND feld(zug(1).x, 6).m = 0) OR (zug(1).y = 2 AND feld(zug(1).x, 3).m = 0 AND spieler = 1 AND cpos.y = 4)) AND zug(1). _
x = cpos.x THEN
IF cpos.y = 8 OR cpos.y = 1 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
fig(spieler, 1, feld(zug(1).x, zug(1).y).n) = fig(spieler, 1, numfig(spieler, 1))
numfig(spieler, 1) = numfig(spieler, 1) - 1
numfig(spieler, 5) = numfig(spieler, 5) + 1: BEEP
feld(zug(1).x, zug(1).y).t = 5
ELSE CALL setf(spieler, 1, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
END IF
'PRINT cpos.y
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF zug(1).y = cpos.y + 1 - 2 * (spieler MOD 2) AND feld(cpos.x, cpos.y).m = spieler MOD 2 + 1 AND ABS(cpos.x - zug(1).x) = 1 THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
IF cpos.y = 8 OR cpos.y = 1 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
fig(spieler, 1, feld(zug(1).x, zug(1).y).n) = fig(spieler, 1, numfig(spieler, 1))
numfig(spieler, 1) = numfig(spieler, 1) - 1
numfig(spieler, 5) = numfig(spieler, 5) + 1: BEEP
feld(zug(1).x, zug(1).y).t = 5
ELSE CALL setf(spieler, 1, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
END IF
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
LOCATE 3, 9: PRINT " "
CASE 2
IF (NOT feld(cpos.x, cpos.y).m = spieler) THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF zug(2).x = 0 THEN
zug(2).y = zug(2).y / ABS(zug(2).y)
ELSE
IF zug(2).y = 0 THEN zug(2).x = zug(2).x / ABS(zug(2).x)
END IF
IF zug(2).x = 0 OR zug(2).y = 0 THEN
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextt
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 2, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 2, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextt:
LOCATE 3, 9: PRINT " "
CASE 4:
IF feld(cpos.x, cpos.y).m <> spieler THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF ABS(zug(2).x) = ABS(zug(2).y) THEN
IF zug(2).x > 0 THEN zug(2).x = 1 ELSE zug(2).x = -1
IF zug(2).y > 0 THEN zug(2).y = 1 ELSE zug(2).y = -1
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
'SLEEP: LOCATE 1, 1: PRINT zug(3).x, zug(3).y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextl
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 4, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 4, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextl:
LOCATE 3, 9: PRINT " "
CASE 5:
IF (NOT feld(cpos.x, cpos.y).m = spieler) THEN
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF ABS(zug(2).x) = ABS(zug(2).y) OR zug(2).x = 0 OR zug(2).y = 0 THEN
IF zug(2).x > 0 THEN zug(2).x = 1
IF zug(2).x < 0 THEN zug(2).x = -1
IF zug(2).y > 0 THEN zug(2).y = 1
IF zug(2).y < 0 THEN zug(2).y = -1
zug(3).y = zug(1).y + zug(2).y: zug(3).x = zug(1).x + zug(2).x
DO WHILE zug(3).x <> cpos.x AND zug(3).y <> cpos.y
IF feld(zug(3).x, zug(3).y).m > 0 THEN GOTO nextq
zug(3).y = zug(3).y + zug(2).y: zug(3).x = zug(3).x + zug(2).x
LOOP
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 5, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextq:
LOCATE 3, 9: PRINT " "
CASE 3
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF (ABS(zug(2).x) = 2 AND ABS(zug(2).y) = 1) OR (ABS(zug(2).x) = 1 AND ABS(zug(2).y) = 2) THEN
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 3, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF NOT feld(cpos.x, cpos.y).m = spieler THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 3, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nexts:
LOCATE 3, 9: PRINT " "
CASE 6
zug(2).x = cpos.x - zug(1).x
zug(2).y = cpos.y - zug(1).y
IF (ABS(zug(2).x) = 1 OR zug(2).x = 0) AND (ABS(zug(2).y) = 1 OR zug(2).y = 0) THEN
IF feld(cpos.x, cpos.y).m = 0 THEN
CALL setf(spieler, 6, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
IF NOT feld(cpos.x, cpos.y).m = spieler THEN
fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, feld(cpos.x, cpos.y).n) = fig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t, numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t))
numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) = numfig(spieler MOD 2 + 1, feld(cpos.x, cpos.y).t) - 1
CALL setf(spieler, 6, feld(zug(1).x, zug(1).y).n, cpos.x, cpos.y)
GOSUB drawst
BEEP
GOSUB zvalid: GOTO nextn
END IF
END IF
nextk:
LOCATE 3, 9: PRINT " "
END SELECT
END SELECT
END SELECT
IF NOT (oldpos.x = cpos.x AND oldpos.y = cpos.y) THEN
COLOR oldc
LOCATE oldpos.y, oldpos.x: PRINT CHR$(SCREEN(oldpos.y, oldpos.x))
GOTO start
END IF
nextn:
LOOP
LOOP
zvalid:
COLOR 4: LOCATE 3, 14: PRINT CHR$(64 + cpos.x) + LTRIM$(STR$(cpos.y))
spieler = spieler MOD 2 + 1
IF kis(spieler) = true THEN
bz:
maxd = menu(spieler) + 1
zuege = 0
temp = fz(1, spieler)
LOCATE 10, 1: PRINT temp, zuege
IF temp > 0 OR true THEN
LOCATE 1, 20
FOR co = 1 TO zuege
IF score(co) = temp THEN
LOCATE CSRLIN + 1, 20: PRINT zg(co, 1).x; " "; zg(co, 1).y; " "; zg(co, 2).x; " "; zg(co, 2).y;
IF CSRLIN = 16 THEN
LOCATE 1, 20
SLEEP
END IF
END IF
NEXT co
FOR co = CSRLIN + 1 TO 16
LOCATE co, 20: PRINT " "
NEXT co
END IF
DO
co = zr(1, zuege)
t$ = INKEY$: IF t$ = CHR$(27) THEN END
LOOP UNTIL score(co) >= temp - (4 - menu(spieler)) * 5
zug(1) = zg(co, 1)
cpos = zg(co, 2)
DO
t$ = INKEY$: IF t$ = CHR$(27) THEN END
LOOP UNTIL t$ <> ""
COLOR 4: LOCATE 3, 11: PRINT CHR$(64 + zug(1).x) + LTRIM$(STR$(zug(1).y)) + " "
GOTO zug
END IF
RETURN
drawst:
COLOR spieler + 8: LOCATE cpos.y, cpos.x: PRINT z(feld(zug(1).x, zug(1).y).t)
COLOR 0: LOCATE zug(1).y, zug(1).x: PRINT "Û"
feld(zug(1).x, zug(1).y).m = 0: oldc = spieler + 8
RETURN
FUNCTION fz (depth, sp)
DIM sop AS v2dd
DIM sof AS fe
IF depth = maxd THEN
fz = 0
ELSE
zmin = 30000
zmax = -30000
FOR sco1 = 1 TO numfig(sp, 1)
IF fout(sp, 1, sco1) = false THEN
IF fig(sp, 1, sco1).y <> 8 - (sp - 1) * 7 THEN
IF fig(sp, 1, sco1).y = wb2(gg(sp)) AND false = true THEN
fout(sp, 1, sco1) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
IF feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
numfig(sp, 5) = numfig(sp, 5) + 1
fig(sp, 5, numfig(sp, 5)).y = fig(sp, 1, sco1).y + ri(sp).y
fig(sp, 5, numfig(sp, 5)).x = fig(sp, 1, sco1).x
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = sp
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).t = 5
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).n = numfig(sp, 5)
fragged(depth) = kk(5) - kk(1)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
'CALL fz(depth + 1, gg(sp))
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = 0
numfig(sp, 5) = numfig(sp, 5) - 1
END IF
IF fig(sp, 1, sco1).x - 1 > 0 THEN
IF feld(fig(sp, 1, sco1).x - 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
numfig(sp, 5) = numfig(sp, 5) + 1
fig(sp, 5, numfig(sp, 5)).y = fig(sp, 1, sco1).y + ri(sp).y
fig(sp, 5, numfig(sp, 5)).x = fig(sp, 1, sco1).x - 1
sof = feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(5) - kk(1) + kk(sof.t)
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).m = sp
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).t = 5
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y).n = numfig(sp, 5)
LOCATE 20, 20: PRINT fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y: SLEEP
'CALL fz(depth + 1, gg(sp))
feld(fig(sp, 5, numfig(sp, 5)).x, fig(sp, 5, numfig(sp, 5)).y) = sof
numfig(sp, 5) = numfig(sp, 5) - 1
fout(sof.m, sof.t, sof.n) = false
END IF
END IF
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fout(sp, 1, sco1) = false
ELSE
IF feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
sop.y = fig(sp, 1, sco1).y
fig(sp, 1, sco1).y = sop.y + ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = feld(fig(sp, 1, sco1).x, sop.y)
feld(fig(sp, 1, sco1).x, sop.y).m = 0
fragged(depth) = 0:
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).y = sop.y
zg(zuege, 1).x = fig(sp, 1, sco1).x
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
END IF
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
IF wb2(sp) = sop.y AND feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y + ri(sp).y).m = 0 THEN
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: 'SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).y = sop.y
zg(zuege, 1).x = fig(sp, 1, sco1).x
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
END IF
fig(sp, 1, sco1).y = sop.y
feld(fig(sp, 1, sco1).x, sop.y).m = sp
feld(fig(sp, 1, sco1).x, sop.y).t = 1
feld(fig(sp, 1, sco1).x, sop.y).n = sco1
END IF
IF fig(sp, 1, sco1).x - 1 > 0 THEN
IF feld(fig(sp, 1, sco1).x - 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x - 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
sof = feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: ' SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 1, sco1).x + 1
zg(zuege, 1).y = fig(sp, 1, sco1).y - ri(sp).y
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x + 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y - ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
END IF
END IF
IF fig(sp, 1, sco1).x + 1 <= 8 THEN
IF feld(fig(sp, 1, sco1).x + 1, fig(sp, 1, sco1).y + ri(sp).y).m = gg(sp) THEN
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = 0
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x + 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y + ri(sp).y
sof = feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 1, sco1).x, fig(sp, 1, sco1).y: ' SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 1, sco1).x - 1
zg(zuege, 1).y = fig(sp, 1, sco1).y - ri(sp).y
zg(zuege, 2) = fig(sp, 1, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 1, sco1).x = fig(sp, 1, sco1).x - 1
fig(sp, 1, sco1).y = fig(sp, 1, sco1).y - ri(sp).y
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).m = sp
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).t = 1
feld(fig(sp, 1, sco1).x, fig(sp, 1, sco1).y).n = sco1
END IF
END IF
END IF
END IF
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 3)
IF fout(sp, 3, sco1) = false THEN
FOR sco2 = 1 TO 8
IF pvalid(fig(sp, 3, sco1).x + sri(sco2).x, fig(sp, 3, sco1).y + sri(sco2).y) = true THEN
SELECT CASE feld(fig(sp, 3, sco1).x + sri(sco2).x, fig(sp, 3, sco1).y + sri(sco2).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x + sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y + sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 3, sco1).x, fig(sp, 3, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 3, sco1).x - sri(sco2).x
zg(zuege, 1).y = fig(sp, 3, sco1).y - sri(sco2).y
zg(zuege, 2) = fig(sp, 3, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x - sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y - sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
CASE gg(sp)
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = 0
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x + sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y + sri(sco2).y
sof = feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y)
fout(sof.m, sof.t, sof.n) = true
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
fragged(depth) = kk(sof.t)
'LOCATE 20, 20: PRINT fig(sp, 3, sco1).x, fig(sp, 3, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1).x = fig(sp, 3, sco1).x - sri(sco2).x
zg(zuege, 1).y = fig(sp, 3, sco1).y - sri(sco2).y
zg(zuege, 2) = fig(sp, 3, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false
fig(sp, 3, sco1).x = fig(sp, 3, sco1).x - sri(sco2).x
fig(sp, 3, sco1).y = fig(sp, 3, sco1).y - sri(sco2).y
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).m = sp
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).t = 3
feld(fig(sp, 3, sco1).x, fig(sp, 3, sco1).y).n = sco1
END SELECT
END IF
NEXT sco2
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 2)
IF fout(sp, 2, sco1) = false THEN
sop = fig(sp, 2, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 4
fig(sp, 2, sco1).x = fig(sp, 2, sco1).x + ri(sco2).x
fig(sp, 2, sco1).y = fig(sp, 2, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y) = true
SELECT CASE feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = sp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).t = 2
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 2, sco1).x, fig(sp, 2, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 2, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).m = sp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).t = 2
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 2, sco1).x, fig(sp, 2, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 2, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 2, sco1).x, fig(sp, 2, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 2, sco1).x = fig(sp, 2, sco1).x + ri(sco2).x
fig(sp, 2, sco1).y = fig(sp, 2, sco1).y + ri(sco2).y
LOOP
fig(sp, 2, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 2
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 4)
IF fout(sp, 4, sco1) = false THEN
sop = fig(sp, 4, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 5 TO 8
fig(sp, 4, sco1).x = fig(sp, 4, sco1).x + ri(sco2).x
fig(sp, 4, sco1).y = fig(sp, 4, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y) = true
SELECT CASE feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = sp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).t = 4
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 4, sco1).x, fig(sp, 4, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 4, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).m = sp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).t = 4
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp,4, sco1).x, fig(sp, 4, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 4, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 4, sco1).x, fig(sp, 4, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 4, sco1).x = fig(sp, 4, sco1).x + ri(sco2).x
fig(sp, 4, sco1).y = fig(sp, 4, sco1).y + ri(sco2).y
LOOP
fig(sp, 4, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 4
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 5)
IF fout(sp, 5, sco1) = false THEN
sop = fig(sp, 5, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 8
fig(sp, 5, sco1).x = fig(sp, 5, sco1).x + ri(sco2).x
fig(sp, 5, sco1).y = fig(sp, 5, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y) = true
SELECT CASE feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = sp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).t = 5
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 5, sco1).x, fig(sp, 5, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 5, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).m = sp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).t = 5
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 5, sco1).x, fig(sp, 5, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 5, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 5, sco1).x, fig(sp, 5, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
fig(sp, 5, sco1).x = fig(sp, 5, sco1).x + ri(sco2).x
fig(sp, 5, sco1).y = fig(sp, 5, sco1).y + ri(sco2).y
LOOP
fig(sp, 5, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 5
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
FOR sco1 = 1 TO numfig(sp, 6)
IF fout(sp, 6, sco1) = false THEN
sop = fig(sp, 6, sco1)
feld(sop.x, sop.y).m = 0
FOR sco2 = 1 TO 8
fig(sp, 6, sco1).x = fig(sp, 6, sco1).x + ri(sco2).x
fig(sp, 6, sco1).y = fig(sp, 6, sco1).y + ri(sco2).y
DO WHILE pvalid(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y) = true
SELECT CASE feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m
CASE 0
fragged(depth) = 0
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = sp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).t = 6
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 6, sco1).x, fig(sp, 6, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 6, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = 0
CASE sp: EXIT DO
CASE ELSE
sof = feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y)
fout(sof.m, sof.t, sof.n) = true
fragged(depth) = kk(sof.t)
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).m = sp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).t = 6
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y).n = sco1
'LOCATE 20, 20: PRINT fig(sp, 6, sco1).x, fig(sp, 6, sco1).y: SLEEP
IF depth MOD 2 = 0 THEN
stemp = fz(depth + 1, gg(sp)) - fragged(depth)
ELSE
stemp = fz(depth + 1, gg(sp)) + fragged(depth)
IF depth = 1 THEN
zuege = zuege + 1
zg(zuege, 1) = sop
zg(zuege, 2) = fig(sp, 6, sco1)
score(zuege) = stemp
END IF
END IF
IF stemp > zmax THEN zmax = stemp
IF stemp < zmin THEN zmin = stemp
feld(fig(sp, 6, sco1).x, fig(sp, 6, sco1).y) = sof
fout(sof.m, sof.t, sof.n) = false: EXIT DO
END SELECT
EXIT DO
LOOP
fig(sp, 6, sco1) = sop
NEXT sco2
feld(sop.x, sop.y).m = sp
feld(sop.x, sop.y).t = 6
feld(sop.x, sop.y).n = sco1
END IF
NEXT sco1
IF depth MOD 2 = 1 THEN fz = zmax ELSE fz = zmin
END IF
END FUNCTION
FUNCTION pvalid (posix, posiy)
IF posiy <= 0 THEN pvalid = false: EXIT FUNCTION
IF posiy >= 9 THEN pvalid = false: EXIT FUNCTION
IF posix >= 9 THEN pvalid = false: EXIT FUNCTION
IF posix <= 0 THEN pvalid = false: EXIT FUNCTION
pvalid = true
END FUNCTION
SUB setf (m, t, n, x, y)
feld(x, y).m = m
feld(x, y).t = t
feld(x, y).n = n
fig(m, t, n).x = x
fig(m, t, n).y = y
END SUB
FUNCTION zr (min, max)
zr = min + RND * (max - min)
END FUNCTION
|
|
und das
| SpionAtom hat Folgendes geschrieben: | Schaut, was ich gefunden habe: Eine Schachoberfläche, leider ganz ohne Funktionalität, und für den TEXTMODUS! Vielleicht kannst du da ja deinen Code einbetten
Und ich weiß, das Pferd sieht nicht unbedingt aus wie ein Pferd, aber was soll man machen, wenn man nur Asciizeichen zur Verfügung hat...
| Code: | ' Schach
' f?r den Text-Modus
' von Thomas Decker 11.1.2003
DEFINT A-Z
CONST curserColor = 1
CONST schwarzFigur = 0
CONST weissFigur = 15
CONST schwarzFeld = 6
CONST weissFeld = 7
DECLARE SUB Spiel.Laden (nr)
DECLARE SUB Spiel.Malen ()
DECLARE SUB MalFeld (zeile, spalte, c)
DECLARE SUB Spiel.Spielen ()
DECLARE SUB Ende ()
DECLARE FUNCTION richtigesFeld (pWahl, pDran, gew$)
DECLARE SUB PlaySound (nr)
DECLARE SUB InfoBox (nr, dran, p1, p2, g$)
DECLARE SUB Rahmen (n%, x1%, y1%, x2%, y2%)
COLOR 0, 1
1 CLS
DIM SHARED feld$(1 TO 8, 1 TO 8)
PlaySound -1
Spiel.Laden 1
Spiel.Malen
Spiel.Spielen
Spielstand.Normal:
DATA "tsldklst"
DATA "bbbbbbbb"
DATA " "
DATA " "
DATA " "
DATA " "
DATA "BBBBBBBB"
DATA "TSLDKLST"
SUB Ende
COLOR 7, 0
SYSTEM
END SUB
SUB InfoBox (nr, dran, p1, p2, g$)
SELECT CASE nr
CASE 1
COLOR 2, 1
Rahmen 1, 23, 51, 25, 80
text$ = CHR$(64 + p2) + "/" + LTRIM$(RTRIM$(STR$(9 - p1)))
IF g$ <> " " THEN
IF g$ = UCASE$(g$) THEN text$ = text$ + " - Weiss"
IF g$ = LCASE$(g$) THEN text$ = text$ + " - Schwarz"
END IF
SELECT CASE UCASE$(g$)
CASE "K": text$ = text$ + " - K”nig"
CASE "D": text$ = text$ + " - Dame"
CASE "L": text$ = text$ + " - L„ufer"
CASE "S": text$ = text$ + " - Springer"
CASE "T": text$ = text$ + " - Turm"
CASE "B": text$ = text$ + " - Bauer"
CASE ELSE: text$ = text$ + " - leeres Feld"
END SELECT
LOCATE 24, 52: PRINT text$ + SPACE$(27 - LEN(text$) + 1);
CASE ELSE
END SELECT
END SUB
SUB MalFeld (zeile, spalte, c)
IF (zeile + spalte) MOD 2 THEN bg = schwarzFeld ELSE bg = weissFeld
COLOR bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 1 + 1: PRINT "ÛÛÛÛÛÛ";
SELECT CASE feld$(zeile, spalte)
CASE "k"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÅKINGÅ";
CASE "K"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "ÅKINGÅ";
CASE "d"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "DAME";
CASE "D"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT "DAME";
CASE "t"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " Ü Ü ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "T"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " Ü Ü ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "s"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " ßÜÜ¿ ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ³³ ";
CASE "S"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " ßÜÜ¿ ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ³³ ";
CASE "l"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " LŽUF ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ER ";
CASE "L"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT " LŽUF ";
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ER ";
CASE "b"
COLOR scharzFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE "B"
COLOR weissFigur, bg
LOCATE (zeile - 1) * 3 + 2, (spalte - 1) * 6 + 1 + 1: PRINT " ";
CASE ELSE
END SELECT
IF c = 0 THEN EXIT SUB
COLOR curserColor, bg
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 1 + 1: PRINT "É";
LOCATE (zeile - 1) * 3 + 1, (spalte - 1) * 6 + 6 + 1: PRINT "»";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 1 + 1: PRINT "È";
LOCATE (zeile - 1) * 3 + 3, (spalte - 1) * 6 + 6 + 1: PRINT "¼";
END SUB
SUB PlaySound (nr)
STATIC schalter 'wenn nummer = -1, dann schaltet der Schalter um auf an oder
' aus (je nachdem, wo er vorher war)
IF nr = -1 THEN IF schalter = 1 THEN schalter = 0 ELSE schalter = 1
IF schalter = 0 THEN EXIT SUB
PLAY "MB" 'Spiele die T”ne im Hintergrund
SELECT CASE nr
CASE 1 'Falsches Feld gew„hlt
PLAY "L32O1GFEDC"
CASE 2 'Richtiges Feld gew„hlt
PLAY "L26O5CCDG"
CASE ELSE
END SELECT
END SUB
SUB Rahmen (n, x1, y1, x2, y2)
SELECT CASE n
CASE 1
Ecke1$ = "À"
Ecke3$ = "Ù"
Ecke7$ = "Ú"
Ecke9$ = "¿"
Wager$ = "Ä"
Senkr$ = "³"
CASE 2
Ecke1$ = "È"
Ecke3$ = "¼"
Ecke7$ = "É"
Ecke9$ = "»"
Wager$ = "Í"
Senkr$ = "º"
CASE 3
Ecke1$ = "Û"
Ecke3$ = "Û"
Ecke7$ = "Û"
Ecke9$ = "Û"
Wager$ = "Û"
Senkr$ = "Û"
CASE 4
Ecke1$ = "Û"
Ecke3$ = "Û"
Ecke7$ = "Û"
Ecke9$ = "Û"
Wager$ = ""
Senkr$ = "Û"
FOR i = y1 + 1 TO y2 - 1
LOCATE x1, i: PRINT "ß";
LOCATE x2, i: PRINT "Ü";
NEXT i
CASE ELSE
EXIT SUB
END SELECT
LOCATE x1, y1: PRINT Ecke7$;
LOCATE x1, y2: PRINT Ecke9$;
LOCATE x2, y1: PRINT Ecke1$;
LOCATE x2, y2: PRINT Ecke3$;
FOR i = x1 + 1 TO x2 - 1
LOCATE i, y1: PRINT Senkr$;
LOCATE i, y2: PRINT Senkr$;
NEXT i
FOR i = y1 + 1 TO y2 - 1
LOCATE x1, i: PRINT Wager$;
LOCATE x2, i: PRINT Wager$;
NEXT i
END SUB
FUNCTION richtigesFeld (pWahl, pDran, gew$)
ret = 0
IF pWahl = 1 THEN
Figuren$ = "KDLSTB"
IF pDran = 1 THEN IF INSTR(UCASE$(Figuren$), gew$) THEN ret = 1
IF pDran = 2 THEN IF INSTR(LCASE$(Figuren$), gew$) THEN ret = 1
END IF
IF pWahl = 2 THEN
BEEP
END IF
richtigesFeld = ret
END FUNCTION
SUB Spiel.Laden (nr)
SELECT CASE nr
CASE ELSE
RESTORE Spielstand.Normal
END SELECT
FOR j = 1 TO 8
READ zeile$
FOR i = 1 TO 8
feld$(j, i) = MID$(zeile$, i, 1)
NEXT i, j
END SUB
SUB Spiel.Malen
FOR zeile = 1 TO 8
FOR spalte = 1 TO 8
MalFeld zeile, spalte, 0
IF spalte = 1 THEN COLOR 15, 1: LOCATE (zeile - 1) * 3 + 2, 1: PRINT LTRIM$(RTRIM$(STR$(9 - zeile)));
IF zeile = 1 THEN COLOR 15, 1: LOCATE 25, (spalte - 1) * 6 + 4: PRINT CHR$(65 + spalte - 1);
NEXT spalte, zeile
COLOR 15, 1: FOR i = 1 TO 25: LOCATE i, 50: PRINT "º"; : NEXT i
END SUB
SUB Spiel.Spielen
dran1 = 1
dran2 = 2
dranIst = dran1 'wer momentan am Zug ist
wahl = 0 'wenn wahl = 1, dann bedeutet das, dass eine Figur ausgew„hlt ist
'bei wahl = 2 ist das Zielfeld ausgew„hlt.
p1 = 1 'sind die Koordinaten des Cursers
p2 = 1
gew$ = " " 'gew„hlte Figur
von1 = 0 'Koordinaten der zu bewegenden Figur
von2 = 0
bis1 = 0 'Koordinaten des Zielfeldes
bis2 = 0
PlayNR = 0 'Sound, der gespielt werden soll
MalFeld p1, p2, 1
InfoBox 1, dranIst, p1, p2, feld$(p1, p2)
DO
a$ = INKEY$
IF a$ <> "" THEN MalFeld p1, p2, 0
SELECT CASE a$
CASE CHR$(0) + "H": IF p1 = 1 THEN p1 = 8 ELSE p1 = p1 - 1
CASE CHR$(0) + "P": IF p1 = 8 THEN p1 = 1 ELSE p1 = p1 + 1
CASE CHR$(0) + "K": IF p2 = 1 THEN p2 = 8 ELSE p2 = p2 - 1
CASE CHR$(0) + "M": IF p2 = 8 THEN p2 = 1 ELSE p2 = p2 + 1
CASE CHR$(13), CHR$(32)
IF wahl + 1 = 1 THEN
IF richtigesFeld(wahl + 1, dranIst, gew$) = 1 THEN
'wahl = wahl + 1
von1 = p1: von2 = p2
LOCATE 1, 60: PRINT gew$
PlayNR = 2
ELSE
PlayNR = 1
END IF
END IF
CASE "S", "s": PlaySound -1
CASE CHR$(27): Ende
CASE ELSE
END SELECT
IF a$ <> "" THEN
MalFeld p1, p2, 1: gew$ = feld$(p1, p2)
InfoBox 1, dranIst, p1, p2, gew$
END IF
IF PlayNR > 0 THEN PlaySound PlayNR: PlayNR = 0
LOOP
END SUB |
|
... nicht lieber ne Quelltextdatei zum Downlaod anbieten? 
_________________
Mein Server: http://gianluca.dyndns.org
(Ist meistens nur Tagsüber an) |
|
| Nach oben |
|
|
raph ael
Anmeldungsdatum: 12.04.2006
Beiträge: 472
|
| Verfasst am: 31.07.2006, 21:44 Titel: |
|
|
Das 2. ist ja nur eine "Idee" für eine neue Version, ohne KI und so, keinesfalls lauffähig.
Edit:
Wer den Quellcode sucht:
Ladet euch die SCHACH.EXE nocheinmal herunder, öffnet sie mit einem Editor und scrollt ans Ende 
Wer keine Lust hat:
Quelle- 30 KB
_________________
| Zitat: | | 1000 Yottabytes sind absurd. 640 Yottabytes sollten genug für jeden sein. |
|
|
| Nach oben |
|
|
SpionAtom
Anmeldungsdatum: 10.01.2005
Beiträge: 395
|
| Verfasst am: 31.07.2006, 22:04 Titel: |
|
|
| raph ael hat Folgendes geschrieben: | | Das 2. ist ja nur eine "Idee" für eine neue Version, ohne KI und so, keinesfalls lauffähig. |
Also starten kann man das Teil schon, man sieht, wie es aussieht, kann einen Curser rumschieben, aber noch keine Figuren bewegen..
@langen Post davor:  Hast Recht, ist wirklich etwas lang für einen Beitrag. Wird Zeit, dass ich mir Webspace anschaffe.
_________________
Inzwischen gehöre ich auch zu den BlitzBasicern. Also verzeiht mir, wenn mir mal ein LOCATE 100, 100 oder dergleichen rausrutscht. |
|
| Nach oben |
|
|
Heizi
Anmeldungsdatum: 19.01.2005
Beiträge: 309
|
| Verfasst am: 01.08.2006, 14:50 Titel: |
|
|
Ihr habt mich überredet, werds weiterentwickeln...
ersteinmal such ich mir noch ne Grafik Lib.
Ich tendiere da zu UGL, da ich schon etwas Erfahrung
mit UGL hab, allerdings scheint UGL mit Windows XP
auf manchen Rechnern nicht zu laufen. Welche andere
Grafik LIB ist dafür wohl am besten geeignet??? |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
