<> <> <> <> 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 [black, Color, DoSaveAll, MaskRectangleI, ScaleT, SetColor, SetFont, SetGray, SetXY, SetXYI, ShowChar, ShowRope, TranslateT, white], ImagerBackdoor USING [MakeStipple], ImagerFont USING [Find, Font], 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, ImagerBackdoor, ImagerFont, IO, Menus, MessageWindow, Process, ProcessProps, Rope, RuntimeError, TIPUser, ViewerOps, ViewerSpecs, ViewerTools = BEGIN OPEN ChessDefs; <> LORA: TYPE = LIST OF REF ANY; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; <> StopRequest: ERROR = CODE; AutoMove: PROC [data: MyData, level: NAT] RETURNS [MoveList] = { MoveFlags: TYPE = RECORD [ taking: BOOL _ FALSE, check: BOOL _ FALSE ]; 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]; 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: BOOL _ FALSE]>> <> 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 { <> 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]; }; }; 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 => { <> 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; <> 1, 2 => bonus _ bonus + 1; <> ENDCASE; IF move.to.row IN [1..6] THEN { <> 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 + 2; 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 + 2; 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 <> bonus _ bonus + 4; }; }; }; wn, bn => { <> fromW: INTEGER = centralWeights[move.from.index]; toW: INTEGER = centralWeights[move.to.index]; bonus _ bonus + (toW-fromW); IF wasInCheck THEN bonus _ bonus + 8; }; wb, bb => { <> SELECT move.from.row FROM 0, 7 => bonus _ bonus + 5; ENDCASE; IF wasInCheck THEN bonus _ bonus + 10; }; wr, br, q => { <> 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) => <> bonus _ bonus + 10; wrPos.onOff = off AND (qPos.position.row = brPos.position.row OR qPos.position.col = brPos.position.col) => <> value _ value + 5; brPos.onOff = off AND (wrPos.position.row = qPos.position.row OR wrPos.position.col = qPos.position.col) => <> bonus _ bonus + 5; ENDCASE; }; k => <> IF move.note.kind = castle THEN bonus _ bonus + 60 <> ELSE bonus _ bonus - 20; <> ENDCASE; }; } ELSE { <> 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 { <> IF goodMovesMax < fanOut OR flags.check OR goodFlags[goodMovesMax-1].check THEN <> IF goodMovesMax+1 < maxFanOut THEN goodMovesMax _ goodMovesMax + 1; FOR j: NAT DECREASING IN (pos..goodMovesMax) DO <> 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 { <> 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 => { <> UnMakeMove[state]; dMove _ move; maxMoves _ 1; val _ kW; quit _ foundMate _ TRUE; }; }; }; ProposeLegalMove[piece, color, state, pass1]; }; ENDLOOP; }; IF foundMate THEN RETURN; <> IF goodMovesMax = 0 THEN { <> SELECT TRUE FROM state.inCheck[color] => val _ history.current - kW; <> val < -400 => val _ kW; <> ENDCASE => val _ -val; <> 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 => { <> value _ value; }; value < minValue AND level = 0 => { <> value _ value; }; current > 2 AND level # 0 => { <> value _ -Driver[level-1, MAX[fanOut-1, defaultFanOut/2]].val; }; current < maxLevel AND (flags.taking OR flags.check OR wasInCheck) => { <> value _ -Driver[0, MAX[fanOut-1, defaultFanOut/2]].val; }; current > 6 => { <> 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 => { <> 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 _ 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]; }; <> 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 => { DrawBoard: PROC = { size: INTEGER ~ squareSize*8; FOR i: NAT IN[0..8] DO m: INTEGER ~ squareSize*i; Imager.MaskRectangleI[context, m-1, -1, 2, size+2]; Imager.MaskRectangleI[context, -1, m-1, size+2, 2]; ENDLOOP; FOR pos: BoardIndex IN BoardIndex DO DrawPosition[ [index[pos]], sample[pos]]; ENDLOOP; }; DrawPosition: PROC [position: Position, cPiece: ColoredPiece] = { alias: Piece _ cPiece.piece; IF cPiece.color # none AND alias IN Pawn THEN alias _ state.aliases[cPiece.color][alias]; DrawSquare[position, [cPiece.color, alias]]; }; DrawSquare: PROC [position: Position, cPiece: ColoredPiece] = { localX: NAT _ position.col*squareSize; localY: NAT _ position.row*squareSize; background: Imager.Color _ IF (((position.col MOD 2) + (position.row MOD 2)) MOD 2) = 0 THEN blackBackground ELSE whiteBackground; char: CHAR _ 0C; IF inverted THEN { <> localY _ (7-position.row)*squareSize; localX _ (7-position.col)*squareSize; }; Imager.SetColor[context, background]; Imager.MaskRectangleI[context, localX+1, localY+1, squareSize-2, squareSize-2]; <> <> <> <> <> IF cPiece.color#none THEN SELECT cPiece.piece FROM p0, p1, p2, p3, p4, p5, p6, p7 => char _ '\101; br, wr => char _ '\104; bn, wn => char _ '\107; bb, wb => char _ '\112; q => char _ '\115; k => char _ '\120; ENDCASE; IF char#0C THEN { Imager.SetFont[context, data.chessFont]; IF background#Imager.white THEN { Imager.SetColor[context, Imager.white]; Imager.SetXYI[context, localX, localY]; Imager.ShowChar[context, char]; }; Imager.SetColor[context, Imager.black]; Imager.SetXYI[context, localX, localY]; SELECT cPiece.color FROM black => Imager.ShowChar[context, char+1]; white => Imager.ShowChar[context, char+2]; ENDCASE; }; }; 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; DrawBoard[]; }; 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 { <> Imager.SetGray[context, 0.0]; Imager.MaskRectangleI[context, 0, 0, squareSize*8, squareSize*8]; } ELSE { <> state _ data.stack.first; DrawBoard[]; state _ data.state; }; }; Imager.DoSaveAll[context, inner]; data.stackValid _ TRUE; }; { <> 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 _ 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: 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 { <> 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 { <> 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]; <> 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 { <> 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 { <> 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: 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; 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: 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; ENDCASE; }; <> NameFromSelection: PROC [data: MyData] RETURNS [ROPE] = { name: ROPE _ NIL; 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 <> 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]; <> 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 '_ => { <> [] _ MakeMove[state, [piece: piece, from: from, to: to]]; }; '& => { <> 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 => { <> rfrom: Position _ to; IF buffer.length > 5 THEN { <> 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]; <> buffer _ IO.GetToken[in, IO.IDProc, buffer].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; 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: BOOL _ TRUE] RETURNS [BOOL] = { <> 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 <> 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; }; <> 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 => { <> 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; <> 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; <> 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 { <> 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] = { <> 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] = { <> 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 => { <> IF NOT captureOnly THEN quit _ action[state, [myPiece, oPos, nPos] ]; RETURN [quit]; }; other => <> quit _ action[state, [myPiece, oPos, nPos, p0, [remove[victim: cPiece, from: nPos]]]]; ENDCASE; }; RETURN [TRUE]; }; ProposePawn: PROC [dRow, dCol: INTEGER] RETURNS [final: BOOL _ FALSE] = { <> 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 => { <> IF NOT captureOnly THEN quit _ action[state, [myPiece, oPos, nPos, alias] ]; RETURN [quit]; }; other => <> 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 => { <> 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 { <> IF action[state, [myPiece, oPos, nPos] ] THEN RETURN; IF aRow = 1 THEN { <> nPos.row _ row+forwards; cPiece _ state.board[nPos.index]; IF cPiece.color = none THEN { <> 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 { <> [] _ 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 { <> [] _ ProposePawn[forwards, 1]; IF quit THEN RETURN; }; }; IF aRow = 4 AND state.history.current > 0 THEN { <> 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 { <> 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 => { <> 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 => { <> 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 => { <> 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 => { <> <> 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; <> 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 => { <> 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 { <> 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] = { <> 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; <> IF alias IN Pawn THEN alias _ aliases[alias]; <> 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; <> 1 => GO TO addCoverage; <> 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 { <> 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 { <> 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 => { <> 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 => { <> 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 { <> 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; <> }; 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]; <> IF alias IN Pawn THEN alias _ state.aliases[color][alias]; <> 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]; <> 1 => RETURN [TRUE]; <> 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 { <> 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 { <> 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 => { <> 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 => { <> 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 { <> 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]; <> }; 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] = { <> 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]]]; }; <> <> squareSize: NAT _ 40; whiteBackground: Imager.Color _ Imager.white; blackBackground: Imager.Color _ ImagerBackdoor.MakeStipple[011110B]; baseX: NAT _ 4; baseY: NAT _ 4; smallScale: REAL _ 3/8.0; chessFontName: Rope.ROPE _ "Xerox/TiogaFonts/Chess40"; textFontName: Rope.ROPE _ "Xerox/TiogaFonts/Helvetica14"; textHeight: NAT _ 32; textWidth: NAT _ 256; minMaterial: INTEGER _ 5000; <> playLevel: NAT _ 3; <> debugLevel: NAT _ 1; <> defaultFanOut: NAT _ 8; <> depthCutoff: NAT _ 2; <> valueCutoff: NAT _ 800; <> maxHistoryLen: NAT _ 400; <> <<>> MyData: TYPE = REF MyDataRep; MyDataRep: TYPE = MONITORED RECORD [ state: GameState _ NIL, stack: GameStateList _ NIL, lastShown: Board, paintBoard: 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, chessFont: 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; 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.chessFont _ ImagerFont.Find[chessFontName]; data.textFont _ ImagerFont.Find[textFontName]; tipTable _ TIPUser.InstantiateNewTIPTable[tipFile ! FS.Error => {msg _ error.explanation; GO TO failed}]; <> 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; }; <> Commander.Register["ChessHack", Init]; END.