CONST true
= -1, false
= 0 CONST Rook
= 1, Knight
= 2, Bishop
= 3, Queen
= 4, King
= 5, Pawn
= 6
COMMON SHARED GameFile$
, RunWith
, check
, redo
, b1
, b2
, b1$
, b2$
l = 5: p = 6: b = 8: q1 = 200: q2 = 500
DIM SHARED b
(b
, b
), t
(b
, b
, l
), o
(b
, b
), mp$
(p
, 7), tb
(b
, b
, 10) DIM SHARED Moves
(l
), Move$
(l
, q1
), Score
(l
, q1
), TieTo
(l
), Index
(l
, q1
) DIM SHARED x
(p
, q2
), y
(p
, q2
), c
(12, q2
), MoveLog$
(q2
)
'ON ERROR GOTO Oops
'GameFile$ = "'chessx.alg"
sillyf = 1 ' Moire effect, toggle with "z", or just default this to 0
Begin:
Init
gm = 1
SaveWorB = WorB
opening = 1
ScanKey
m$ = gm$(gm)
'LOCATE 1, 1: PRINT gm; "*"; m$; "*";
Score = 0
Score = 777
check = true
gm = gm + 1
IF LEN(m$
) = 0 THEN opening
= 0: GameFile$
= ""
'IF opening > 0 THEN
' READ m$
'IF m$ = "end" THEN opening = 0
'END IF
SaveForTakeBack
redo:
CheckBoard 1
CheckBoard 0
IF Moves
(0) = 0 THEN mess$
= "Stalemate" 'LOCATE 1, 1: PRINT debug$;
woof:
takeback
PlotAll
tbf = 0
'LOCATE 1, 1: PRINT tbc; " ";
HumanMove
ok = 0
DebugR = 99
rflag = 1
Recurse 1
rflag = 0
TakeBest 0
PlotAll
WorB = SaveWorB
DispTime
fr
= VAL(MID$(m$
, 2, 1)) ' from row fc
= INSTR("abcdefgh", LEFT$(m$
, 1)) ' from column fr = mkr: fc = mkc
fr = okr: fc = okc
IF ic
> 5 THEN f$
= "clockx.png" ELSE f$
= "clockx2.png" oldf$ = f$
c1& = black&: c2& = black&
x1 = xc + (fc - 5) * xq
y1 = yc + (4 - fr) * yq
x2 = x1 + xq
y2 = y1 + yq
LINE (x1
+ 1, y1
+ 1)-(x2
- 1, y2
- 1), c1&
, B
LINE (x1
+ 2, y1
+ 2)-(x2
- 2, y2
- 2), c1&
, B
x1 = xc + (tc - 5) * xq
y1 = yc + (4 - tr) * yq
x2 = x1 + xq
y2 = y1 + yq
LINE (x1
+ 1, y1
+ 1)-(x2
- 1, y2
- 1), c2&
, B
LINE (x1
+ 2, y1
+ 2)-(x2
- 2, y2
- 2), c2&
, B
ScanKey
'IF tbf THEN GOTO begin2
MoveIt m$, -1
ShowAlgebraic m$
check = false
CheckBoard 0
check = true
WorB
= SaveWorB
XOR 1 ' toggle white/black 'IF LEN(GameFile$) > 0 THEN KeyGet
'IF humanc = WorB THEN KeyGet
'WaitForKey = true
IF Move
= 500 THEN mess$
= "Over 500 moves...." ' IF Studying THEN KeyGet
o1:
DATA e2e4
,e7e5
,g1f3
,b8c6
,f1b5
,a7a6
,b5a4
,b7b5
,a4b3
,g8f6
,b1c3
,f8e7
,f3g5
,h7h6
'DATA g5f7,O-O
'DATA f7d8,g8h7
SetUp:
DATA 12,12,12,12,12,12,12,12
Legal:
' udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R
,8000,0800,0080,0008,0000,0000,0000,0000 DATA N
,2010,2001,0210,0201,1020,1002,0120,0102 DATA B
,8080,8008,0880,0808,0000,0000,0000,0000 DATA Q
,8000,0800,0080,0008,8080,8008,0880,0808 DATA K
,1000,0100,0010,0001,1010,1001,0110,0101 DATA P
,1000,1001,1010,0000,0000,0000,0000,0000
PiecePatterns:
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA .....X.XX..XX..XX.X.....
DATA ......XXXXXXXXXXXX......
DATA .....XX..........XX.....
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA .....X..XXXXXXXX..X.....
DATA ....X..............X....
DATA ...X..XXXXXXXXXXXX..X...
DATA ...X................X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ............XXX.........
DATA ..........XX.X.X........
DATA .........X..X.X.XX......
DATA ........X.X.XX.X..X.....
DATA .......X.XXXX.X.X..X....
DATA .......X.X...XXX.X..X...
DATA .....X..XX..X.XXX.X.X...
DATA ....X.XXXXXXX.XXX.X..X..
DATA ...X.XXXXXX.X..XX.X..X..
DATA ...X.XX..XXX.X.XX.X..X..
DATA ....X..XXXX..X.XX.X..X..
DATA .....XX..X..X.XXX.X..X..
DATA ........X..XX.XX.XX.X...
DATA .......X..XX.XX.XX.X....
DATA ......XXXXXXXXXXXXXX....
DATA .....X..............X...
DATA ....X................X..
DATA .....XXXXXXXXXXXXXXXX...
DATA ........................
DATA ........................
DATA ........................
DATA ............X...........
DATA ...........X.X..........
DATA ..........X.X.X.........
DATA ........X...XX..X.......
DATA .......X..X..XX..X......
DATA .......X.XXX..XX.X......
DATA .......X.XXXX..X.X......
DATA ........X.......X.......
DATA .......XX.X.X.X.XX......
DATA ......X...........X.....
DATA .......X.XXX.XX.XX......
DATA ........X.XX.XX.X.......
DATA .......X.XXX.XXX.X......
DATA .......X.XXX.XXX.X......
DATA ......X.X.......X.X.....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ............X...........
DATA ...........X.X..........
DATA .....X....X.X.X....X....
DATA ....X.X.XX.XXX..X.X.X...
DATA ...X.X.X..XX.XXX.X.X.X..
DATA ...X.XX.XXX.X.XXX.XX.X..
DATA ...X.XXX.X.XXX.X.XXX.X..
DATA ...X.XXXX.XXXXX.XXXX.X..
DATA ....X.XXXXXX..XXXXX.X...
DATA .....X.XXXXX..XXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ....X...............X...
DATA ......XX.XXXXXXX.XX.....
DATA .......X.X.XXX.X.X......
DATA ......X.XX.XXX.XX.X.....
DATA ......X.XX.XXX.XX.X.....
DATA .....XXXXXXXXXXXXXXX....
DATA ....X...............X...
DATA ...X..XX.XX.XX.XX.X..X..
DATA ...X.................X..
DATA ....XXXXXXXXXXXXXXXXX...
DATA ...........XX...........
DATA .........XX..XX.........
DATA .......XX.X..X.XX.......
DATA .....XX.X......X.XX.....
DATA ....X..XX.X..X.XX..X....
DATA ...X...XXXX..XXXX...X...
DATA ..X...XX........XX...X..
DATA .X..XXX.XXX..XXX.XXX..X.
DATA X..XXX..XXX..XXX..XXX..X
DATA X.XXXX..XXX..XXXX.XXXX.X
DATA X.XXXX.XXXX..XXXX.XXXX.X
DATA X.XXXX..XXXXXXXX..XXXX.X
DATA .X.XXXX..XXXXXX..XXXX.X.
DATA .X..XXXX..XXXX..XXXX..X.
DATA ..X..XXXX......XXXX..X..
DATA ...X....X......X....X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ..X..................X..
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA ..X..................X..
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ........................
DATA ........................
DATA ........................
DATA ..........XXXX..........
DATA .........X....X.........
DATA ........X.XXXX.X........
DATA ........X.XXXX.X........
DATA .........X....X.........
DATA ........XXXXXXXX........
DATA .......X........X.......
DATA ........XXXXXXXX........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA ........X..XX..X........
DATA .......X..XXXX..X.......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA ......XXXXXXXXXXXX......
DATA ........................
DATA ........................
rgb:
DATA 1,30,60,20,"board white" DATA 2,1,1,1,"board black" DATA 3,92,92,92,"white bright" DATA 4,22,22,92,"white hightlight" DATA 5,0,0,0,"black bright" DATA 6,62,22,22,"black hightlight" DATA 15,30,30,30,"printing"
Oops:
gronk = gronk + 1
SUB AddIt
(Level
, tm$
, Score
) Moves(Level) = Moves(Level) + 1 ' count ok
Move$(Level, Moves(Level)) = tm$ ' save move
Score(Level, Moves(Level)) = Score
Index(Level, Moves(Level)) = TieTo(Level)
b(r, c) = t(r, c, Level)
t(r, c, Level) = b(r, c)
Moves(Level) = 0
tking = 5: oking = 11
mkr = r
mkc = c
okr = r
okc = c
mp = b(r, c)
mc = -(mp > 6) - (mp = 0) * 2
IF mc
= WorB
THEN TryMove Level
, r
, c
' BBWW
' QKQK
IF MID$(Castle$
, WorB
* 2 + 1, 1) = " " THEN cq
= true
ELSE cq
= false
' blank means ok IF MID$(Castle$
, WorB
* 2 + 2, 1) = " " THEN ck
= true
ELSE ck
= false
neks$ = "" ' not empty kingside
neqs$ = "" ' not empty queenside
qsc$ = "" ' queenside control
ksc$ = "" ' kingside control
kic$ = "" ' king in check
nok$ = "" ' king not there
nrq$ = "" ' no rook queenside
nrk$ = "" ' no rook kingside
FOR Castle
= 0 TO 1 ' queenside, then kingside ' bcd fg
IF Castle
= 0 THEN ca$
= "234" ELSE ca$
= "67" ' column number IF WorB
THEN rn$
= "1" ELSE rn$
= "8" ' row number tp
= b
(VAL(rn$
), 5): tp
= tp
+ (tp
> 6) * 6 tp
= b
(VAL(rn$
), 1): tp
= tp
+ (tp
> 6) * 6 tp
= b
(VAL(rn$
), 8): tp
= tp
+ (tp
> 6) * 6 c$
= MID$("abcdefgh", cn
, 1) tp = b(rn, cn)
tp = tp + (tp > 6) * 6 ' convert >6 to 1-5
IF Castle
= 0 THEN neqs$
= neqs$
+ "neq " + c$
+ rn$
+ " " IF Castle
= 1 THEN neks$
= neks$
+ "nek " + c$
+ rn$
+ " " q$
= MID$("abcdefgh", cn
, 1) + rn$
IF Castle
= 0 THEN qsc$
= "qsc" + Move$
(1, lm
) + " " IF Castle
= 1 THEN ksc$
= "ksc " + Move$
(1, lm
) + " " q$ = "e" + rn$
IF q$
= RIGHT$(Move$
(1, lm
), 2) THEN cq
= 0: ck
= 0: kic$
= "kic " + Move$
(1, lm
) + " " debug$ = nok$ + nrq$ + nrk$ + kic$ + neqs$ + neks$ + qsc$ + ksc$ + " *"
IF ck
THEN AddIt Level
, "O-O", 12 IF cq
THEN AddIt Level
, "O-O-O", 13
'LOCATE 34 + WorB, 46: PRINT "*"; Castle$; "*";
'PRINT MID$("K ", ck + 2, 1);
'PRINT MID$("Q ", cq + 2, 1); cq; ck;
TakeBest Level
sr = 32
r = sr
c = 4
PRINT Make4$
(Move$
(0, t
)); rjust$
(Score
(0, t
), 4);
r = r + 1
IF r
> MaxRow
THEN r
= sr: c
= c
+ 9
'IF human AND (humanc = WorB) THEN EXIT SUB
DebugR = DebugR + 1
DebugR = 3: DebugC = 62
ts = 0: s = 1
z$ = ""
ti = TieTo(t)
z$ = z$ + Make4$(Move$(t - 1, ti)) + rjust$(Score(t - 1, ti), 3) + " "
ts = ts + Score(t - 1, ti) * s
's = -s
ts = ts - Score
z$ = z$ + Make4$(m$) + rjust$(Score, 3) + " " + rjust$(ts, 4)
t$ = " RNBQKP"
LOCATE TextRow
(zr
), TextCol
(zc
)
Elapse1!
= TIMER - Start1&
Elapse2!
= TIMER - Start2&
IF Elapse2!
> MaxElapse!
THEN MaxElapse!
= Elapse2!
'ShowTime 3, Elapse1!, "Game:"
'ShowTime 4, Elapse2!, "This move:"
'ShowTime 5, MaxElapse!, "Max move:"
SUB FadePiece
(tfr
, tfc
, ttr
, ttc
) fr = tfr: fc = tfc: tr = ttr: tc = ttc
x1 = xc + (fc - 5) * xq
y1 = yc + (4 - fr) * yq
x2 = xc + (tc - 5) * xq
y2 = yc + (4 - tr) * yq
p = b(tr, tc)
IF invert
THEN p
= b
(9 - tr
, 9 - tc
) IF p
> 6 THEN wb
= 1: p
= p
- 6 i = p - (wb = 0) * 6
c = fr + fc: tx = x1: ty = y1
c = tr + tc: tx = x2: ty = y2
LINE (tx
, ty
)-(tx
+ xq
, ty
+ yq
), boardwhite&
, BF
LINE (tx
, ty
)-(tx
+ xq
, ty
+ yq
), boardblack&
, BF
' black square LINE (tx
, ty
)-(tx
+ xq
, ty
+ yq
), boardwhite&
, B
' border
tx = x1 + x(p, t) * 2
ty = y1 + y(p, t) * 2
LINE (tx
, ty
)-STEP(1, 1), cp&
(c
(i
, t
)), B
getreal:
rr = 8: cc = 1
IF invert
THEN rr
= 9 - rr: cc
= 9 - cc
rr = fr: cc = fc
IF invert
THEN rr
= 9 - rr: cc
= 9 - cc
x1 = xc - 4 * xq
y1 = yc - 4 * yq
x2 = xc + 4 * xq
y2 = yc + 4 * yq
LINE (x1
, y1
)-(x2
, y2
), boardwhite&
, B
'LOCATE 1, 1: PRINT "Move ";
x1 = xc + (cc - 5) * xq
x2 = xc + (cc - 4) * xq
y1 = yc + (rr - 5) * yq
y2 = yc + (rr - 4) * yq
wc&
= POINT(x1
+ 1, y1
+ 1) LINE (x1
+ zx
, y1
+ zx
)-(x2
- zx
, y2
- zx
), tc&
, B
ScanKey
cc = cc + (kk = 75) - (kk = 77) ' left right
rr = rr + (kk = 72) - (kk = 80) ' up down
IF invert
THEN rr
= 9 - rr: cc
= 9 - cc
fr = rr: fc = cc
tr = rr: tc = cc
'IF fs$ = ts$ THEN GOTO getreal
m$ = fs$ + ts$
IF m$
= "e1g1" THEN m$
= "O-O" IF m$
= "e1c1" THEN m$
= "O-O-O" IF m$
= "e8g1" THEN m$
= "O-O" IF m$
= "e8c1" THEN m$
= "O-O-O"
black& = cp&(0)
boardwhite& = cp&(1)
boardblack& = cp&(2)
green& = cp&(8)
blue& = cp&(9)
white& = cp&(10)
xm = 1280: ym = 800
xm = 800: ym = 600
MaxRow = ym \ 16 - 1
READ PalNum
, r
, g
, b
, Desc$
cp&
(p
) = _RGB32(r
* 4, g
* 4, b
* 4) colorassign ' red&, green&, etc, easier to use than palette numbers
Move = 0
WorB = 1 ' white=1, black=0
speed = 3
q = 28
q = q * 2
xq = q: yq = q
xc = 248: yc = 254 ' center of board
Esc$
= CHR$(27) ' to quit program lf$
= CHR$(10) ' line feed crlf$ = Enter$ + lf$
Castle$
= SPACE$(4) ' flags QKQK (B then W)
mess$ = ""
n = 0
FOR y
= 0 TO 21 ' 22 rows p1
= INSTR(d$
+ "X", "X") ' find first "on" bit p2 = t
n = n + 1
x(p, n) = x + 1
y(p, n) = y + 2
c(p, n) = c
c(p + 6, n) = c
c(p, 0) = n
FOR scram
= 1 TO 256 ' scramble (moves nicer) c1
= RND * (c
(p
, 0) - 1) + 1 ' any bit c2
= RND * (c
(p
, 0) - 1) + 1 ' any other bit SWAP c
(p
, c1
), c
(p
, c2
) ' black SWAP c
(p
+ 6, c1
), c
(p
+ 6, c2
) ' white
RESTORE Legal
' define how piece moves READ p$
' piece, not saved READ mp$
(p
, t
) ' mp (move piece)
RESTORE SetUp
' initial board position o(r, c) = b(r, c)
elim$ = " ,"
gm = 0: n = 0
gm = 0
f = f + 1
'MasterLevel = VAL(COMMAND$) ' only 4 really tested....
'GameFile$ = COMMAND$
'IF _FILEEXISTS(GameFile$) THEN ReadGame ELSE GameFile$ = ""
IF MasterLevel
= 0 THEN MasterLevel
= 4 debug = true ' someday I may turn this off
m$ = "(w)hite (b)lack (n)one"
human = 0 ' press n for none (watch computer play)
human = 1
humanc = p - 1 ' 0 black, 1 white
IF humanc
= 0 THEN invert
= 1 ' if black, flip board to have black at bottom PlotAll
'opening = 1
'RESTORE o1
ScanKey
IF i$
= "s" THEN WaitForKey
= false
fs$
= LEFT$(m$
, 2) ' from square ts$
= RIGHT$(m$
, 2) ' to square tzz
= 1 - (LEFT$(m$
, 1) = "O") ' two moves for a castle IF m$
= "O-O" THEN ' castle Kingside IF pass
= 1 THEN ' first move of KS castle fs$ = "e1": ts$ = "g1"
fs$ = "h1": ts$ = "f1"
fs$ = "e8": ts$ = "g8"
fs$ = "h8": ts$ = "f8"
IF m$
= "O-O-O" THEN ' castle Queenside fs$ = "e1": ts$ = "c1"
fs$ = "a1": ts$ = "d1"
fs$ = "e8": ts$ = "c8"
fs$ = "a8": ts$ = "d8"
fc
= INSTR("abcdefgh", LEFT$(fs$
, 1)) ' from column pm = b(fr, fc) ' piece to move
p = pm + (pm > 6) * 6
b(tr, tc) = pm ' move piece in array
b(fr, fc) = 0 ' blank old array spot
IF b
(r
, c
) = o
(r
, c
) THEN o
(r
, c
) = -1 FadePiece fr, fc, tr, tc
IF p
= King
THEN MID$(Castle$
, WorB
* 2 + 1, 2) = "XX" b(tr, tc) = Queen - (pm > 6) * 6 ' promote to queen
IF real
THEN FadePiece tr
, tc
, tr
, tc
' show queen
FadePiece zr, zc, zr, zc
'CIRCLE (xc, yc), 100, red&
a$
= MID$("abcdefgh", z
, 1) nx = xc - 4 * xq - 12
ny = yc + (i - 4) * yq - 34
ax = xc + (i - 5) * xq + 22
ay = yc + 4 * yq + 3
gm
= gm
+ 1: g$
(gm
) = LTRIM$(m1$
) gm
= gm
+ 1: g$
(gm
) = LTRIM$(m2$
)
DispTime
'IF human AND (humanc = WorB) AND (Level = 2) THEN EXIT SUB
FOR t
= 1 TO Moves
(Level
- 1) WorB = SaveWorB
TieTo(Level) = t
BoSave Level
m$ = Move$(Level - 1, t)
MoveIt m$, 0
t$ = rjust$(Moves(Level - 1), 3)
t$ = t$ + rjust$(t, 4) + " "
t$ = t$ + Make4$(m$)
t$ = t$ + rjust$(Score(Level - 1, t), 5)
ShowMe Level + 1, 24, t$
CheckBoard Level
Recurse Level + 1
TakeBest Level
Score = Score(Level, 1)
levm1 = Level - 1
i = Index
IF Score
(levm
, i
) <> -777 THEN Score
(levm1
, i
) = Score
(levm1
, i
) - Score
IF Level
= (MasterLevel
- 1) THEN Debug2
BoRestore Level
ScanKey
c
= INSTR("123456789ABCDEF", i$
) IF i$
= "i" THEN invert
= invert
XOR 1: PlotAll
ShowMe 1, 72, "NoPause"
ShowMe 1, 72, " "
i$ = ""
IF WorB
THEN ' white=1, black=0 Move = Move + 1 ' number the moves
MID$(MoveLog$
(Move
), 1, 3) = rjust$
(Move
, 3) MID$(MoveLog$
(Move
), 5, LEN(m$
)) = m$
MID$(MoveLog$
(Move
), 11, LEN(m$
)) = m$
BeginAt = Move - 18
IF BeginAt
< 1 THEN BeginAt
= 1 dr = 1
ShowMe dr + 1, 1, MoveLog$(t)
dr = dr + 1
zr2 = (10 - zr1) * 2 + 3
zc2 = zc1 * 3 + 17 + br * 32
tp = b(zr1, zc1)
z$ = " "
z$
= "B" + MID$("RNBQKP", tp
, 1) z$
= "W" + MID$("RNBQKP", tp
- 6, 1) ShowMe zr2, zc2, z$
sc
= POS(0) ' save column LOCATE dr
, dc
' display row & column LOCATE sr
, sc
' restore to old location ' IF Pause THEN SLEEP
SUB ShowTime
(trow
, t!
, Desc$
) s! = t!
unit$ = "h"
s! = s! / 3600
unit$ = "m"
s! = s! / 60
unit$ = "s"
trow = trow + 3
s1
= RND * (Moves
(Level
) - 1) + 1 s2
= RND * (Moves
(Level
) - 1) + 1 SWAP Score
(Level
, s1
), Score
(Level
, s2
) SWAP Move$
(Level
, s1
), Move$
(Level
, s2
) SWAP Index
(Level
, s1
), Index
(Level
, s2
)
passes = 0
ReSort:
Score = -999 ' assume no moves
Sorted = true
FOR s
= 2 TO Moves
(Level
) IF Score
(Level
, s
- 1) < Score
(Level
, s
) THEN Sorted = false
SWAP Score
(Level
, s
- 1), Score
(Level
, s
) SWAP Move$
(Level
, s
- 1), Move$
(Level
, s
) SWAP Index
(Level
, s
- 1), Index
(Level
, s
)
m$ = Move$(Level, 1)
Score = Score(Level, 1)
Index = Index(Level, 1)
'IF Level = -1 THEN
' FOR lb = 0 TO 2 ' stop repeats
' IF INSTR(MoveLog$(Move - lb), m$) THEN
' Score(Level, 1) = Score(Level, 2) - 1 ' best = 2nd best-1
' passes = passes + 1
' IF passes < 5 THEN GOTO ReSort ' repeat may be only move
' END IF
' NEXT lb
'END IF
IF Score
= -777 THEN ' in check, no escape mess$ = "Mate"
mess$ = "Stalemate"
IF (Level
= 1) AND (Score
= 777) THEN Score
(0, TieTo
(1)) = -777
TextCol = (xc - 1) * 2 + 25
TextRow = (8 - xr) * 1 + 8
i = b(xr, xc)
i = i + (i > 6) * 6
TextVal = i
SUB TryMove
(Level
, fr
, fc
) ' from row, from column mp = b(fr, fc)
mc = -(mp > 6) - (mp = 0) * 2 ' moving color
mp = mp + (mp > 6) * 6
IF mc
= 1 THEN s
= -1 ELSE s
= 1 ' direction a pawn moves
FOR n
= 0 TO 7 ' possible 8 dirs udlr$ = mp$(mp, n) ' up/down/left/right
du
= VAL(MID$(udlr$
, 1, 1)) ' direction up dd
= VAL(MID$(udlr$
, 2, 1)) ' direction down dl
= VAL(MID$(udlr$
, 3, 1)) ' direction left dr
= VAL(MID$(udlr$
, 4, 1)) ' direction right IF mp
<> Knight
THEN ' not knight du
= SGN(du
) * s
' one square at a time IF (mp
= Pawn
) AND (n
= 0) THEN ' pawn first move? IF (fr
= 2) AND (WorB
= 1) THEN TrySq
= 2 ' gambit for white IF (fr
= 7) AND (WorB
= 0) THEN TrySq
= 2 ' gambit for black tr = fr: tc = fc ' row, column
FOR sq
= 1 TO TrySq
' up to 8 loops cap = false
Score = 0 ' must init
tr = tr - du + dd ' row=row-up+down
tc = tc - dl + dr ' column=column-left+right
cp = b(tr, tc) ' capture piece
cc = -(cp > 6) - (cp = 0) * 2 ' capture color
cp = cp + (cp > 6) * 6
cap = true
' RNBQKP
Score
= VAL(MID$("533901", cp
, 1)) * 10 IF (Score
> 0) AND (Level
= 0) THEN Score
= Score
+ 2 IF Score
= 0 THEN Score
= 777 ' king capture ' IF redo AND (Score = 777) THEN Score = 25
IF (tr
= 1) OR (tr
= 8) THEN ' promote pawn IF Score
<> 777 THEN Score
= Score
+ 99
' usually not good to be moving the King
IF mp
= King
THEN Score
= Score
- 4
' small plus for king moving out of check
InCheck
= (mc
= SaveWorB
) AND check
IF (mp
= King
) AND InCheck
THEN Score
= Score
+ 2
' leave king cap scores, also normal bonuses if in check
dis1
= ABS(fr
- okr
) + ABS(fc
- okc
) ' get closer to king dis2
= ABS(tr
- okr
) + ABS(tc
- okc
) ' IF dis2 < dis1 THEN Score = Score + (dis1 - dis2)
Score = Score + dis1 - dis2
IF dir
= 1 THEN Score
= Score
+ 2 ' move ahead at begin&mid
' priority to getting a piece first moved
IF b
(fr
, fc
) = o
(fr
, fc
) THEN Score
= Score
+ 1
' priority to getting a piece off the bottom rank
IF (fr
= 1) AND (tr
> 1) AND (WorB
= 1) THEN Score
= Score
+ 1 IF (fr
= 8) AND (tf
< 8) AND (WorB
= 0) THEN Score
= Score
+ 1
fs$
= MID$("abcdefgh", fc
, 1) + CHR$(48 + fr
) ' from square ts$
= MID$("abcdefgh", tc
, 1) + CHR$(48 + tr
) ' to square AddIt Level, fs$ + ts$, Score
PlotAll
br = 255
x1 = xc - 4 * xq
y1 = yc - 4 * yq
x2 = x1 + 8 * xq
y2 = y1 + 8 * yq
'LINE (x1, y1)-(x2, y2), boardwhite&
z
= ABS((sx
- xc
- xq \
2) * (sy
- yc
- yq \
2)) PSET (sx
, sy
), _RGB32(br
* SIN(.1 * r!
* z
+ zz
), br
* SIN(.155 * g!
* z
+ zz
), br
* SIN(2 * b!
* z
+ zz
))
tb(r, c, i) = tb(r, c, i - 1)
tb(r, c, 0) = b(r, c)
tbc = tbc + 1
b(r, c) = tb(r, c, 2)
tb(r, c, i) = tb(r, c, i + 1)
tbc = tbc - 1