[Cyan]<CedarChest6.0>ChessHack>ChessDisplayImpl.mesa!1

copy -u /User/Atkinson/Chess/ ← ChessDisplayImpl.*

Russ Atkinson (RRA) March 3, 1986 11:54:15 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],

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];

ChessDisplayImpl: CEDAR MONITOR

LOCKS data USING data: MyData

IMPORTS Basics, BasicTime, CedarProcess, Commander, 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: BOOL ← FALSE,

threat: BOOL ← FALSE,

check: BOOL ← FALSE,

inThreat: BOOL ← FALSE,

inCover: BOOL ← FALSE,

intoThreat: BOOL ← FALSE,

intoCover: BOOL ← FALSE

];

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: BOOL ← FALSE] 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: BOOL ← FALSE;

val ← state.material[color] - state.material[other];

{

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: BOOL ← FALSE]

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: INTEGER ← IF 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

bonus ← bonus + 4;

SELECT move.from.row FROM

0, 7 => bonus ← bonus + 10;

1, 6 => bonus ← bonus + 5;

ENDCASE =>

SELECT move.from.col FROM

0, 7 => bonus ← bonus + 10;

1, 6 => bonus ← bonus + 5;

ENDCASE;

IF wasInCheck THEN bonus ← bonus + 10;

};

wb, bb => {

We like to block checks with bishops

bonus ← bonus + 5;

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 < -900 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 <= baseLevel + depthCutoff AND (flags.taking OR flags.check OR state.inCheck[color]) => {

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;

};

ENDCASE => {

At this point we have to determine the best move based on the material difference and the flags.

alias: Piece ← move.piece.piece;

IF alias IN Pawn THEN alias ← state.aliases[color][alias];

value ← state.material[color] - state.material[other];

SELECT TRUE FROM

flags.intoThreat =>

This is likely to be a problem, since we will lose the piece

value ← value - materialWeights[alias];

flags.inThreat =>

This gets the piece out of threat

IF alias # k THEN value ← value + materialWeights[alias];

move.note.kind = castle =>

We like to castle

value ← value + 50;

flags.taking, flags.check =>

Slight bias here towrds taking or checking

value ← value + 5;

ENDCASE;

IF flags.threat THEN value ← value + 20;

We like to add threats to another piece

IF current > 6 THEN {

Try not to repeat moves too much. Eventually we should avoid repetition that would force a draw (unless we want one, of course).

myLast: Move ← history[current-5];

IF myLast.piece = move.piece AND myLast.to = move.to AND myLast.from = move.from THEN value ← value - 50;

};

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;

triggerLo: NAT ← baseLevel+1;

triggerHi: NAT ← baseLevel+debugLevel;

debug: INT ← 0;

move: Move;

value: INTEGER;

[move, value, count] ← driver[level, defaultFanOut, TRUE

! StopRequest => {count ← 0; 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;

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;

};

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 ← data.state.board;

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: ROPE ← IF 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 ← data.state.board;

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: BOOL ← FALSE;

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: NAT ← IF 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;

};

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;

};

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;

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;

};

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;

};

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;

};

out: STREAM ← FS.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;

};

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;

};

in: STREAM ← FS.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;

};

Utility procedures

NameFromSelection: PROC [data: MyData] RETURNS [ROPE] = {

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: BOOL ← FALSE;

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 TEXT ← NEW[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;

};

[] ← 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: BOOL ← TRUE, waitForDone: BOOL ← TRUE] = {

state: GameState ← data.state;

data.paintRequested ← TRUE;

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;

};

MakeBusy: ENTRY PROC [data: MyData, busy: BOOL ← TRUE] 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;

};

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: BOOL ← TRUE] RETURNS [legal: BOOL ← TRUE] = {

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: BOOL ← FALSE, move: Move] = {

color: WhiteBlack ← state.toMove;

other: WhiteBlack ← OtherColor[color];

row: [0..8) ← IF color = white THEN 0 ELSE 7;

delta: INTEGER ← IF 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: BOOL ← FALSE] = {

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: BOOL ← FALSE];

ProposeLegalMove: PROC [piece: Piece, color: WhiteBlack, state: GameState, action: MoveAction, captureOnly: BOOL ← FALSE] = {

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: INTEGER ← IF myColor = white THEN 1 ELSE -1;

backwards: INTEGER ← -forwards;

fullPos: FullPosition;

curPos: Position;

alias: Piece ← piece;

currentRow: [0..8);

currentCol: [0..8);

quit: BOOL ← FALSE;

Propose: PROC [dRow, dCol: INTEGER] RETURNS [final: BOOL ← FALSE] = {

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: BOOL ← FALSE] = {

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: BOOL ← FALSE] 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: NAT ← ABS[dRow];

kCol: [0..8) ← pos.col;

dCol: INTEGER ← kCol-myPos.position.col;

adc: NAT ← ABS[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: INTEGER ← IF dRow > 0 THEN -1 ELSE 1;

stepC: INTEGER ← IF 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: INTEGER ← IF dRow > 0 THEN -1 ELSE 1;

stepC: INTEGER ← IF 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: NAT ← ABS[dRow];

kCol: [0..8) ← pos.col;

dCol: INTEGER ← kCol-myPos.position.col;

adc: NAT ← ABS[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: INTEGER ← IF dRow > 0 THEN -1 ELSE 1;

stepC: INTEGER ← IF 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: INTEGER ← IF dRow > 0 THEN -1 ELSE 1;

stepC: INTEGER ← IF 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];

};

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 ← 8;

Max fan out for moves

depthCutoff: NAT ← 5;

Depth cutoff for following special cases

maxHistoryLen: NAT ← 400;

Maximum # of moves

MyData: TYPE = REF MyDataRep;

MyDataRep: TYPE = MONITORED RECORD [

state: GameState ← NIL,

stack: GameStateList ← NIL,

lastShown: Board,

paintCond: CONDITION,

displayMoves: BOOL ← FALSE,

busy: BOOL ← FALSE,

stopRequested: BOOL ← FALSE,

paintRequested: BOOL ← FALSE,

flashRequested: NAT ← 0,

autoAuto: BOOL ← FALSE,

stackValid: BOOL ← FALSE,

screenValid: BOOL ← FALSE,

quit: BOOL ← FALSE,

invertDisplay: BOOL ← FALSE,

selected: FullPosition ← [off, [index[0]]],

message1: ROPE ← NIL,

message2: ROPE ← NIL,

letterFont: ImagerFont.Font ← NIL,

textFont: ImagerFont.Font ← NIL,

wd: ROPE ← NIL

];

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;

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["Chess.tip" ! FS.Error => CONTINUE];

IF tipTable = NIL THEN

tipTable ← TIPUser.InstantiateNewTIPTable["///Chess.tip" ! FS.Error => CONTINUE];

IF tipTable = NIL THEN

tipTable ← TIPUser.InstantiateNewTIPTable["///Chess/Chess.tip" ! FS.Error => CONTINUE];

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: [

openHeight: squareSize*8+baseY*2+ViewerSpecs.menuHeight*2,

data: data,

tipTable: tipTable,

menu: menu

]

]]];

};

Registration

Commander.Register["ChessHack", Init];

END.