CONST true
= -1, false
= 0, Rook
= 1, Knight
= 2, Bishop
= 3, Queen
= 4, King
= 5, Pawn
= 6 ' sort these alphabetically and document them, dummy
COMMON SHARED WorB
, Move
, Score
, Index
, opening
, invert
, i$
, m$
, lm$
, msg$
, abort
, MaxRow
, xq
, yq
, xc
, yc
, xm
, ym
, castle$
, OtherK$
COMMON SHARED mkr
, mkc
, okr
, okc
, k$
, MasterLevel
, MasterLevel1
, SaveWorB
, GameFile$
, check
, incheck
, debug
, DebugR
, DebugC
, Start1!
, Start2!
COMMON SHARED MaxElapse!
, human
, humanc
, OnAuto
, graphics
, rflag
, tlimit
, boardwhite&
, boardblack&
, black&
, red&
, green&
, blue&
, white&
, gray&
COMMON SHARED Enter$
, Esc$
, lf$
, crlf$
, debug$
, pinit
, takebackflag
, tbc
, waitflag
, pause
, cursoron!
, quitflag
, smode
, vflag
, MakeNoise
COMMON SHARED bri
, hold!
, dtime!
, mtime!
, altblack
, epfc
, epfr
, eptc
, eptr
, eprc
, eprr
, best
, best$
, ep$
, rick
, lcount&
, alpha$
, ocount&
COMMON SHARED iflag
, showthink
, history
, showlegalf
, showprotf
, bscore
, maxtime&
, l
, p
, b
, q1
, q2
, emin
, useidiot
, main&
, alfred!
l = 10: p = 6: b = 8: q1 = 300: q2 = 500
DIM SHARED b
(b
, b
), t
(b
, b
, l
), o
(b
, b
), tb
(b
, b
, 10), castle$
(l
), Moves
(l
), Move$
(l
, q1
), Score
(l
, q1
), TieTo
(l
), Index
(l
, q1
), prot
(l
), prot$
(l
, q1
) DIM SHARED x
(p
, q2
), y
(p
, q2
), c
(12, q2
), MoveLog$
(q2
), cp&
(32), etime!
(3), myr
(32), myg
(32), myb
(32), icon&
(10), mcount&
(10), du
(p
, 7), dd
(p
, 7) DIM SHARED dl
(p
, 7), dr
(p
, 7), value
(p
), alphal$
(8), abuff
(30000), s1
(b
, b
), s2
(b
, b
), s3
(b
, b
), s4
(b
, b
), s5
(b
, b
), s9
(b
, b
) m
(1) = _MEM(s1
(0, 0)): m
(2) = _MEM(s2
(0, 0)): m
(3) = _MEM(s3
(0, 0)): m
(4) = _MEM(s4
(0, 0)): m
(5) = _MEM(s5
(0, 0)): m
(9) = _MEM(s9
(0, 0))
MasterLevel1
= VAL(COMMAND$) ' only 4 really tested....2 is plenty stupid, odds not tested!IF MasterLevel1
= 0 THEN MasterLevel1
= 4
begin:
Init
SaveWorB = WorB
mking = 5: oking = 11
IF b
(c
, r
) = mking
THEN mkr
= r: mkc
= c
IF b
(c
, r
) = oking
THEN okr
= r: okc
= c
ks$
= alphal$
(mkc
) + CHR$(48 + mkr
)
IF WorB
= humanc
THEN SaveForTakeBack
redo:
Reset_To_Zero
IF Moves
(0) = 0 THEN msg$
= "Stalemate":
GOTO yoyo
Start1!
= TIMER: Start2!
= Start1!
DebugR = 99
IF human
AND (humanc
= WorB
) OR (human
= 2) THEN ' 2 is two humans IF (iflag
= 0) AND (human
= 2) THEN invert
= -(WorB
= 0) pinit = 0 ' nudge for the graphics, vary it a little
HumanMove ' get a move
TakeBack ' restores board & castling status
PlotBoard
takebackflag = 0
sm$ = m$
_MEMCOPY m
(0), m
(0).OFFSET
, m
(0).SIZE
TO m
(9), m
(9).OFFSET
' save board MoveIt m$, false
CheckBoard 1
m$ = sm$
_MEMCOPY m
(9), m
(9).OFFSET
, m
(9).SIZE
TO m
(0), m
(0).OFFSET
' restore board FOR i
= 1 TO Moves
(0) ' check against legal list IF m$
= Move$
(0, i
) THEN EXIT DO ' move found, skip more checking alfred!
= TIMER + 5:
IF alfred!
> maxtime&
THEN alfred!
= 0 IF MakeNoise
THEN PlaySound
"bad" abort = false
DebugR = 99
rflag = true ' flag in recursion to stop displaying board
bscore = -9999
Center 0, "", true
MasterLevel = 2 ' fast check in case slow aborted
Recurse 1 ' try all moves & responses
TakeBest 0, true '
ShowBest
rflag = 0
IF Moves
(0) THEN msg$
= "Checkmate!" ELSE msg$
= "Stalemate!" msg$
= msg$
+ STR$(Score
) MasterLevel = MasterLevel1 ' slow check
Recurse 1 ' try all moves & responses
IF MakeNoise
THEN PlaySound
"ding" TakeBest 0, true '
ShowBest
rflag = false
Center 0, "", true
IF abort
THEN _MEMCOPY m
(1), m
(1).OFFSET
, m
(1).SIZE
TO m
(0), m
(0).OFFSET
' restore board IF msg$
= "abort" THEN msg$
= ""
WorB = SaveWorB
sm$ = m$: m2$ = m$ ' save move for display in case modified for castling
IF m$
= "O-O" THEN ' castle kingside m$ = "e1g1": m2$ = "h1f1"
m$ = "e8g8": m2$ = "h8f8"
IF m$
= "O-O-O" THEN ' castle queenside m$ = "e1c1": m2$ = "a1c1"
m$ = "e8c8": m2$ = "a8d8"
IF human
<> 1 THEN GOTO doit
' people playing, or computer playing itself
waitflag = 1
FlashMove true
waitflag = 0
doit:
m$ = sm$
lm$ = m$
MoveIt m$, true
AddMove
PlotScreen true
check = false
CheckBoard 0
IF Score
= 777 THEN check
= true: TempMess
"Check!", 2
'check = 0: incheck = 0
'check = false: z = Level XOR 1
'k1$ = MID$(alpha$, mkc, 1) + CHR$(48 + mkr) ' location of King
'k2$ = MID$(alpha$, okc, 1) + CHR$(48 + okr) ' location of King
'ic = 0
'FOR i = 1 TO Moves(0) ' can any opponent piece move there?
' s$ = RIGHT$(Move$(z, 0), 2)
' IF k1$ = s$ THEN ic = 1 ' in check
' IF k2$ = s$ THEN ic = 2 ' in check
'NEXT i
'IF ic THEN
' check = true
' ic$ = CHR$(48 + ic) + " Check!"
' TempMess ic$
'END IF
WorB
= SaveWorB
XOR 1 ' toggle white/black
IF Move
= 500 THEN msg$
= "Over 500 moves...."
yoyo:
Playagain msg$
msg$ = ""
WorB = WorBs - 1: WorBs = 0
PlotScreen true
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
test:
Legal:
' udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R
,7000,0700,0070,0007,0000,0000,0000,0000 DATA N
,2010,2001,0210,0201,1020,1002,0120,0102 DATA B
,7070,7007,0770,0707,0000,0000,0000,0000 DATA Q
,7000,0700,0070,0007,7070,7007,0770,0707 DATA K
,1000,0100,0010,0001,1010,1001,0110,0101 DATA P
,1000,1001,1010,0000,0000,0000,0000,0000
hg:
' 1 2 3 4 5
' 12345678901234567890123456789012345678901234567890
DATA "01","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "02","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "03","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "04","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "05","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "06","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "07","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "08","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "09","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "10","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "11","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "12","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "13","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "14","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "15","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "16","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "17","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "18","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "19","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "20","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "21","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "22","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "23","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "24","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "25"," XXXXXXXXXXXXXXXXXXXX " DATA "26"," XXXXXXXXXXXXXXXXXX " DATA "27"," XXXXXXXXXXXXXXXX " DATA "28"," XXXXXXXXXXXXXX " DATA "29"," XXXXXXXXXXXX "
DATA "33","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "34","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "35","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "36","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "37","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "38","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "39","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "40","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "41","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "42","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "43","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "44","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "45","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "46","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "47","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "48","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "49","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "50","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "52","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "53","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "54","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "55","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "56","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "57","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "58","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "59","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "60","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "61","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "62","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "63","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" DATA "64","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
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,20,50,0,"board white"
DATA 1,30,60,20,"board white" DATA 2,1,1,1,"board black" DATA 3,50,50,50,"white bright" DATA 4,12,12,30,"white hightlight" DATA 5,0,0,0,"black bright" 'DATA 6,32,32,32,"black highlight"
DATA 6,50,12,12,"black highlight" DATA 15,30,30,30,"printing"
cmenu:
Oops:
gronk = gronk + 1
SUB AddIt
(Level
, tm$
, Score
) IF rflag
THEN mcount&
(Level
) = mcount&
(Level
) + 1 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)
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$
SUB Center
(tr
, t$
, highlight
) t$ = " Quit spacebar:move now Noise "
t$ = "Quit Resign Back Color Invert Setup Mode Noise Graphic"
y = ym - 40
y = ym - 18
y = tr / (ym / 16) * ym
LINE (0, ym
)-(xm
- 1, ym
- 18), bg0&
, BF
'COLOR white&
LINE (0, 500)-(xm
, ym
), bg0&
, BF
' clear lower area k = 1
tx
= 40 + INT((i
- 1) / 2) * 150 ty
= 540 + ((i
- 1) MOD 2) * 16 t$ = "rgb:down RGB:up Esc:exit"
FOR i
= 1 TO 3 ' show 3 colors lines x1 = xc - xq * 4: x2 = xc + xq * 4
y1 = yc + yq * 4 + 20 + i * 8: y2 = y1 + 4
LINE (x1
, y1
)-(x2
, y2
), black&
, BF
LINE (x1
, y1
)-(x2
, y2
), gray&
, B
IF i
= 1 THEN j
= myr
(k
): tc&
= red&
IF i
= 2 THEN j
= myg
(k
): tc&
= green&
IF i
= 3 THEN j
= myb
(k
): tc&
= blue&
j = j / 255 * xq * 8
LINE (x1
, y1
)-(x1
+ j
, y2
), tc&
, BF
IF i$
= "" THEN i$
= " " ' so instr doesn't bomb p
= INSTR("123456", i$
):
IF p
THEN k
= p
' select palette
z = 10
myr(k) = myr(k) - z
myg(k) = myg(k) - z
myb(k) = myb(k) - z
myr(k) = myr(k) + z
IF myr
(k
) > 255 THEN myr
(k
) = 255 myg(k) = myg(k) + z
IF myg
(k
) > 255 THEN myg
(k
) = 255 myb(k) = myb(k) + z
IF myb
(k
) > 255 THEN myb
(k
) = 255
ColorWrite
Colorassign
PlotScreen false
LINE (0, 500)-(xm
, ym
), black&
, BF
Moves(Level) = 0
prot(Level) = 0
mp = b(c, r)
mc = -(mp > 6) - (mp = 0) * 2 ' evaluates to 0 black 1 white 2 empty
mp = mp + (mp > 6) * 6
TryMove Level, c, r, mp, mc
IF Level
> 1 THEN GOTO nocastle
' only do for current move (speed)
cq = true: ck = true ' castling
tp = b(5, rn): tp = tp + (tp > 6) * 6 ' e1 (white) or e8 (black)
IF tp
<> King
THEN cq
= 0: ck
= 0:
GOTO nocastle
' no King here
t$ = "e" + rn$ ' King home spot algebraic
FOR lm
= 1 TO Moves
(1) ' can any opponent piece move there? IF t$
= RIGHT$(Move$
(1, lm
), 2) THEN cq
= 0: ck
= 0:
GOTO nocastle
' must be in check
' WHITE BLACK
' 8 R N B Q K B N R 1 R N B K Q B N R
' 7 P P P P P P P P 2 P P P P P P P P
' 6 3
' 5 4
' 4 5
' 3 6
' 2 P P P P P P P P 7 P P P P P P P P
' 1 R N B Q K B N R 8 R N B K Q B N R
' a b c d e f g h h g f e d c b a
FOR castle
= 1 TO 2 ' queenside, then kingside
'debug$(castle) = ""
nr = 0 ' no rook
pr = 0 ' prior condition
ne = 0 ' not empty
co = 0 ' controlled space
' bbww
' castle$ format "QKQK" blank if ok, X if nulled by King or Rook move
IF MID$(castle$
, WorB
* 2 + castle
, 1) <> " " THEN pr
= castle:
GOTO nocando
' prior condition
IF castle
= 1 THEN cn
= 1 ELSE cn
= 8 ' column number p = b(cn, rn): p = p + (p > 6) * 6
' bcd fg
IF castle
= 1 THEN ca$
= "234" ELSE ca$
= "67" ' column number FOR cs
= 1 TO LEN(ca$
) ' look at spaces between king and rook IF b
(cn
, rn
) > 0 THEN ne
= castle:
GOTO nocando
' not empty
t$
= MID$(alpha$
, cn
, 1) + rn$
' controlled square? FOR i
= 1 TO Moves
(lm
) ' see what can move here 'debug$(castle) = Move$(lm, i)
nocando:
'debug$(castle) = debug$(castle) + STR$(nr) + STR$(pr) + STR$(ne) + STR$(co)
IF (nr
+ pr
+ ne
+ co
) THEN ' non-zero means some test failed
IF ck
THEN AddIt Level
, "O-O", 12 IF cq
THEN AddIt Level
, "O-O-O", 13
'LOCATE 34 + WorB, 45: PRINT "*"; castle$; "* ";
'PRINT MID$("K ", ck + 2, 1);
'PRINT MID$("Q ", cq + 2, 1); cq; ck;
nocastle:
TakeBest Level, false
tf$ = "ccolor.dat"
INPUT #tf
, myr
(i
), myg
(i
), myb
(i
) cp&
(i
) = _RGB32(myr
(i
) * bri
, myg
(i
) * bri
, myb
(i
) * bri
) bri = 4
READ PalNum
, myr
(i
), myg
(i
), myb
(i
), Desc$
myr(i) = 32: myg(i) = 32: myb(i) = 32
cp&
(i
) = _RGB32(myr
(i
) * bri
, myg
(i
) * bri
, myb
(i
) * bri
) ColorWrite
black& = cp&(0)
boardwhite& = cp&(1)
boardblack& = cp&(2)
red& = cp&(7)
green& = cp&(8)
blue& = cp&(9)
white&
= _RGB32(155, 155, 155) IF altblack
THEN cp&
(6) = _RGB32(32 * bri
, 32 * bri
, 32 * bri
)
tf$ = "ccolor.dat"
PRINT #tf
, myr
(i
);
","; myg
(i
);
","; myb
(i
)
x1 = xc + (bc - 5) * xq: x2 = x1 + xq
y1 = yc + (4 - br) * yq: y2 = y1 + yq
GET (x1
, y1
)-(x2
, y2
), garr
() IF ctime!
> maxtime&
THEN ctime!
= 0
IF rflag
= 0 THEN tc
= humanc
ELSE tc
= 1 - humanc
t!
= TIMER - Start2!:
IF t!
< 0 THEN t!
= t!
+ maxtime&
etime!(tc) = etime!(tc) + t!
etime!
(2) = TIMER - Start1!
+ hold!
' current move hold! = 0
IF etime!
(2) > etime!
(tc
) THEN etime!
(2) = etime!
(tc
) etime!(3) = etime!(0) + etime!(1) ' game total
emin = etime!(2) \ 60
'IF rick AND (vflag = 0) THEN
' LOCATE 1, 4
' PRINT Moves(0);
' FOR i = 1 TO 3
' PRINT mcount&(i);
' NEXT i
' LOCATE 2, 4
' FOR i = 0 TO 3
' PRINT Moves(i);
' NEXT i
'END IF
'IF tlimit > 0 THEN t$ = LTRIM$(STR$(tlimit)) + "m" ELSE t$ = "unlimited"
't$ = "Time: " + t$
'LOCATE 2, 4: PRINT t$;
tcount& = Moves(0) + mcount&(1) + mcount&(2) + mcount&(3)
mps& = tcount& - ocount&
IF mps&
<= 100 THEN mps&
= omps&
ELSE opms&
= mps&
'bg2& = _RGB32(0, 70, 70)
'LINE (351, 504)-(xm - 8, ym - 22), bg2&, BF
ShowTime 32, etime!(0), "Black"
ShowTime 33, etime!(1), "White"
ShowTime 34, etime!(3), "Game"
ShowTime 35, etime!(2), "Move"
'COLOR white&, black&
ocount& = tcount&
dtime!
= TIMER + 1:
IF dtime!
> maxtime&
THEN dtime!
= 0
FUNCTION f_pl
(n1
, n2
, n3
) ' plasma function f_pl
= _RGB32(n1
* 255, n2
* 255, n3
* 255)
fr
= VAL(MID$(m$
, 2, 1)) ' from row (or rank) IF invert
THEN fr
= 9 - fr
' invert means black at bottom
tr
= VAL(MID$(m$
, 4, 1)) ' row or rank IF invert
THEN tr
= 9 - tr
' black at bottom
'IF (itime! = 0) OR (TIMER > itime!) THEN
' iname = iname XOR 1
' _ICON icon&(iname + 2) ' clockx or clockx2
' itime! = TIMER + .5
'END IF
KeyScan 1, 1 ' plotscreen, _display
Cursor fr, fc, 0
Cursor tr, tc, 0
xm = 600: ym = 200
Colorassign ' red&, green&, etc, easier to use than palette numbers
alpha$ = "abcdefgh"
q = 120
fg0& = black&
castle$
= SPACE$(4) ' flags QKQK (B then W) crlf$ = Enter$ + lf$
Esc$
= CHR$(27) ' to quit program graphics = 3 ' graphics for white squares (0-3)
lcount& = 0 ' line counter for debug output
lf$
= CHR$(10) ' line feed maxtime& = 86400
Move = 0
MakeNoise = 1
showthink = 1
WorB = 1 ' white=1, black=0
xq = 56: yq = 56
xc = 248: yc = 256 ' center of board
alphal$
(i
) = MID$(alpha$
, i
, 1)
FOR i
= 0 TO 3: etime!
(i
) = 0:
NEXT ' sides, total, current
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 du
(p
, t
) = VAL(MID$(udlr$
, 1, 1)) ' direction up dd
(p
, t
) = VAL(MID$(udlr$
, 2, 1)) ' direction down dl
(p
, t
) = VAL(MID$(udlr$
, 3, 1)) ' direction left dr
(p
, t
) = VAL(MID$(udlr$
, 4, 1)) ' direction right
' RNBQKP
value
(i
) = VAL(MID$("533901", i
, 1)) ' point value for capture
RESTORE Setup
' initial board position o(c, r) = b(c, r) ' initial setup
gm = 0: n = 0
gm = 0
newf:
f = f + 1
f$
= "ch" + RIGHT$("0000000" + LTRIM$(STR$(f
)), 6) + ".alg" ' save game for analysis
f$ = "alfred.jpg" ' Alfred E. Neuman
f$ = "chess.png"
f$ = "clockx.png"
f$ = "clockx2.png"
isthere = true
f$
= UCASE$(f$
) ' now try uppercase li1:
_SOURCE icon&
(0) ' Alfred E. Neuman GET (0, 0)-(52, 53), abuff
(0)
Menubox
Center 6, "White Black Humans Computer", 1
Center 0, "Quit or Esc to exit", 1
human = 1: humanc = 0: invert = 1
human = 1: humanc = 1
human = 2
CASE IS = 4 ' computer vs. computer, just watch human = 0: OnAuto = 1
'IF human <> 2 THEN
' tlimit = 0
' DO
' CLS
' Menubox
' Center 6, "Time limit in minutes? (0 unlimited)", 0
' Center 8, STR$(tlimit), 0
' Center 0, "Quit or Esc to exit", 1
' _DISPLAY
' DO: _LIMIT 10
' i$ = INKEY$
' LOOP UNTIL LEN(i$)
' IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
' IF i$ = CHR$(8) THEN tlimit = tlimit / 10
' p = INSTR("0123456789", i$): IF p THEN tlimit = tlimit * 10 + p - 1
' LOOP UNTIL i$ = Enter$
'END IF
'IF rick THEN smode = 2
ScreenInit
PlotBoard
cursoron!
= TIMER + 3:
IF cursoron!
> maxtime&
THEN cursoron!
= 0 rr = 7
cc = 5 + (WorB = 0)
IF vflag
THEN ShowValid cc
, rr
KeyScan 1, 0 ' plotscreen, no _display
xx = (mx - xc - (4 * xq) + xq \ 2) / xq + 8
yy = (my - yc - (4 * yq) + yq \ 2) / yq + 8
cc = cc + (kk = 75) - (kk = 77) ' left right
rr = rr + (kk = 72) - (kk = 80) ' up down
fr = rr: fc = cc
IF invert
THEN fr
= 9 - fr: fc
= 9 - fc
tr = rr: tc = cc
IF invert
THEN tr
= 9 - tr: tc
= 9 - tc
m$ = fs$ + ts$
IF m$
= "e1g1" THEN m$
= "O-O" IF m$
= "e1c1" THEN m$
= "O-O-O" IF m$
= "e8g8" THEN m$
= "O-O" IF m$
= "e8c8" THEN m$
= "O-O-O"
SUB KeyScan
(kf1
, kf2
) STATIC ' plotscreen, _display TempMess "", 0
DispStats
dot = 0
IF cursoron!
> maxtime&
THEN cursoron!
= 0 c
= INSTR("123456789ABCDEF0", i$
) ' experiment with colors c = 2
myr(c) = 0: myg(c) = 0: myb(c) = 0
myr
(c
) = RND * 64: myg
(c
) = RND * 64: myb
(c
) = RND * 64 cp&
(c
) = _RGB32(myr
(c
) * bri
, myg
(c
) * bri
, myb
(c
) * bri
) ColorWrite
Colorassign
PlotBoard
IF i$
= "a" THEN OnAuto
= NOT (OnAuto
) ' not currently in use IF i$
= "b" THEN takebackflag
= 1 IF i$
= "g" THEN ' change white square graphics scheme graphics
= (graphics
+ 1) MOD 4 IF graphics
= 0 THEN PlotBoard
t$
= "Mode" + STR$(graphics
+ 1) + " of 4" TempMess t$, 2
IF i$
= "G" THEN pinit
= pinit
XOR 1 ' adjust current white square graphics IF i$
= "h" THEN dot
= 1: history
= history
XOR 1 IF i$
= "i" THEN ' flip board around PlotBoard
useidiot
= useidiot
XOR 1 t$ = "Idiot " + OnOff$(useidiot)
TempMess t$, 2
IF i$
= "l" THEN dot
= 1: showlegalf
= showlegalf
XOR 1 IF i$
= "L" THEN ' look at log file IF i$
= "m" THEN ' screen mode smode
= (smode
+ 1) MOD 3 ScreenInit
IF i$
= "n" THEN ' sound effects MakeNoise
= MakeNoise
XOR 1 t$ = "Sound " + OnOff$(MakeNoise)
TempMess t$, 2
IF i$
= "p" THEN dot
= 1: showprotf
= showprotf
XOR 1 IF t!
< 0 THEN t!
= t!
+ maxtime&
hold! = t!
IF (rflag
= 0) AND (i$
= "r") THEN abort
= 2: msg$
= "Resign!" IF i$
= "s" THEN Setup
' setup IF i$
= "t" THEN dot
= 1: showthink
= showthink
XOR 1 IF i$
= "v" THEN ' show valid moves at top left IF i$
= "x" AND MakeNoise
THEN PlaySound
"ding" ' sound test ColorWrite
Colorassign
PlotBoard
'IF i$ = "y" THEN itest ' see how bad icon problem is
altblack
= altblack
XOR 1 Colorassign
'CLS 0, bg0&
PlotBoard
TempMess "Alternate black " + OnOff(altblack), 2
i$ = ""
wbri = bri
bri = bri - (k = 73) + (k = 81) ' brightness PgUp/PgDn
IF bri
<> wbri
THEN ' was changed ColorWrite
Colorassign
TempMess
"Brightness" + STR$(bri
), 1
IF dot
THEN DebugR
= 99: TextInfo
""
ts = 0: z1$ = "": z2$ = ""
ti = TieTo(t)
z1$ = z1$ + Make4$(Move$(t - 1, ti)) + " "
z2$ = z2$ + Rjust$(Score(t - 1, ti), 3) + " "
ts = ts + Score(t - 1, ti)
ts = ts - Score
zz$ = z1$ + Make4$(m$) + z2$ + Rjust$(Score, 3) + " " + Rjust$(ts, 4)
zz = Score(0, 1)
z$ = Move$(0, 1)
bscore = zz
IF zz
= bscore
THEN best$
= best$
+ " " + z$
ELSE best$
= z$
TextInfo zz$
xs = 200: ys = 70
x1 = tx - xs: y1 = ty - ys
x2 = tx + xs: y2 = ty + ys
LINE (x1
, y1
+ 20)-(x2
, y2
- 20), _RGBA(1, 1, 1, 220), BF
LINE (x1
- q
+ 0, y1
+ q
+ 0)-(x2
+ q
+ 0, y2
- q
+ 0), cp&
(1), B
LINE (x1
- q
+ 1, y1
+ q
+ 1)-(x2
+ q
+ 1, y2
- q
+ 1), cp&
(1), B
IF m$
= ep$
THEN ' epfc, epfr, eptc, eptr, eprc, eprr Plotpiece fc, fr, tc, tr
b(epfc, epfr) = 0
b(eprc, eprr) = 0
b(eptc, eptr) = 6 + WorB * 6
fs$
= LEFT$(m$
, 2) ' from square ts$
= RIGHT$(m$
, 2) ' to square tzz
= 1 - (LEFT$(m$
, 1) = "O") - (L1$
= "e") ' 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"
pm = b(fc, fr) ' piece to move
p = pm + (pm > 6) * 6
b(tc, tr) = pm ' move piece in array
b(fc, fr) = 0 ' blank old array spot
IF b
(c
, r
) = o
(c
, r
) THEN o
(c
, r
) = -1 Plotpiece fc, fr, tc, tr
IF p
= King
THEN MID$(castle$
, WorB
* 2 + 1, 2) = "XX" b(tc, tr) = Queen - (pm > 6) * 6 ' promote to queen
IF real
THEN Plotpiece tc
, tr
, tc
, tr
' show queen
OnOff$
= MID$("OFFON ", v
* 3 + 1, 3)
r1 = r: g1 = g: b1 = b
FOR m%
= 0 TO 17: m1%
= 17 - m%
f1 = (m% * r) / 18: f2 = (m% * g) / 18: f3 = (m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
FOR m%
= 0 TO 17: m1%
= 17 - m%
f1 = (m% + m1% * r) / 18: f2 = (m% + m1% * g) / 18: f3 = (m% + m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
FOR m%
= 0 TO 17: m1%
= 17 - m%
f1 = (m1% + m% * r) / 18: f2 = (m1% + m% * g) / 18: f3 = (m1% + m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
FOR m%
= 0 TO 17: m1%
= 17 - m%
f1 = (m1% * r) / 18: f2 = (m1% * g) / 18: f3 = (m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
p
(n%
).x
= RND * xm%: p
(n%
).y
= RND * ym%: p
(n%
).dx
= RND * 2 - 1: p
(n%
).dy
= RND * 2 - 1
xm2% = 8 * xq%: ym2% = xm2%: x1% = xc% - 4 * xq%: y1% = yc% - 4 * yq%: x2% = xc% + 4 * xq%: y2% = yc% + 4 * yq%:
pinit% = 1
p(n%).x = p(n%).x + p(n%).dx
IF p
(n%
).x
> xm2%
OR p
(n%
).x
< 0 THEN p
(n%
).dx
= -p
(n%
).dx
p(n%).y = p(n%).y + p(n%).dy
IF p
(n%
).y
> ym2%
OR p
(n%
).y
< 0 THEN p
(n%
).dy
= -p
(n%
).dy
'IF (p& = boardwhite&) OR (p& = boardblack&) THEN
d = 0
dx = x% - p(n%).x: dy = y% - p(n%).y
k
= SQR(dx
* dx
+ dy
* dy
) d
= d
+ (SIN(k
* f
(n%
)) + 1) / 2 '_DELAY .001
Menubox
Center 18, t$, 0
Center 20, "Resume New game Quit", 1
ks$ = "rn"
Center 20, "New game Quit", 1
ks$ = "rn" ' take out r when working properly (false checkmates)
'COLOR _RGBA(155, 155, 155, 255), _RGBA32(0, 0, 0, 255)
tryagain:
f$ = f$ + ".alg"
FlashMove false
MoveIt m$, true
PlotScreen true
pbdone:
IF MakeNoise
THEN PlaySound
"ding"
SUB PlaySound
(f$
) STATIC ' ding,tada,notify,windows xp hardware fail, etc. CONST CACHE
= 441 ' minimal detected frequency for analyzer is 100 Hz, so this is enought value (with 44100 biterate) subchunksize
AS LONG ' 4 bytes (lo / hi), $00000010 for PCM audio format
AS STRING * 2 ' 2 bytes (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM) channels
AS INTEGER ' 2 bytes (1 = mono, 2 = stereo) rate
AS LONG ' 4 bytes (sample rate, standard is 44100) ByteRate
AS LONG ' 4 bytes (= sample rate * number of channels * (bits per channel /8)) Block
AS INTEGER ' 2 bytes (block align = number of channels * bits per sample /8) Bits
AS INTEGER ' 2 bytes (bits per sample. 8 = 8, 16 = 16) subchunk2
AS STRING * 4 ' 4 bytes ("data") contains begin audio samples f$ = f$ + ".wav"
block = H.Block
RATE = H.rate
chan = H.channels
bits = H.Bits
lef = scache(P).Left
IF chan
= 1 THEN righ
= lef
ELSE righ
= scache
(P
).Right
lef = lef / RATE
righ = righ / RATE
IF RATE
> 44100 THEN frekvence
= RATE
ELSE frekvence
= 44100 FOR plll
= 1 TO frekvence
/ RATE
IF rflag
= 0 THEN Plotpiece zc
, zr
, zc
, zr
SUB Plotpiece
(fc
, fr
, tc
, tr
) x1 = xc + (fc - 5) * xq
x2 = xc + (tc - 5) * xq
y1 = yc + (4 - fr) * yq
y2 = yc + (4 - tr) * yq
p = b(tc, tr)
IF invert
THEN p
= b
(9 - tc
, 9 - tr
) 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
'CLS 0, bg0&
PlotBoard
TextInfo ""
r
= _RED32(boardwhite&
) \
2 ' legend, dim a-h, 1-8 along sides a$ = alphal$(z)
nx = xc - 4 * xq - 12
ny = yc + (i - 4) * yq - 34
ax = xc + (i - 5) * xq + 23
ay = yc + 4 * yq + 3
Plasma
br = 255
x1 = xc - 4 * xq
y1 = yc - 4 * yq
x2 = x1 + 8 * xq
y2 = y1 + 8 * yq
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
))
gm
= gm
+ 1: g$
(gm
) = LTRIM$(m1$
) gm
= gm
+ 1: g$
(gm
) = LTRIM$(m2$
)
FOR t
= 1 TO Moves
(Level
- 1)
IF Level
= 1 THEN ' progress bar x1 = xc - 4 * xq: x2 = xc + 4 * xq
y1 = yc + 4 * yq + 20
z1 = Moves(Level - 1): z2 = z1 - (z1 = 0)
xx = (z1 - t + 1) / z2 * (x2 - x1)
LINE (x1
, y1
)-(x2
, y1
), bg0&
IF (xx
- x1
) > 2 THEN LINE (x1
, y1
)-(xx
, y1
), cp&
(1)
'x1 = 290: x2 = x1 + 50
'y1 = 508: y2 = y1 + 64
'LINE (x1, y1)-(x2, y2), _RGB32(222, 0, 0), B
WorB = SaveWorB
TieTo(Level) = t
_MEMCOPY m
(0), m
(0).OFFSET
, m
(0).SIZE
TO m
(Level
), m
(Level
).OFFSET
' save board m$ = Move$(Level - 1, t)
MoveIt m$, false
lm1 = Level - 1
CheckBoard Level
Recurse Level + 1
TakeBest Level, false
i = Index
Score = Score(Level, 1)
levm1 = Level - 1
IF Score
(levm1
, 1) <> 777 THEN Score
(levm1
, i
) = Score
(levm1
, i
) - Score
IF Level
= (MasterLevel
- 1) THEN KeyScan 0, 0 ' no plotscreen or _display
'IF (tlimit > 0) AND (emin >= tlimit) THEN abort = true
LogThinking
_MEMCOPY m
(Level
), m
(Level
).OFFSET
, m
(Level
).SIZE
TO m
(0), m
(0).OFFSET
' restore board
WorB
= WorB
XOR 1 ' reverse who's moving CheckBoard 1 ' need to know what opponent can do to ensre legal castling
WorB
= WorB
XOR 1 ' restore playing color CheckBoard 0 ' determine legal moves
SUB SaveForTakeBack
STATIC ' use MEM later to move arrays castle$(i) = castle$(i - 1)
tb(c, r, i) = tb(c, r, i - 1)
castle$(0) = castle$
tb(c, r, 0) = b(c, r)
tbc = tbc + 1
xm = 480: ym = 600
MaxRow = ym \ 16 - 2
k = 99
t1$ = "rnbkqp:black clear:one spacebar:flip"
t2$ = "RNBKQP:white Clear:all Esc:exit"
LINE (0, 500)-(xm
, ym
), black&
, BF
cc = 1: rr = 8
Center -1, t1$, 0
Center 0, t2$, 0
PlotBoard
IF z
THEN Cursor
9 - rr
, cc
, 0 r2 = 9 - rr
IF (i$
= CHR$(9)) OR (i$
= "c") THEN b
(cc
, r2
) = 0 ' Del or "c" to delete piece IF i$
= "C" THEN ' delete all pieces b(c, r) = 0
p
= INSTR("rnbqkpRNBQKP", i$
) IF p
THEN b
(cc
, r2
) = p
' set piece by letter mp = b(cc, r2)
b(cc, r2) = mp
t = b(c, r)
s9(c, r) = t
b(c, 9 - r) = s9(c, r)
cc = cc + (kk = 75) - (kk = 77) ' left right
rr = rr + (kk = 72) - (kk = 80) ' up down
LINE (0, 500)-(xm
, ym
), black&
, BF
' board probably changed - reinitialize legal moves
Reset_To_Zero
'bg1& = _RGB32(0, 90, 0)
'LINE (22, 504)-(350, ym - 22), bg1&, BF
yy = 505
ty = yy
tx = 29
t$ = Make4$(Move$(0, t)) + Rjust$(Score(0, t), 5)
FOR i
= 1 TO LEN(t$
) ' shift "g" up 2 pixels y2 = ty + (c$ = "g") * 2
ty = ty + 14
IF ty
> 570 THEN ty
= yy: tx
= tx
+ 80
sc
= POS(0) ' save column LOCATE dr
, dc
' display row & column LOCATE sr
, sc
' restore to old location
SUB ShowTime
(trow
, z!
, Desc$
) t! = z!
unit$ = "h"
t! = t! / 3600
unit$ = "m"
t! = t! / 60
unit$ = "s"
x1 = 408
x2
= x1
- (LEN(Desc$
) + 1) * 8 yy = trow / (600 / 16) * 600 - 4
t!
= INT(t!
* 1000) / 1000 zz = 0
t$ = t$ + "0"
zz = zz + 1
dammit:
SUB ShowValid
(cc
, rr
) ' show valid moves for piece at cursor
tc = cc: tr = rr
IF invert
THEN tc
= 9 - tc: tr
= 9 - tr
mp = b(tc, tr): mp = mp + (mp > 6) * 6
t$ = z$ + ":"
IF (mp
= King
) AND (LEFT$(Move$
(0, i
), 1) = "O") THEN t$
= t$
+ " " + Move$
(0, i
) 'IF (tc = epfc) AND (tr = epfc) THEN t$ = t$ + " ep"
SUB TakeBack
' use MEM to move arrays? speed not an issue here IF MakeNoise
THEN PlaySound
"tb" ' so your mom knows you're cheating :) castle$ = castle$(2)
b(c, r) = tb(c, r, 2)
castle$(i) = castle$(i + 1)
tb(c, r, i) = tb(c, r, i + 1)
tbc = tbc - 1
Reset_To_Zero
SUB TakeBest
(Level
, final
)
IF final
THEN ' feeble attempt to vary response when scores equal upto = 10
IF upto
> Moves
(Level
) THEN upto
= Moves
(Level
) 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)
best$ = Move$(0, 1)
bscore = Score(0, 1)
IF Score
= -777 THEN ' in check, no escape abort = 3: msg$ = "Checkmate!"
abort = 3: msg$ = "Stalemate!"
tm = Moves(1)
FOR lb
= 1 TO 9 ' stop repeats 'SOUND 888, 1
Score(1, 1) = Score(1, 1) - 10
passes = passes + 1
IF passes
< 5 THEN GOTO ReSort
' repeat may be only move
IF (Level
= 1) AND (Score
= 777) THEN Score
(0, TieTo
(1)) = -777
t$ = "History Thinking Legal Protection"
'LOCATE 1, 4: PRINT showthink; history; showlegalf; showprotf;
z = 0
DebugR = 3: DebugC = 61
DebugR = DebugR + 1
IF DebugR
= MaxRow
THEN DebugR
= 99 BeginAt = Move - 28
IF BeginAt
< 1 THEN BeginAt
= 1 tr = 4
tr = tr + 1
tr = i + 3
tr = i + 3
tr = i + 3
tr = i + 3
SUB TryMove
(Level
, fc
, fr
, mp
, mc
) ' from row, from column IF mc
= 1 THEN s
= -1 ELSE s
= 1 ' direction a pawn moves incheck
= (mc
= SaveWorB
) AND check
' rnbqkp
nmoves
= VAL(MID$("373772", mp
, 1))
FOR n
= 0 TO nmoves
' possible 8 dirs du = du(mp, n): dd = dd(mp, n): dl = dl(mp, n): dr = dr(mp, n)
IF mp
<> Knight
THEN du
= SGN(du
) * s: dd
= SGN(dd
) * s: dl
= SGN(dl
) * s: dr
= SGN(dr
) * s
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 tc = fc: tr = fr ' row, column
fs$
= alphal$
(fc
) + CHR$(48 + fr
) ' from square cap = false
FOR sq
= 1 TO TrySq
' up to 7 steps in current direction Score = 0 ' must init
tc = tc - dl + dr ' column=column-left+right
tr = tr - du + dd ' row=row-up+down
ts$
= alphal$
(tc
) + CHR$(48 + tr
) ' to square cp = b(tc, tr) ' capture piece
cc = -(cp > 6) - (cp = 0) * 2 ' capture color
cp = cp + (cp > 6) * 6
prot(Level) = prot(Level) + 1
IF prot
(Level
) < q1
THEN prot$
(Level
, prot
(Level
)) = fs$
+ ts$
cap = true
Score = Score + value(cp) * 10
IF value
(cp
) = 0 THEN Score
= 777 ' king capture
'FOR i = 1 TO Moves(lm) ' can any opponent piece move there?
' s$ = RIGHT$(Move$(lm, i), 2)
'IF ts$ = s$ THEN GOTO nsquare ' would be moving into check
'NEXT
FOR i
= 1 TO prot
(lm
) ' opponent piece protecting? IF ts$
= s$
THEN GOTO nsquare
' would be moving into check Score = Score + 20
IF Move
< 30 THEN Score
= Score
- 4 ' usually not good to be moving the King dis1
= ABS(fr
- okr
) + ABS(fc
- okc
) ' get closer to king dis2
= ABS(tr
- okr
) + ABS(tc
- okc
) Score = Score + dis1 - dis2
IF dir
= 1 THEN Score
= Score
+ 2 ' move ahead at begin & mid game
' 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 IF mp
<> Rook
THEN ' priority to getting a piece first moved IF b
(fc
, fr
) = o
(fc
, fr
) THEN Score
= Score
+ 1 's1 = Score
'IF (Score <> 777) AND (NOT (incheck)) THEN
Score = Score + TrySq
IF (tr
= 1) OR (tr
= 8) THEN ' promote pawn Score = Score + 99
'END IF
'IF s1 = 777 THEN Score = s1
AddIt Level, fs$ + ts$, Score
nsquare:
IF mp
= Pawn
THEN ' en passant IF WorB
THEN othp
= 6 ELSE othp
= 12 ' opponent pawn l1 = 7 + (WorB = 0) * 5 ' rank 7 for white, 2 for black
l2 = 5 - (WorB = 0) ' rank 5 for white, 6 for black
lc = fc + z ' look column
IF (lc
> 0) AND (lc
< 9) THEN ' in bounds of board IF b
(lc
, fr
) = othp
THEN ' it is a pawn tc$ = alphal$(lc)
tm$
= tc$
+ CHR$(48 + l1
) + tc$
+ CHR$(48 + l2
) ' form coordinate IF tm$
= lm$
THEN ' yes, add e.p. to list of legal moves epfc = fc: epfr = fr ' en passant from row, column
eptc = lc: eptr = fr - s ' en passant to row, column
eprc = lc: eprr = fr ' en passant remove piece
ep$
= alphal$
(epfc
) + CHR$(48 + epfr
) + alphal$
(eptc
) + CHR$(48 + eptr
) AddIt Level, ep$, 1 ' add with score of 1
'EXIT SUB
zz = 100: x1 = xc - zz: x2 = xc + zz
y = 12
LINE (x1
, 0)-(x2
, 28), black&
, BF
current$ = t$
mtime!
= TIMER + secs:
IF mtime!
> maxtime&
THEN mtime!
= 0 LINE (x1
, 0)-(x2
, 28), black&
, BF
mtime! = 0