ChessHackImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) March 27, 1986 2:03:44 am PST
DIRECTORY
Basics USING [BITAND, BITOR, BITXOR],
BasicTime USING [GetClockPulses, Now, Pulses, PulsesToSeconds],
CedarProcess USING [GetPriority, Priority, SetPriority],
ChessDefs USING [Aliases, AliasesRep, Board, BoardIndex, ColoredPiece, CoverageRep, FullPosition, GameState, GameStateRep, Move, MoveHistory, MoveHistoryRep, MoveList, Pawn, Piece, PieceColor, Position, Positions, PositionsRep, Side, SpecialEffects, SquareCoverage, WhiteBlack],
Commander USING [CommandProc, Register],
CommandTool USING [FileWithSearchRules],
FS USING [Error, ExpandName, StreamOpen],
Imager USING [Color, DoSaveAll, MaskRectangleI, ScaleT, SetColor, SetFont, SetGray, SetXY, ShowChar, ShowRope, TranslateT],
ImagerColor USING [Color, ColorFromGray],
ImagerFont USING [BoundingBox, Extents, Find, Font, Scale],
IO USING [Close, EndOfStream, Error, GetInt, GetToken, IDProc, PutChar, PutF, PutF1, PutFR1, PutRope, SkipWhitespace, STREAM],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu],
MessageWindow USING [Append],
Process USING [Detach, MsecToTicks, Pause],
ProcessProps USING [GetProp],
Rope USING [Concat, Fetch, Length, ROPE],
RuntimeError USING [UNCAUGHT],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
ViewerClasses USING [DestroyProc, NotifyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],
ViewerSpecs USING [menuHeight],
ViewerTools USING [GetSelectionContents];
ChessHackImpl: CEDAR MONITOR
LOCKS data USING data: MyData
IMPORTS Basics, BasicTime, CedarProcess, Commander, CommandTool, FS, Imager, ImagerColor, ImagerFont, IO, Menus, MessageWindow, Process, ProcessProps, Rope, RuntimeError, TIPUser, ViewerOps, ViewerSpecs, ViewerTools
= BEGIN OPEN ChessDefs;
Types
LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Automatic player
StopRequest: ERROR = CODE;
AutoMove: PROC [data: MyData, level: NAT] RETURNS [MoveList] = {
MoveFlags: TYPE = RECORD [
taking: BOOLFALSE,
check: BOOLFALSE
];
ComputeCoverage: PROC [by: WhiteBlack, on: WhiteBlack] RETURNS [covers: ARRAY Piece OF NAT] = {
other: WhiteBlack ← OtherColor[by];
state: GameState ← data.state;
covers ← ALL[LAST[NAT]];
FOR piece: Piece IN Piece DO
fPos: FullPosition ← data.state.positions[by][piece];
IF fPos.onOff # off THEN {
pa: Piece ← IF piece IN Pawn THEN state.aliases[by][piece] ELSE piece;
pv: NAT ← materialWeights[pa];
FOR victim: Piece IN Piece DO
vPos: FullPosition ← data.state.positions[on][victim];
IF vPos.onOff # off AND PieceCovers[state, by, vPos.position, piece] THEN {
IF pv < covers[victim] THEN covers[victim] ← pv;
};
ENDLOOP;
};
ENDLOOP;
};
MinReply: PROC [by: WhiteBlack, victim: Piece] RETURNS [NAT] = {
state: GameState ← data.state;
min: NAT ← NoThreat;
vPos: FullPosition ← state.positions[by][victim];
IF vPos.onOff # off THEN {
FOR piece: Piece IN Piece DO
IF victim # piece THEN {
fPos: FullPosition ← state.positions[by][piece];
IF fPos.onOff # off THEN {
pa: Piece ← IF piece IN Pawn THEN state.aliases[by][piece] ELSE piece;
pv: NAT ← materialWeights[pa];
IF PieceCovers[state, by, vPos.position, piece] THEN {
IF pv < min THEN min ← pv;
};
};
};
ENDLOOP;
};
RETURN [min];
};
NoThreat: NAT = LAST[NAT];
driver: PROC [level: NAT, fanOut: [0..MaxFanOut), firstCall: BOOLFALSE] RETURNS [dMove: Move, val: INTEGER ← 0, maxMoves: NAT ← 0] = {
state: GameState ← data.state;
goodMovesMax: NAT ← 0;
goodValues: ARRAY [0..MaxFanOut) OF INTEGER;
goodBonus: ARRAY [0..MaxFanOut) OF INTEGER;
goodMoves: ARRAY [0..MaxFanOut) OF Move;
goodFlags: ARRAY [0..MaxFanOut) OF MoveFlags;
color: WhiteBlack ← state.toMove;
other: WhiteBlack ← OtherColor[color];
history: MoveHistory ← state.history;
lastValue: INTEGER ← 0;
bestIndex: NAT ← 0;
kW: INTEGER ← materialWeights[k];
wasInCheck: BOOL ← state.inCheck[color];
foundMate: BOOLFALSE;
val ← state.material[color] - state.material[other];
IF firstCall THEN minValue ← val - valueCutoff;
{
FOR piece: Piece IN Piece WHILE NOT foundMate DO
fPos: FullPosition ← data.state.positions[color][piece];
IF fPos.onOff # off THEN {
pass1: MoveAction = {
[state: GameState, move: Move] RETURNS [quit: BOOLFALSE]
In Pass1 we try to make a rank ordering based on the "likely" best move.
IF data.stopRequested THEN ERROR StopRequest;
IF MakeMove[state, move] THEN {
ENABLE UNWIND => UnMakeMove[state];
value: INTEGER ← state.material[color] - state.material[other];
flags: MoveFlags ← [];
pos: NAT ← goodMovesMax;
dest: Position ← move.to;
bonus: INTEGER ← 0;
otherMoves: NAT ← 0;
otherTakes: NAT ← 0;
myWeight: NAT ← 0;
forceEntry: BOOL ← wasInCheck;
alias: Piece ← move.piece.piece;
IF alias IN Pawn THEN alias ← state.aliases[color][alias];
myWeight ← materialWeights[alias];
IF state.inCheck[other] THEN {
IF CheckMate[state] THEN GO TO absoluteBest;
flags.check ← forceEntry ← TRUE;
};
IF firstCall
THEN {
At the base level we try hard for pruning, since we don't get another chance at this level of move.
otherBest: MoveAction = {
IF MakeMove[state, move] THEN {
ENABLE UNWIND => UnMakeMove[state];
myBest2: MoveAction = {
IF MakeMove[state, move] THEN {
ENABLE UNWIND => UnMakeMove[state];
val2: INTEGER ← state.material[color] - state.material[other];
myMoves2 ← myMoves2 + 1;
SELECT TRUE FROM
state.inCheck[other] => {
val2 ← val2 + 50;
IF (quit ← CheckMate[state]) THEN val2 ← kW;
};
ENDCASE;
IF myMoves2 = 1 OR val2 > temp THEN temp ← val2;
UnMakeMove[state];
};
};
inCheck: BOOL ← state.inCheck[color];
temp: INTEGER ← 0;
myMoves2: NAT ← 0;
otherMoves ← otherMoves + 1;
FOR piece: Piece IN Piece DO
fPos: FullPosition ← data.state.positions[color][piece];
IF fPos.onOff # off THEN {
ProposeLegalMove[piece, color, state, myBest2];
};
ENDLOOP;
IF myMoves2 = 0 AND state.inCheck[color] THEN {
temp ← -kW;
quit ← TRUE;
};
IF otherMoves = 1 OR temp < value THEN value ← temp;
UnMakeMove[state];
};
};
otherMoves: NAT ← 0;
FOR piece: Piece IN Piece DO
fPos: FullPosition ← data.state.positions[other][piece];
IF fPos.onOff # off THEN {
ProposeLegalMove[piece, other, state, otherBest];
};
ENDLOOP;
SELECT TRUE FROM
otherMoves = 0 AND state.inCheck[other] => {
value ← kW;
quit ← TRUE;
};
ENDCASE => {
IF move.note.kind = remove THEN flags.taking ← TRUE;
SELECT alias FROM
p0, p1, p2, p3, p4, p5, p6, p7 => {
We rather like moving the pawns forwards
toRow: [0..7] ← move.to.row;
fwd: INTEGERIF color = white THEN 1 ELSE -1;
bonus ← bonus + 5;
SELECT move.from.row FROM
1 => IF toRow = 3 THEN bonus ← bonus + 5;
2 => IF toRow = 1 THEN bonus ← bonus + 20;
3 => IF toRow = 2 THEN bonus ← bonus + 5;
4 => IF toRow = 5 THEN bonus ← bonus + 5;
5 => IF toRow = 6 THEN bonus ← bonus + 20;
6 => IF toRow = 4 THEN bonus ← bonus + 5;
ENDCASE => ERROR;
SELECT move.to.col FROM
3, 4 => bonus ← bonus + 2;
Slight advantage for advancing central pawns
1, 2 => bonus ← bonus + 1;
Slighter advantage for queen-side pawns
ENDCASE;
IF move.to.row IN [1..6] THEN {
Weight for coverage by pawns
me: Piece ← move.piece.piece;
nRow: [0..7] ← toRow+fwd;
col: [0..7] ← move.to.col;
IF col # 0 THEN {
diag: Position ← [rowCol[nRow, col-1]];
cp: ColoredPiece ← state.board[diag.index];
SELECT cp.color FROM
other =>
bonus ← bonus + 4;
color =>
IF cp.piece IN Pawn THEN bonus ← bonus + 4;
ENDCASE;
};
IF col # 7 THEN {
diag: Position ← [rowCol[nRow, col+1]];
cp: ColoredPiece ← state.board[diag.index];
SELECT cp.color FROM
other =>
bonus ← bonus + 4;
color =>
IF cp.piece IN Pawn THEN bonus ← bonus + 4;
ENDCASE;
};
IF col IN [1..7] THEN {
facing: Position ← [rowCol[nRow, col]];
cp: ColoredPiece ← state.board[facing.index];
IF cp.color = other AND cp.piece IN Pawn THEN
We are blocking the movement of an enemy pawn
bonus ← bonus + 4;
};
};
};
wn, bn => {
We rather like moving the knights off the edges
fromW: INTEGER = centralWeights[move.from.index];
toW: INTEGER = centralWeights[move.to.index];
bonus ← bonus + (toW-fromW);
IF wasInCheck THEN bonus ← bonus + 8;
};
wb, bb => {
We like to block checks with bishops
SELECT move.from.row FROM
0, 7 => bonus ← bonus + 5;
ENDCASE;
IF wasInCheck THEN bonus ← bonus + 10;
};
wr, br, q => {
It is a good idea to keep the rooks lined up
qPos: FullPosition ← state.positions[color][q];
brPos: FullPosition ← state.positions[color][br];
wrPos: FullPosition ← state.positions[color][wr];
SELECT TRUE FROM
qPos.onOff = off AND wrPos.onOff = off => {};
qPos.onOff = off AND brPos.onOff = off => {};
wrPos.onOff = off AND brPos.onOff = off => {};
qPos.onOff = off AND
(wrPos.position.row = brPos.position.row
OR wrPos.position.col = brPos.position.col)
=>
The rooks are lined up
bonus ← bonus + 10;
wrPos.onOff = off AND
(qPos.position.row = brPos.position.row
OR qPos.position.col = brPos.position.col)
=>
A rook and a queen are lined up
value ← value + 5;
brPos.onOff = off AND
(wrPos.position.row = qPos.position.row
OR wrPos.position.col = qPos.position.col)
=>
A rook and a queen are lined up
bonus ← bonus + 5;
ENDCASE;
};
k =>
Bias against moving the king, except via castle
IF move.note.kind = castle
THEN bonus ← bonus + 60
We like to castle
ELSE bonus ← bonus - 20;
But we don't really want to move the king
ENDCASE;
};
}
ELSE {
At higher levels we try to be more approximate, which is faster.
IF flags.check THEN {
bonus ← bonus + 50;
IF (quit ← CheckMate[state]) THEN value ← kW;
forceEntry ← TRUE;
};
WITH move.note SELECT FROM
castle: castle SpecialEffects => bonus ← bonus + 40;
rem: remove SpecialEffects => {
vp: Piece ← rem.victim.piece;
va: Piece ← IF vp IN Pawn THEN state.aliases[other][vp] ELSE vp;
vc: NAT ← materialWeights[va];
SELECT vc FROM
< myWeight => bonus ← bonus - 20;
> myWeight => bonus ← bonus + 20;
ENDCASE;
flags.taking ← TRUE;
};
ENDCASE;
};
UnMakeMove[state];
value ← value + bonus;
WHILE pos > 0 DO
np: NAT ← pos - 1;
IF value <= goodValues[np] THEN EXIT;
pos ← np;
ENDLOOP;
IF pos < fanOut OR (forceEntry AND pos < fanOut+4) THEN {
We can add a new move
IF goodMovesMax < fanOut OR flags.check OR goodFlags[goodMovesMax-1].check THEN
We don't even have to force out an old one (note that we add an extra entry beyond the fanout if we are trying to add or force out a check).
IF goodMovesMax+1 < MaxFanOut THEN goodMovesMax ← goodMovesMax + 1;
FOR j: NAT DECREASING IN (pos..goodMovesMax) DO
Shift all of the moves up by one to make room for the new move in its appropriate slot
goodValues[j] ← goodValues[j-1];
goodBonus[j] ← goodBonus[j-1];
goodMoves[j] ← goodMoves[j-1];
goodFlags[j] ← goodFlags[j-1];
ENDLOOP;
goodMoves[pos] ← move;
goodValues[pos] ← value;
goodBonus[pos] ← bonus;
goodFlags[pos] ← flags;
IF goodMovesMax-1 > fanOut AND NOT goodFlags[fanOut].check THEN {
Splice out a non-check move beyond the fanOut to keep our examinations down
FOR j: NAT IN (fanOut..goodMovesMax) DO
goodValues[j-1] ← goodValues[j];
goodBonus[j-1] ← goodBonus[j];
goodMoves[j-1] ← goodMoves[j];
goodFlags[j-1] ← goodFlags[j];
ENDLOOP;
goodMovesMax ← goodMovesMax-1;
};
};
EXITS absoluteBest => {
We have a mate, so forget all of the other moves.
UnMakeMove[state];
dMove ← move;
maxMoves ← 1;
val ← kW;
quit ← foundMate ← TRUE;
};
};
};
ProposeLegalMove[piece, color, state, pass1];
};
ENDLOOP;
};
IF foundMate THEN RETURN;
This is a quick stop for finding a mate
IF goodMovesMax = 0 THEN {
There were no legal moves, so we are either checkmated or drawn
SELECT TRUE FROM
state.inCheck[color] =>
val ← history.current - kW;
In checkmate, but adjust value to prefer later checkmate
val < -400 => val ← kW;
We are behind, but we can draw
ENDCASE => val ← -val;
The negative of the value is the worth of the draw
dMove ← move;
RETURN;
};
FOR i: [0..MaxFanOut) IN [0..goodMovesMax) DO
move: Move ← goodMoves[i];
flags: MoveFlags ← goodFlags[i];
bonus: INTEGER ← goodBonus[i];
IF data.stopRequested THEN ERROR StopRequest;
IF MakeMove[state, move] THEN {
ENABLE UNWIND => UnMakeMove[state];
value: INTEGER ← goodValues[i];
current: NAT ← history.current;
IF current IN [triggerLo..triggerHi] THEN {
debug ← debug + 1;
IF data.displayMoves THEN {
UpdateViewer[data, FALSE];
Process.Pause[Process.MsecToTicks[500]];
};
};
SELECT TRUE FROM
value >= kW => {
We have a mate, guaranteed!
value ← value;
};
value < minValue AND level = 0 => {
Things are getting bad, so don't pursue this course any deeper
value ← value;
};
current > 2 AND level # 0 => {
We have a ways to go before getting out of our depth
value ← -driver[level-1, MAX[fanOut-1, 2]].val;
};
current < maxLevel AND (flags.taking OR flags.check OR wasInCheck) => {
We are going to take a piece or place him in check, so check it out pretty closely.
value ← -driver[0, MAX[fanOut-1, 2]].val;
};
current > 6 => {
Try to downgrade for repetition.
myLast: Move ← history[current-5];
IF myLast.piece = move.piece AND myLast.to = move.to AND myLast.from = move.from THEN value ← value - 50;
};
ENDCASE => {
Other cases.
value ← value;
};
IF current IN [triggerLo..triggerHi] THEN
debug ← debug + 1;
maxMoves ← maxMoves + 1;
value ← value + bonus;
IF maxMoves = 1 OR value > val THEN {
val ← value;
dMove ← move;
bestIndex ← i;
};
lastValue ← value;
UnMakeMove[state];
};
ENDLOOP;
IF history.current IN [triggerLo..triggerHi] THEN
Debug point after choice has been made
debug ← debug + 1;
};
baseLevel: NAT ← data.state.history.current;
maxLevel: NAT ← baseLevel+level+depthCutoff;
triggerLo: NAT ← baseLevel+1;
triggerHi: NAT ← baseLevel+debugLevel;
debug: INT ← 0;
move: Move;
count: NAT ← 0;
minValue: INTEGER ← -1;
[dMove: move, maxMoves: count] ← driver[level, defaultFanOut, TRUE
! StopRequest => CONTINUE];
IF count # 0 THEN RETURN [LIST[move]] ELSE RETURN [NIL];
};
Paint, Notify & Menu procedures
PaintWatcher: PROC [data: MyData, viewer: ViewerClasses.Viewer] = {
WaitForPaint: ENTRY PROC [data: MyData] RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
DO
IF data.quit THEN RETURN [TRUE];
IF data.paintRequested THEN RETURN [FALSE];
WAIT data.paintCond;
ENDLOOP;
};
ShowPaintDone: ENTRY PROC [data: MyData] = {
data.paintRequested ← FALSE;
BROADCAST data.paintCond;
};
DO
IF WaitForPaint[data] THEN EXIT;
ViewerOps.PaintViewer[viewer, client, FALSE, $Update];
ShowPaintDone[data];
ENDLOOP;
};
PaintMe: ViewerClasses.PaintProc = {
[self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ← FALSE]
WITH self.data SELECT FROM
data: MyData => {
DrawPosition: PROC [position: Position, cPiece: ColoredPiece] = {
char: CHAR ← 'P;
color: REAL ← 0.0;
alias: Piece ← cPiece.piece;
IF cPiece.color # none AND alias IN Pawn THEN
alias ← state.aliases[cPiece.color][alias];
SELECT alias FROM
bn, wn => char ← 'N;
bb, wb => char ← 'B;
br, wr => char ← 'R;
q => char ← 'Q;
k => char ← 'K;
ENDCASE;
SELECT cPiece.color FROM
white => color ← 0.0;
black => color ← 1.0;
ENDCASE => char ← 0C;
DrawSquare[position, char, color];
};
DrawSquare: PROC [position: Position, char: CHAR, color: REAL] = {
localX: NAT ← position.col*squareSize;
localY: NAT ← position.row*squareSize;
background: ImagerColor.Color ←
IF (((position.col MOD 2) + (position.row MOD 2)) MOD 2) = 0
THEN blackBackground ELSE whiteBackground;
quarter: NAT ← squareSize/4;
half: NAT ← squareSize/2;
IF inverted THEN {
Our user wants the black squares on the bottom
localY ← (7-position.row)*squareSize;
localX ← (7-position.col)*squareSize;
};
Imager.SetColor[context, background];
Imager.MaskRectangleI[context, localX, localY, squareSize, squareSize];
IF char # 0C THEN {
extents: ImagerFont.Extents ← ImagerFont.BoundingBox[data.letterFont, [0, ORD[char]]];
width: REAL ← extents.rightExtent - extents.leftExtent;
height: REAL ← extents.ascent;
Imager.SetGray[context, color];
localY ← localY + letterOffset;
Imager.SetXY[context, [localX+half-width*0.5, localY+half-height*0.5]];
Imager.SetFont[context, data.letterFont];
Imager.ShowChar[context, char];
};
};
DoFlashing: PROC [newColor: PieceColor] = {
IF data.flashRequested # 0 THEN
FOR i: NAT IN [0..data.flashRequested*2] DO
FOR pos: BoardIndex IN BoardIndex DO
old: ColoredPiece ← data.lastShown[pos];
new: ColoredPiece ← sample[pos];
IF old # new THEN
IF newColor = new.color THEN {
IF i MOD 2 = 0
THEN DrawPosition[ [index[pos]], new]
ELSE DrawPosition[ [index[pos]], old ];
};
ENDLOOP;
Process.Pause[Process.MsecToTicks[100]];
ENDLOOP;
};
sample: Board ← SampleBoard[data];
inverted: BOOL ← data.invertDisplay;
stackValid: BOOL ← data.stackValid;
state: GameState ← data.state;
toMove: WhiteBlack ← state.toMove;
myHeight: INTEGER ← self.ch-ViewerSpecs.menuHeight;
IF NOT data.screenValid THEN whatChanged ← NIL;
Imager.TranslateT[context, [baseX, MAX[myHeight-(baseY + 8*squareSize), 0] + baseY]];
SELECT whatChanged FROM
$Update => {
DoFlashing[none];
DoFlashing[OtherColor[toMove]];
FOR pos: BoardIndex IN BoardIndex DO
old: ColoredPiece ← data.lastShown[pos];
new: ColoredPiece ← sample[pos];
IF old # new THEN
DrawPosition[ [index[pos]], new ];
ENDLOOP;
};
ENDCASE => {
stackValid ← FALSE;
FOR pos: BoardIndex IN BoardIndex DO
DrawPosition[ [index[pos]], sample[pos]];
ENDLOOP;
};
data.flashRequested ← 0;
IF NOT stackValid THEN {
inner: PROC = {
Imager.TranslateT[context, [8*squareSize+baseY, 5*squareSize]];
Imager.ScaleT[context, smallScale];
IF data.stack = NIL
THEN {
Erase the stacked state display
Imager.SetGray[context, 0.0];
Imager.MaskRectangleI[context, 0, 0, squareSize*8, squareSize*8];
}
ELSE {
Draw the stacked state (reduced)
state ← data.stack.first;
FOR pos: BoardIndex IN BoardIndex DO
DrawPosition[ [index[pos]], sample[pos]];
ENDLOOP;
state ← data.state;
};
};
Imager.DoSaveAll[context, inner];
data.stackValid ← TRUE;
};
{
Attempt to show the current value
localX: INTEGER ← 8*squareSize+8;
localY: INTEGER ← 8;
moves: NAT ← data.state.history.current;
toMove: ROPEIF data.state.toMove = white THEN "white" ELSE "black";
Imager.SetGray[context, 0.0];
Imager.MaskRectangleI[context, localX, localY, textWidth, textHeight*5];
Imager.SetGray[context, 1.0];
Imager.SetFont[context, data.textFont];
IF data.message2 # NIL THEN {
Imager.SetXY[context, [localX, localY+textHeight*0]];
Imager.ShowRope[context, data.message2];
data.message2 ← NIL;
};
Imager.SetXY[context, [localX, localY+textHeight*1]];
Imager.ShowRope[context, IO.PutFR1["move: %g", [integer[(data.state.history.current/2)+1 ]]]];
Imager.SetXY[context, [localX, localY+textHeight*2]];
Imager.ShowRope[context, IO.PutFR1["to move: %g", [rope[toMove]]]];
IF data.message1 # NIL THEN {
Imager.SetXY[context, [localX, localY+textHeight*3]];
Imager.ShowRope[context, data.message1];
};
};
data.lastShown ← sample;
data.screenValid ← TRUE;
};
ENDCASE;
};
NotifyMe: ViewerClasses.NotifyProc = {
[self: ViewerClasses.Viewer, input: LIST OF REF ANY]
WITH self.data SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
which: ATOM;
x: INTEGER ← 0;
y: INTEGER ← 0;
inverted: BOOL ← data.invertDisplay;
FOR each: LORA ← input, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
atom: ATOM => which ← atom;
coords: TIPUser.TIPScreenCoords => {
x ← coords.mouseX;
y ← coords.mouseY;
};
ENDCASE;
ENDLOOP;
SELECT which FROM
$Select, $Move => {
myHeight: INTEGER ← self.ch-ViewerSpecs.menuHeight;
xLo: INTEGER ← baseX;
xHi: INTEGER ← xLo+8*squareSize;
yLo: INTEGER ← baseY+MAX[myHeight-(baseY + 8*squareSize), 0];
yHi: INTEGER ← yLo+8*squareSize;
new: FullPosition ← [on, [index[0]]];
old: FullPosition ← data.selected;
data.selected ← [off, [index[0]]];
IF x IN [xLo..xHi) AND y IN [yLo..yHi) THEN {
state: GameState ← data.state;
new.position.row ← (y-yLo) / squareSize;
new.position.col ← (x-xLo) / squareSize;
IF inverted THEN {
new.position.row ← 7 - new.position.row;
new.position.col ← 7 - new.position.col;
};
SELECT which FROM
$Select =>
IF state.board[new.position.index].color = state.toMove THEN
data.selected ← new;
$Move => IF old.onOff = on THEN {
movePiece: ColoredPiece ← state.board[old.position.index];
color: WhiteBlack ← state.toMove;
IF old # new AND movePiece.color = color THEN {
taken: ColoredPiece ← state.board[new.position.index];
effects: SpecialEffects ← IF taken.color # none THEN [remove[taken, new.position]] ELSE [none[]];
pMove: Move ← [movePiece, old.position, new.position, p0, effects];
last: NAT ← state.history.last;
legal: BOOLFALSE;
CheckLegal: MoveAction = {
SELECT TRUE FROM
pMove.piece # move.piece => GO TO bogus;
pMove.from # move.from => GO TO bogus;
pMove.to # move.to => GO TO bogus;
pMove.note.kind # move.note.kind => GO TO bogus;
ENDCASE => legal ← TRUE;
EXITS bogus => {};
};
alias: Piece ← movePiece.piece;
IF alias IN Pawn THEN alias ← state.aliases[color][alias];
SELECT alias FROM
IN Pawn => {
IF pMove.from.row = pMove.to.row AND ABS[pMove.from.col- pMove.to.col] = 1 THEN {
Trying for en passant capture, so modify the pMove a little
taken ← state.board[pMove.to.index];
SELECT pMove.from.row FROM
3 => pMove.to.row ← 2;
4 => pMove.to.row ← 5;
ENDCASE;
};
};
k => {
IF pMove.from.col = 4 AND ABS[pMove.from.col- pMove.to.col] = 2 AND pMove.from.row = pMove.to.row THEN {
Trying for castle, so check the legality
side: Side ← IF pMove.to.col = 2 THEN queen ELSE king;
ok: BOOL;
[ok, pMove] ← CheckCastle[data.state, side];
IF NOT ok THEN GO TO bailOut;
};
};
ENDCASE;
ProposeLegalMove[movePiece.piece, color, state, CheckLegal];
IF legal THEN {
data.message1 ← NIL;
IF NOT MakeMove[state, pMove] THEN GO TO bailOut;
data.flashRequested ← 2;
last ← state.history.current;
state.history.last ← last;
UpdateViewer[data];
};
EXITS bailOut => {};
};
};
ENDCASE;
};
};
ENDCASE;
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
};
DestroyMe: ViewerClasses.DestroyProc = {
[self: ViewerClasses.Viewer]
IF self # NIL THEN {
WITH self.data SELECT FROM
data: MyData => {
DropDead: ENTRY PROC [data: MyData] = {
data.stopRequested ← TRUE;
data.paintRequested ← TRUE;
data.quit ← TRUE;
BROADCAST data.paintCond;
};
DropDead[data];
};
ENDCASE;
};
};
StopButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer => {
WITH clientData SELECT FROM
data: MyData => data.stopRequested ← TRUE;
ENDCASE;
};
ENDCASE;
};
ResetButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer => {
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
history: MoveHistory ← data.state.history;
current: NAT ← history.current;
last: NAT ← history.last;
NewBoard[data, history];
history.last ← last;
UpdateViewer[data];
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
};
ENDCASE;
};
RefreshButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer => {
WITH clientData SELECT FROM
data: MyData =>
IF MakeBusy[data]
THEN {
UpdateViewer[data];
[] ← MakeBusy[data, FALSE];
}
ELSE
UpdateViewer[data, FALSE];
ENDCASE;
};
ENDCASE;
};
ReplayButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer => {
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
history: MoveHistory ← data.state.history;
current: NAT ← history.current;
last: NAT ← history.last;
pause: NATIF shift THEN 1000 ELSE 500;
IF control THEN pause ← pause*4;
NewBoard[data, history];
UpdateViewer[data, FALSE];
Make moves slowly
FOR i: NAT IN [0..current) DO
play: MoveList ← LIST[history[i]];
Process.Pause[Process.MsecToTicks[pause]];
MakeMoves[data, play, viewer];
IF data.stopRequested THEN EXIT;
ENDLOOP;
history.last ← last;
IF last = current THEN [] ← MakeBusy[data, FALSE];
};
ENDCASE;
};
ENDCASE;
};
StepButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
history: MoveHistory ← data.state.history;
current: NAT ← history.current;
last: NAT ← history.last;
data.message1 ← NIL;
IF mouseButton = red
THEN {
UnMakeMove[data.state];
UpdateViewer[data, FALSE];
}
ELSE {
IF current < last THEN {
[] ← MakeMove[data.state, history[current]];
UpdateViewer[data];
};
};
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
StackButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
state: GameState ← data.state;
stack: GameStateList ← data.stack;
history: MoveHistory ← state.history;
IF mouseButton = red
THEN {
Push the current game state
current: NAT ← history.current;
IF current > 0 THEN {
NewBoard[data];
data.stack ← CONS[state, stack];
FOR i: NAT IN [0..current) DO
[] ← MakeMove[data.state, history[i]];
ENDLOOP;
FOR i: NAT IN [current..history.last) DO
data.state.history[i] ← history[i];
ENDLOOP;
data.state.history.last ← history.last;
};
}
ELSE {
Pop the current game state
stack: GameStateList ← data.stack;
IF stack # NIL THEN {data.state ← stack.first; data.stack ← stack.rest};
};
data.stackValid ← FALSE;
data.message1 ← NIL;
UpdateViewer[data];
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
AutoButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
level: NAT ← playLevel;
moves: MoveList;
old: CedarProcess.Priority ← CedarProcess.GetPriority[];
data.displayMoves ← shift;
SELECT mouseButton FROM
red => {};
yellow => level ← level + 1;
blue => level ← level + 2;
ENDCASE;
DO
pulses: BasicTime.Pulses ← BasicTime.GetClockPulses[];
seconds: REAL;
CedarProcess.SetPriority[background];
moves ← AutoMove[data, level];
CedarProcess.SetPriority[old];
data.displayMoves ← FALSE;
SELECT TRUE FROM
data.stopRequested => data.message1 ← "stopped";
data.state.inCheck[data.state.toMove] => data.message1 ← NIL;
moves = NIL => data.message1 ← "STALEMATE";
ENDCASE => data.message1 ← NIL;
data.state.history.last ← data.state.history.current;
seconds ← BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - pulses];
data.message2 ← IO.PutFR1[
IF seconds <= 99.9 THEN "seconds: %4.1f" ELSE "seconds: %5.0f",
[real[seconds]]];
IF moves = NIL
THEN {
UpdateViewer[data];
}
ELSE {
data.flashRequested ← 3;
MakeMoves[data, moves, viewer];
};
IF moves = NIL OR NOT control OR data.stopRequested THEN EXIT;
ENDLOOP;
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
InvertButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
data.invertDisplay ← NOT data.invertDisplay;
data.screenValid ← FALSE;
UpdateViewer[data];
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
DumpButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
{
ENABLE FS.Error => {
MessageWindow.Append[error.explanation, TRUE];
GO TO failed;
};
name: ROPE ← NameFromSelection[data];
out: STREAMFS.StreamOpen[fileName: name, accessOptions: $create, keep: 2];
MessageWindow.Append[Rope.Concat["Dumping game to ", name], TRUE];
DumpState[data, out];
IO.Close[out];
EXITS failed => {};
};
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
LoadButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent SELECT FROM
viewer: ViewerClasses.Viewer =>
WITH clientData SELECT FROM
data: MyData => IF MakeBusy[data] THEN {
state: GameState ← data.state;
{
ENABLE FS.Error => {
MessageWindow.Append[error.explanation, TRUE];
GO TO failed;
};
name: ROPE ← NameFromSelection[data];
in: STREAMFS.StreamOpen[name];
MessageWindow.Append[Rope.Concat["Loading game from ", name], TRUE];
IF NOT LoadState[data, in] THEN {
MessageWindow.Append[Rope.Concat["Load failed from ", name], TRUE];
data.state ← state;
};
IO.Close[in];
EXITS failed => {};
};
UpdateViewer[data];
[] ← MakeBusy[data, FALSE];
};
ENDCASE;
ENDCASE;
};
Utility procedures
NameFromSelection: PROC [data: MyData] RETURNS [ROPE] = {
name: ROPENIL;
len: INT;
dot: INT;
name ← ViewerTools.GetSelectionContents[
! RuntimeError.UNCAUGHT => CONTINUE];
IF Rope.Length[name] < 2 THEN name ← "Dump$";
len ← dot ← Rope.Length[name];
FOR i: INT DECREASING IN [0..len) DO
SELECT Rope.Fetch[name, i] FROM
'. => {dot ← i; EXIT};
'>, '/, '] => EXIT;
ENDCASE;
ENDLOOP;
IF dot = len THEN name ← Rope.Concat[name, ".chess"];
SELECT Rope.Fetch[name, 0] FROM
'[, '/ => name ← FS.ExpandName[name, NIL].fullFName;
ENDCASE => name ← FS.ExpandName[name, data.wd].fullFName;
RETURN [name];
};
DumpState: PROC [data: MyData, out: STREAM] = {
state: GameState ← data.state;
history: MoveHistory ← state.history;
IO.PutF1[out, "\n-- game dumped on %g", [time[BasicTime.Now[]]]];
FOR i: NAT IN [0..history.last) DO
move: Move ← history[i];
enPassant: BOOLFALSE;
IO.PutRope[out, IF i MOD 2 = 0 THEN "\n " ELSE " "];
IO.PutF[out, "%g%g", [cardinal[move.to.row]], [cardinal[move.to.col]] ];
SELECT move.note.kind FROM
none => IO.PutChar[out, '←];
castle => IO.PutChar[out, '&];
remove => IO.PutChar[out, 'x];
ENDCASE;
IO.PutF[out, "%g%g", [cardinal[move.from.row]], [cardinal[move.from.col]] ];
WITH move.note SELECT FROM
rem: remove SpecialEffects => {
IF move.to # rem.from THEN
Special case, like en passant
IO.PutF[out, "r%g%g", [cardinal[rem.from.row]], [cardinal[rem.from.col]] ];
};
ENDCASE;
ENDLOOP;
IO.PutF1[out, "\nCurrent %g \n\n", [cardinal[history.current]] ];
};
LoadState: PROC [data: MyData, in: STREAM] RETURNS [ok: BOOL ← TRUE] = {
state: GameState;
current: NAT ← 0;
buffer: REF TEXTNEW[TEXT[100]];
NewBoard[data];
Get an initialized board
state ← data.state;
{
ENABLE IO.EndOfStream, IO.Error => GO TO bomb;
ParseMove: PROC = {
to: Position;
from: Position;
piece: ColoredPiece;
to.row ← buffer[0]-'0;
to.col ← buffer[1]-'0;
from.row ← buffer[3]-'0;
from.col ← buffer[4]-'0;
piece ← state.board[from.index];
SELECT buffer[2] FROM
'← => {
A simple move, nothing more to do
[] ← MakeMove[state, [piece: piece, from: from, to: to]];
};
'& => {
A castle, either king or queen side
side: Side ← SELECT to.col FROM 6 => king, 2 => queen, ENDCASE => ERROR;
[] ← MakeMove[state, [piece: piece, from: from, to: to, note: [castle[side]]]];
};
'x, 'X => {
We are actually taking something
rfrom: Position ← to;
IF buffer.length > 5 THEN {
A funny remove, as in en passant
SELECT buffer[5] FROM
'r, 'R => {
rfrom.row ← buffer[6]-'0;
rfrom.col ← buffer[7]-'0;
};
ENDCASE;
};
[] ← MakeMove[state, [piece: piece, from: from, to: to, note: [remove[state.board[rfrom.index], rfrom]]]];
};
ENDCASE;
};
DO
[] ← IO.SkipWhitespace[in];
skip spaces & comments
buffer ← IO.GetToken[in, IO.IDProc, buffer].token;
Get a move (it is a single token)
IF buffer.length = 0 OR buffer[0] NOT IN ['0..'7] THEN EXIT;
ParseMove[
! IO.EndOfStream => EXIT; RuntimeError.UNCAUGHT => GO TO bomb
];
ENDLOOP;
current ← IO.GetInt[in];
WHILE state.history.current > current DO UnMakeMove[state]; ENDLOOP;
};
EXITS bomb => ok ← FALSE;
};
MakeMoves: PROC [data: MyData, moves: MoveList, viewer: ViewerClasses.Viewer] = {
FOR each: MoveList ← moves, each.rest WHILE each # NIL DO
color: PieceColor ← data.state.toMove;
IF NOT MakeMove[data.state, each.first] THEN EXIT;
ENDLOOP;
data.state.history.last ← data.state.history.current;
data.message1 ← NIL;
UpdateViewer[data];
};
UpdateViewer: ENTRY PROC [data: MyData, mateCheck: BOOLTRUE, waitForDone: BOOLTRUE] = {
state: GameState ← data.state;
data.paintRequested ← TRUE;
data.paintBoard ← state.board;
IF data.message1 = NIL THEN
IF state.inCheck[state.toMove] THEN
IF mateCheck AND state.history.current = state.history.last AND CheckMate[data.state]
THEN data.message1 ← "CHECKMATE"
ELSE data.message1 ← "check";
BROADCAST data.paintCond;
WHILE waitForDone AND data.paintRequested AND NOT data.quit DO
WAIT data.paintCond;
ENDLOOP;
};
SampleBoard: ENTRY PROC [data: MyData] RETURNS [Board] = {
RETURN [data.paintBoard];
};
MakeBusy: ENTRY PROC [data: MyData, busy: BOOLTRUE] RETURNS [BOOL] = {
Used to lock out input due to multiple input events. Input events are ignored if we are busy.
IF busy AND data.busy THEN RETURN [FALSE];
data.busy ← busy;
data.stopRequested ← FALSE;
RETURN [TRUE];
};
NewBoard: PROC [data: MyData, oldHistory: MoveHistory ← NIL] = {
state: GameState ← data.state ← NEW[GameStateRep ← [
coverage: [NEW[CoverageRep], NEW[CoverageRep]],
positions: [NEW[PositionsRep], NEW[PositionsRep]],
aliases: [NEW[AliasesRep], NEW[AliasesRep]]
]];
material: NAT ← 0;
data.message1 ← NIL;
state.aliases[white]^ ← [p0, p1, p2, p3, p4, p5, p6, p7];
state.aliases[black]^ ← [p0, p1, p2, p3, p4, p5, p6, p7];
IF oldHistory = NIL
THEN {
state.history ← NEW[MoveHistoryRep[maxHistoryLen]];
state.history.current ← state.history.last ← 0;
}
ELSE {
state.history ← oldHistory;
oldHistory.current ← 0;
};
RenewPositions[data.state];
data.selected ← [off, [index[0]] ];
FOR piece: Piece IN Piece DO
Do this dynamically to allow experimentation with weights
material ← material + materialWeights[piece];
ENDLOOP;
state.material[black] ← state.material[white] ← material;
data.paintBoard ← state.board;
};
RenewPositions: PROC [state: GameState] = {
state.positions[white]^ ← ALL[ [off, [index[0]]] ];
state.positions[black]^ ← ALL[ [off, [index[0]]] ];
FOR index: BoardIndex IN BoardIndex DO
cPiece: ColoredPiece ← state.board[index];
IF cPiece.color # none THEN
state.positions[cPiece.color][cPiece.piece] ← [on, [index[index]]];
ENDLOOP;
};
Moving stuff
MakeMove: PROC [state: GameState, move: Move, check: BOOLTRUE] RETURNS [legal: BOOLTRUE] = {
history: MoveHistory ← state.history;
current: NAT ← history.current;
last: NAT ← history.last;
moving: ColoredPiece ← move.piece;
color: WhiteBlack ← moving.color;
other: WhiteBlack ← OtherColor[color];
alias: Piece ← moving.piece;
move.material ← state.material[color];
move.wasCheck ← state.inCheck;
IF alias IN Pawn THEN {
alias ← state.aliases[color][alias];
SELECT move.to.row FROM
0, 7 => IF alias IN Pawn THEN {
alias ← move.alias ← q;
state.aliases[color][moving.piece] ← alias ← move.alias ← q;
state.material[color] ← state.material[color] + (materialWeights[alias]-materialWeights[moving.piece]);
};
ENDCASE;
};
WITH move.note SELECT FROM
castle: castle SpecialEffects => {
row: [0..8) ← IF color = white THEN 0 ELSE 7;
oldRookPos: Position ← [rowCol[row, IF castle.side = king THEN 7 ELSE 0]];
newRookPos: Position ← [rowCol[row, IF castle.side = king THEN 5 ELSE 3]];
rook: ColoredPiece ← state.board[oldRookPos.index];
state.positions[color][rook.piece] ← [on, newRookPos];
state.board[oldRookPos.index] ← [none, p0];
state.board[newRookPos.index] ← rook;
};
remove: remove SpecialEffects => {
vc: WhiteBlack ← remove.victim.color;
vp: Piece ← remove.victim.piece;
va: Piece ← vp;
IF va IN Pawn THEN va ← state.aliases[vc][va];
state.positions[vc][vp] ← [off, [index[0]]];
state.board[remove.from.index] ← [none, p0];
state.material[vc] ← state.material[vc] - materialWeights[va];
};
ENDCASE;
state.positions[moving.color][moving.piece] ← [on, move.to];
state.board[move.from.index] ← [none, p0];
state.board[move.to.index] ← moving;
state.toMove ← IF color = white THEN black ELSE white;
history[current] ← move;
history.current ← current ← current + 1;
IF last < current THEN history.last ← current;
IF check THEN {
legal ← CoveredWeight[state, other, state.positions[color][k].position, TRUE] = 0;
IF NOT legal THEN {UnMakeMove[state]; history.last ← last; RETURN [FALSE]};
state.inCheck ← [
IF color = white THEN NOT legal ELSE CoveredWeight[state, black, state.positions[white][k].position, TRUE] # 0,
IF color = black THEN NOT legal ELSE CoveredWeight[state, white, state.positions[black][k].position, TRUE] # 0
];
};
RETURN [TRUE];
};
UnMakeMove: PROC [state: GameState] = {
history: MoveHistory ← state.history;
current: NAT ← history.current;
IF current > 0 THEN {
move: Move ← history[history.current ← current-1];
moving: ColoredPiece ← move.piece;
color: WhiteBlack ← moving.color;
state.positions[moving.color][moving.piece] ← [on, move.from];
state.board[move.to.index] ← [none, p0];
state.board[move.from.index] ← moving;
state.toMove ← color;
IF moving.piece IN Pawn AND move.alias # p0 THEN
state.aliases[color][moving.piece] ← moving.piece;
WITH move.note SELECT FROM
castle: castle SpecialEffects => {
row: [0..8) ← IF color = white THEN 0 ELSE 7;
oldRookPos: Position ← [rowCol[row, IF castle.side = king THEN 7 ELSE 0]];
newRookPos: Position ← [rowCol[row, IF castle.side = king THEN 5 ELSE 3]];
rook: ColoredPiece ← state.board[newRookPos.index];
state.positions[color][rook.piece] ← [on, oldRookPos];
state.board[newRookPos.index] ← [none, p0];
state.board[oldRookPos.index] ← rook;
};
remove: remove SpecialEffects => {
vc: WhiteBlack ← remove.victim.color;
vp: Piece ← remove.victim.piece;
va: Piece ← vp;
IF va IN Pawn THEN va ← state.aliases[vc][va];
state.positions[vc][vp] ← [on, remove.from];
state.board[remove.from.index] ← remove.victim;
state.material[vc] ← state.material[vc] + materialWeights[va];
};
ENDCASE;
state.material[color] ← move.material;
state.inCheck ← move.wasCheck;
};
};
PositionEvaluate: PROC [state: GameState, checkWeight: INTEGER] RETURNS [value: INTEGER ← 0] = INLINE {
other: WhiteBlack ← state.toMove;
color: WhiteBlack ← OtherColor[other];
value ← state.material[color] - state.material[other];
IF state.inCheck[other] THEN value ← value + checkWeight;
};
CheckCastle: PROC [state: GameState, side: Side] RETURNS [ok: BOOLFALSE, move: Move] = {
color: WhiteBlack ← state.toMove;
other: WhiteBlack ← OtherColor[color];
row: [0..8) ← IF color = white THEN 0 ELSE 7;
delta: INTEGERIF side = king THEN +1 ELSE -1;
oldKingPos: Position ← [rowCol[row, 4]];
newKingPos: Position ← [rowCol[row, IF side = king THEN 6 ELSE 2]];
oldRookPos: Position ← [rowCol[row, IF side = king THEN 7 ELSE 0]];
newRookPos: Position ← [rowCol[row, IF side = king THEN 5 ELSE 3]];
rook: ColoredPiece ← state.board[oldRookPos.index];
king: ColoredPiece ← state.board[oldKingPos.index];
SELECT TRUE FROM
rook.color # color, king.color # color, king.piece # k, state.inCheck[color] => {};
rook.piece = br, rook.piece = wr => {
Check for interposing pieces
IF side = king
THEN FOR pos: BoardIndex IN (oldKingPos.index..oldRookPos.index) DO
IF state.board[pos].color # none THEN GO TO nope;
ENDLOOP
ELSE FOR pos: BoardIndex IN (oldRookPos.index..oldKingPos.index) DO
IF state.board[pos].color # none THEN GO TO nope;
ENDLOOP;
Check for previous king or rook move
FOR i: NAT IN [0..state.history.current) DO
move: Move ← state.history[i];
IF move.piece.color = color THEN
SELECT move.piece.piece FROM
k, rook.piece => GO TO nope;
ENDCASE;
ENDLOOP;
Check for moving through check
SELECT TRUE FROM
CoveredWeight[state, other, newKingPos, TRUE] # 0 => GO TO nope;
CoveredWeight[state, other, newRookPos, TRUE] # 0 => GO TO nope;
ENDCASE;
RETURN [TRUE, [king, oldKingPos, newKingPos, p0, [castle[side]] ]];
EXITS nope => {};
};
ENDCASE;
};
CheckMate: PROC [state: ChessDefs.GameState] RETURNS [mated: BOOLFALSE] = {
color: WhiteBlack ← state.toMove;
IF state.inCheck[color] THEN {
We could be in big trouble!
testMate: MoveAction = {
IF MakeMove[state, move] THEN {
quit ← TRUE;
mated ← FALSE;
UnMakeMove[state];
};
};
mated ← TRUE;
FOR piece: Piece IN Piece WHILE mated DO
fPos: FullPosition ← state.positions[color][piece];
IF fPos.onOff # off THEN
ProposeLegalMove[piece, color, state, testMate];
ENDLOOP;
};
};
nullCoverageEntry: SquareCoverage ← ALL[FALSE];
MoveAction: TYPE = PROC [state: ChessDefs.GameState, move: ChessDefs.Move] RETURNS [quit: BOOLFALSE];
ProposeLegalMove: PROC [piece: Piece, color: WhiteBlack, state: GameState, action: MoveAction, captureOnly: BOOLFALSE] = {
This routine proposes legal moves, except that it does not check for moves that place the king in check. It can also propose only captuing moves, which is used in determining if the king really is in check.
myColor: PieceColor ← color;
myPiece: ColoredPiece ← [myColor, piece];
other: PieceColor ← IF myColor = white THEN black ELSE white;
forwards: INTEGERIF myColor = white THEN 1 ELSE -1;
backwards: INTEGER ← -forwards;
fullPos: FullPosition;
curPos: Position;
alias: Piece ← piece;
currentRow: [0..8);
currentCol: [0..8);
quit: BOOLFALSE;
Propose: PROC [dRow, dCol: INTEGER] RETURNS [final: BOOLFALSE] = {
Propose a non-pawn move (no aliasing)
IF NOT quit THEN {
oPos: Position ← [rowCol[row: currentRow, col: currentCol]];
nPos: Position ← [rowCol[row: dRow+currentRow, col: dCol+currentCol]];
cPiece: ColoredPiece ← state.board[nPos.index];
SELECT cPiece.color FROM
none => {
It is possible to move, so propose such a move, then continue
IF NOT captureOnly THEN quit ← action[state, [myPiece, oPos, nPos] ];
RETURN [quit];
};
other =>
It is possible to capture, so propose such a move, then EXIT
quit ← action[state, [myPiece, oPos, nPos, p0, [remove[victim: cPiece, from: nPos]]]];
ENDCASE;
};
RETURN [TRUE];
};
ProposePawn: PROC [dRow, dCol: INTEGER] RETURNS [final: BOOLFALSE] = {
Propose a pawn move (aliasing possible)
IF NOT quit THEN {
nRow: [0..8) ← dRow+currentRow;
nCol: [0..8) ← dCol+currentCol;
oPos: Position ← [rowCol[row: currentRow, col: currentCol]];
nPos: Position ← [rowCol[row: nRow, col: nCol]];
cPiece: ColoredPiece ← state.board[nPos.index];
alias: Piece ← p0;
IF myPiece.piece IN Pawn THEN IF nRow = 0 OR nRow = 7 THEN alias ← q;
SELECT cPiece.color FROM
none => {
It is possible to move, so propose such a move, then continue
IF NOT captureOnly THEN quit ← action[state, [myPiece, oPos, nPos, alias] ];
RETURN [quit];
};
other =>
It is possible to capture, so propose such a move, then EXIT
quit ← action[state, [myPiece, oPos, nPos, alias, [remove[victim: cPiece, from: nPos]]]];
ENDCASE;
};
RETURN [TRUE];
};
fullPos ← state.positions[color][piece];
IF fullPos.onOff = off THEN RETURN;
curPos.index ← fullPos.position.index;
IF piece IN Pawn THEN alias ← state.aliases[color][piece];
currentRow ← curPos.row;
currentCol ← curPos.col;
SELECT alias FROM
p0, p1, p2, p3, p4, p5, p6, p7 => {
Pawns
IF currentRow IN (0..7) THEN {
aRow: [0..8) ← IF color = white THEN currentRow ELSE 7-currentRow;
row: [0..8) ← currentRow+forwards;
oPos: Position ← [rowCol[row: currentRow, col: currentCol]];
nPos: Position ← [rowCol[row: row, col: currentCol]];
cPiece: ColoredPiece ← state.board[nPos.index];
IF cPiece.color = none AND NOT captureOnly AND aRow # 7 THEN {
It is possible to move forwards, so propose such a move
IF action[state, [myPiece, oPos, nPos] ] THEN RETURN;
IF aRow = 1 THEN {
It may be possible to move forwards two squares
nPos.row ← row+forwards;
cPiece ← state.board[nPos.index];
IF cPiece.color = none THEN {
It is possible to move forwards two squares, so propose such a move
IF action[state, [myPiece, oPos, nPos] ] THEN RETURN;
IF quit THEN RETURN;
};
nPos.row ← row;
};
};
IF currentCol # 0 THEN {
nPos.col ← currentCol-1;
cPiece ← state.board[nPos.index];
IF cPiece.color = other THEN {
It is possible to capture, so propose such a move
[] ← ProposePawn[forwards, -1];
IF quit THEN RETURN;
};
};
IF currentCol # 7 THEN {
nPos.col ← currentCol+1;
cPiece ← state.board[nPos.index];
IF cPiece.color = other THEN {
It is possible to capture, so propose such a move
[] ← ProposePawn[forwards, 1];
IF quit THEN RETURN;
};
};
IF aRow = 4 AND state.history.current > 0 THEN {
Check for en passant capture.
lastMove: Move ← state.history[state.history.current-1];
p2: ColoredPiece ← lastMove.piece;
a2: Piece ← p2.piece;
IF a2 IN Pawn THEN {
a2 ← state.aliases[other][a2];
IF a2 IN Pawn AND lastMove.to.row = currentRow AND ABS[lastMove.to.row - lastMove.from.row] = 2 THEN {
There was a two-space pawn move onto our row, so check for column
col: INTEGER ← currentCol;
SELECT lastMove.to.col FROM
col+1, col-1 => {
effects: SpecialEffects ← [remove[victim: lastMove.piece, from: lastMove.to]];
IF action[state, [myPiece, curPos, [rowCol[currentRow+forwards, lastMove.to.col]], p0, effects]] THEN RETURN;
IF quit THEN RETURN;
};
ENDCASE;
};
};
};
};
};
br, wr => {
Rooks
FOR delta: INTEGER IN [1..7-currentRow] UNTIL quit OR Propose[delta, 0] DO ENDLOOP;
FOR delta: INTEGER IN [1..currentRow] UNTIL quit OR Propose[-delta, 0] DO ENDLOOP;
FOR delta: INTEGER IN [1..7-currentCol] UNTIL quit OR Propose[0, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..currentCol] UNTIL quit OR Propose[0, -delta] DO ENDLOOP;
};
bb, wb => {
Bishops
FOR delta: INTEGER IN [1..MIN[7-currentRow, 7-currentCol]]
UNTIL quit OR Propose[delta, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[7-currentRow, currentCol]]
UNTIL quit OR Propose[delta, -delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[currentRow, 7-currentCol]]
UNTIL quit OR Propose[-delta, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[currentRow, currentCol]]
UNTIL quit OR Propose[-delta, -delta] DO ENDLOOP;
};
bn, wn => {
kNights
IF currentRow < 7 THEN {
IF currentCol < 6 THEN {[] ← Propose[1, 2]; IF quit THEN RETURN};
IF currentCol > 1 THEN {[] ← Propose[1, -2]; IF quit THEN RETURN};
IF currentRow < 6 THEN {
IF currentCol < 7 THEN {[] ← Propose[2, 1]; IF quit THEN RETURN};
IF currentCol > 0 THEN {[] ← Propose[2, -1]; IF quit THEN RETURN};
};
};
IF currentRow > 0 THEN {
IF currentCol < 6 THEN {[] ← Propose[-1, 2]; IF quit THEN RETURN};
IF currentCol > 1 THEN {[] ← Propose[-1, -2]; IF quit THEN RETURN};
IF currentRow > 1 THEN {
IF currentCol < 7 THEN {[] ← Propose[-2, 1]; IF quit THEN RETURN};
IF currentCol > 0 THEN {[] ← Propose[-2, -1]; IF quit THEN RETURN};
};
};
};
q => {
Queen
Rook-type moves
FOR delta: INTEGER IN [1..7-currentRow] UNTIL quit OR Propose[delta, 0] DO ENDLOOP;
FOR delta: INTEGER IN [1..currentRow] UNTIL quit OR Propose[-delta, 0] DO ENDLOOP;
FOR delta: INTEGER IN [1..7-currentCol] UNTIL quit OR Propose[0, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..currentCol] UNTIL quit OR Propose[0, -delta] DO ENDLOOP;
Bishop-type moves
FOR delta: INTEGER IN [1..MIN[7-currentRow, 7-currentCol]]
UNTIL quit OR Propose[delta, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[7-currentRow, currentCol]]
UNTIL quit OR Propose[delta, -delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[currentRow, 7-currentCol]]
UNTIL quit OR Propose[-delta, delta] DO ENDLOOP;
FOR delta: INTEGER IN [1..MIN[currentRow, currentCol]]
UNTIL quit OR Propose[-delta, -delta] DO ENDLOOP;
};
k => {
King
IF currentRow < 7 THEN {
IF currentCol < 7 THEN {[] ← Propose[1, 1]; IF quit THEN RETURN};
{[] ← Propose[1, 0]; IF quit THEN RETURN};
IF currentCol > 0 THEN {[] ← Propose[1, -1]; IF quit THEN RETURN};
};
IF currentCol < 7 THEN {[] ← Propose[0, 1]; IF quit THEN RETURN};
IF currentCol > 0 THEN {[] ← Propose[0, -1]; IF quit THEN RETURN};
IF currentRow > 0 THEN {
IF currentCol < 7 THEN {[] ← Propose[-1, 1]; IF quit THEN RETURN};
{[] ← Propose[-1, 0]; IF quit THEN RETURN};
IF currentCol > 0 THEN {[] ← Propose[-1, -1]; IF quit THEN RETURN};
};
IF NOT captureOnly AND NOT quit THEN {
IF NOT state.inCheck[color] THEN {
We are not in check so we can try for a castle.
ok: BOOL;
move: Move;
[ok, move] ← CheckCastle[state, king];
IF ok THEN IF action[state, move] THEN RETURN;
[ok, move] ← CheckCastle[state, queen];
IF ok THEN IF action[state, move] THEN RETURN;
};
};
};
ENDCASE => ERROR;
};
CoveredWeight: PROC [state: GameState, color: WhiteBlack, pos: Position, stopOnFirst: BOOLFALSE] RETURNS [totalWeight: INTEGER ← 0] = {
Returns the number of pieces that color has covering the given position. It does not compensate for coverage by pieces pinned by discovered check, which makes this routine useful in determining check.
other: WhiteBlack ← OtherColor[color];
positions: Positions ← state.positions[color];
aliases: Aliases ← state.aliases[color];
FOR piece: Piece IN Piece DO
myPos: FullPosition ← positions[piece];
IF myPos.onOff = on THEN {
alias: Piece ← piece;
kRow: [0..8) ← pos.row;
dRow: INTEGER ← kRow-myPos.position.row;
adr: NATABS[dRow];
kCol: [0..8) ← pos.col;
dCol: INTEGER ← kCol-myPos.position.col;
adc: NATABS[dCol];
IF Basics.BITOR[adc, adr] = 0 THEN GO TO notThisOne;
A piece can never cover itself
IF alias IN Pawn THEN alias ← aliases[alias];
Pawns can be aliased due to reaching the farthest row
SELECT alias FROM
p0, p1, p2, p3, p4, p5, p6, p7 => {
IF adc = 1 AND adr = 1 THEN
IF color = white
THEN {IF dRow = 1 THEN GO TO addCoverage}
ELSE {IF dRow = -1 THEN GO TO addCoverage};
};
wn, bn => {
IF adr+adc = 3 AND adc IN [1..2] THEN GO TO addCoverage;
};
wb, bb => {
SELECT adr FROM
# adc => GO TO notThisOne;
Not on a diagonal, so skip it
1 => GO TO addCoverage;
Fast test for adjacency
ENDCASE => {
stepR: INTEGERIF dRow > 0 THEN -1 ELSE 1;
stepC: INTEGERIF dCol > 0 THEN -1 ELSE 1;
THROUGH (0..adc) DO
pos: Position ← [rowCol[kRow ← kRow + stepR, kCol ← kCol + stepC]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
};
wr, br => {
SELECT TRUE FROM
adc = 0 => IF adr = 1 THEN GO TO addCoverage ELSE {
On a column
r1: [0..8) ← MIN[kRow, myPos.position.row];
FOR r: [0..8) IN (r1..r1+adr) DO
pos: Position ← [rowCol[r, kCol]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
adr = 0 => IF adc = 1 THEN GO TO addCoverage ELSE {
On a row
c1: [0..8) ← MIN[kCol, myPos.position.col];
FOR c: [0..8) IN (c1..c1+adc) DO
pos: Position ← [rowCol[kRow, c]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
ENDCASE;
};
q => {
SELECT adc FROM
adr => {
On a diagonal
stepR: INTEGERIF dRow > 0 THEN -1 ELSE 1;
stepC: INTEGERIF dCol > 0 THEN -1 ELSE 1;
THROUGH (0..adc) DO
pos: Position ← [rowCol[kRow ← kRow + stepR, kCol ← kCol + stepC]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
0 => {
On a column
r1: [0..8) ← MIN[kRow, myPos.position.row];
FOR r: [0..8) IN (r1..r1+adr) DO
pos: Position ← [rowCol[r, kCol]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
ENDCASE => IF adr = 0 THEN {
On a row
c1: [0..8) ← MIN[kCol, myPos.position.col];
FOR c: [0..8) IN (c1..c1+adc) DO
pos: Position ← [rowCol[kRow, c]];
IF state.board[pos.index].color # none THEN GO TO notThisOne;
ENDLOOP;
GO TO addCoverage;
};
};
k => {
IF Basics.BITOR[adr, adc] = 1 THEN GO TO addCoverage;
Fast test for adjacency
};
ENDCASE;
EXITS
notThisOne => {};
addCoverage => {
totalWeight ← totalWeight + 1;
IF stopOnFirst THEN EXIT;
};
};
ENDLOOP;
};
PieceCovers: PROC [state: GameState, color: WhiteBlack, pos: Position, piece: Piece] RETURNS [BOOL] = {
myPos: FullPosition ← state.positions[color][piece];
IF myPos.onOff = on THEN {
alias: Piece ← piece;
kRow: [0..8) ← pos.row;
dRow: INTEGER ← kRow-myPos.position.row;
adr: NATABS[dRow];
kCol: [0..8) ← pos.col;
dCol: INTEGER ← kCol-myPos.position.col;
adc: NATABS[dCol];
IF Basics.BITOR[adc, adr] = 0 THEN RETURN [FALSE];
A piece can never cover itself
IF alias IN Pawn THEN alias ← state.aliases[color][alias];
Pawns can be aliased due to reaching the farthest row
SELECT alias FROM
p0, p1, p2, p3, p4, p5, p6, p7 => {
IF adc = 1 AND adr = 1 THEN
IF color = white
THEN {IF dRow = 1 THEN RETURN [TRUE]}
ELSE {IF dRow = -1 THEN RETURN [TRUE]};
};
wn, bn => {
IF adr+adc = 3 AND adc IN [1..2] THEN RETURN [TRUE];
};
wb, bb => {
SELECT adr FROM
# adc => RETURN [FALSE];
Not on a diagonal, so skip it
1 => RETURN [TRUE];
Fast test for adjacency
ENDCASE => {
stepR: INTEGERIF dRow > 0 THEN -1 ELSE 1;
stepC: INTEGERIF dCol > 0 THEN -1 ELSE 1;
THROUGH (0..adc) DO
pos: Position ← [rowCol[kRow ← kRow + stepR, kCol ← kCol + stepC]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
};
wr, br => {
SELECT TRUE FROM
adc = 0 => IF adr = 1 THEN RETURN [TRUE] ELSE {
On a column
r1: [0..8) ← MIN[kRow, myPos.position.row];
FOR r: [0..8) IN (r1..r1+adr) DO
pos: Position ← [rowCol[r, kCol]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
adr = 0 => IF adc = 1 THEN RETURN [TRUE] ELSE {
On a row
c1: [0..8) ← MIN[kCol, myPos.position.col];
FOR c: [0..8) IN (c1..c1+adc) DO
pos: Position ← [rowCol[kRow, c]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
ENDCASE;
};
q => {
SELECT adc FROM
adr => {
On a diagonal
stepR: INTEGERIF dRow > 0 THEN -1 ELSE 1;
stepC: INTEGERIF dCol > 0 THEN -1 ELSE 1;
THROUGH (0..adc) DO
pos: Position ← [rowCol[kRow ← kRow + stepR, kCol ← kCol + stepC]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
0 => {
On a column
r1: [0..8) ← MIN[kRow, myPos.position.row];
FOR r: [0..8) IN (r1..r1+adr) DO
pos: Position ← [rowCol[r, kCol]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
ENDCASE => IF adr = 0 THEN {
On a row
c1: [0..8) ← MIN[kCol, myPos.position.col];
FOR c: [0..8) IN (c1..c1+adc) DO
pos: Position ← [rowCol[kRow, c]];
IF state.board[pos.index].color # none THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
};
k => {
IF Basics.BITOR[adr, adc] = 1 THEN RETURN [TRUE];
Fast test for adjacency
};
ENDCASE;
};
RETURN [FALSE];
};
centralWeights: REF IndexWeightArray ← NEW[IndexWeightArray ← [
0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 1, 1, 1, 1, 1, 0,
0, 1, 3, 3, 3, 3, 1, 0,
0, 1, 3, 5, 5, 3, 1, 0,
0, 1, 3, 5, 5, 3, 1, 0,
0, 1, 3, 3, 3, 3, 1, 0,
0, 1, 1, 1, 1, 1, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0
]];
IndexWeightArray: TYPE = ARRAY BoardIndex OF Weight;
materialWeights: REF PieceWeightArray ← NEW[PieceWeightArray ← [
150, 150, 150, 150, 150, 150, 150, 150,
500, 320, 330, 900, 10000, 330, 320, 500
]];
PieceWeightArray: TYPE = ARRAY Piece OF Weight;
Weight: TYPE = NAT;
CountBits: PROC [cover: SquareCoverage] RETURNS [w: CARDINAL] = {
An algorithm for counting bits due to Ed McCreight.
n: CARDINAL ← Basics.BITAND[0AAAAH, w ← LOOPHOLE[cover]];
w ← n/2 + (w-n);
n ← Basics.BITAND[0CCCCH, w];
w ← n/4 + (w-n);
n ← Basics.BITAND[0F0F0H, w];
w ← n/16 + (w-n);
n ← Basics.BITAND[0FF00H, w];
w ← n/256 + (w-n);
};
CountBitsInline: PROC [cover: SquareCoverage] RETURNS [w: CARDINAL] = INLINE {
n: CARDINAL ← Basics.BITAND[0AAAAH, w ← LOOPHOLE[cover]];
w ← n/2 + (w-n);
n ← Basics.BITAND[0CCCCH, w];
w ← n/4 + (w-n);
n ← Basics.BITAND[0F0F0H, w];
w ← n/16 + (w-n);
n ← Basics.BITAND[0FF00H, w];
w ← n/256 + (w-n);
};
OtherColor: PROC [color: WhiteBlack] RETURNS [WhiteBlack] = INLINE {
RETURN [LOOPHOLE[Basics.BITXOR[ORD[color], 1]]];
};
Viewer stuff
Goodies
squareSize: NAT ← 40;
whiteBackground: ImagerColor.Color ← ImagerColor.ColorFromGray[0.35];
blackBackground: ImagerColor.Color ← ImagerColor.ColorFromGray[0.65];
baseX: NAT ← 4;
baseY: NAT ← 4;
smallScale: REAL ← 3/8.0;
letterScale: NAT ← 30;
letterOffset: NAT ← 2;
letterFontName: Rope.ROPE ← "Xerox/PressFonts/Cream-brr";
textFontName: Rope.ROPE ← "Xerox/TiogaFonts/Helvetica14";
textHeight: NAT ← 32;
textWidth: NAT ← 256;
minMaterial: INTEGER ← 5000;
Minimum acceptable material
playLevel: NAT ← 3;
Minimum acceptable play level
debugLevel: NAT ← 1;
Debugging display level
defaultFanOut: NAT ← 6;
Max fan out for moves
depthCutoff: NAT ← 2;
Depth cutoff for following special cases
valueCutoff: NAT ← 800;
Value cutoff for getting in deep
maxHistoryLen: NAT ← 400;
Maximum # of moves
MyData: TYPE = REF MyDataRep;
MyDataRep: TYPE = MONITORED RECORD [
state: GameState ← NIL,
stack: GameStateList ← NIL,
lastShown: Board,
paintBoard: Board,
paintCond: CONDITION,
displayMoves: BOOLFALSE,
busy: BOOLFALSE,
stopRequested: BOOLFALSE,
paintRequested: BOOLFALSE,
flashRequested: NAT ← 0,
autoAuto: BOOLFALSE,
stackValid: BOOLFALSE,
screenValid: BOOLFALSE,
quit: BOOLFALSE,
invertDisplay: BOOLFALSE,
selected: FullPosition ← [off, [index[0]]],
message1: ROPENIL,
message2: ROPENIL,
letterFont: ImagerFont.Font ← NIL,
textFont: ImagerFont.Font ← NIL,
wd: ROPENIL
];
GameStateList: TYPE = LIST OF GameState;
MaxFanOut: NAT = 20;
ChessProcsClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec ← [
flavor: $Chess,
notify: NotifyMe,
destroy: DestroyMe,
paint: PaintMe
]];
Init: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
data: MyData ← NEW[MyDataRep];
menu: Menus.Menu ← Menus.CreateMenu[lines: 1];
tipTable: TIPUser.TIPTable ← NIL;
tipFile: ROPE ← CommandTool.FileWithSearchRules["Chess", ".tip", cmd, FALSE];
IF tipFile = NIL THEN {
msg ← "Error: Chess.tip not found or not accessible.\n";
GO TO failed};
NewBoard[data];
ViewerOps.RegisterViewerClass[$Chess, ChessProcsClass];
WITH ProcessProps.GetProp[$WorkingDirectory] SELECT FROM
wd: ROPE => data.wd ← wd;
ENDCASE;
data.letterFont ← ImagerFont.Find[letterFontName];
data.textFont ← ImagerFont.Find[textFontName];
IF letterScale > 1 THEN data.letterFont ← ImagerFont.Scale[data.letterFont, letterScale];
tipTable ← TIPUser.InstantiateNewTIPTable[tipFile
! FS.Error => {msg ← error.explanation; GO TO failed}];
Build up the menu
Menus.AppendMenuEntry[menu, Menus.CreateEntry["STOP!", StopButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Reset", ResetButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Refresh", RefreshButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Replay", ReplayButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Step", StepButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Stack", StackButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Auto", AutoButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Invert", InvertButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Dump", DumpButton, data]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Load", LoadButton, data]];
TRUSTED {
Process.Detach[FORK PaintWatcher[data, ViewerOps.CreateViewer[
flavor: $Chess,
info: [
name: "ChessHack",
openHeight: squareSize*8+baseY*2+ViewerSpecs.menuHeight*2,
data: data,
tipTable: tipTable,
menu: menu
]
]]];
};
EXITS failed => result ← $Failure;
};
Registration
Commander.Register["ChessHack", Init];
END.