From a8831544f630719309f32390c1382a41d60181d5 Mon Sep 17 00:00:00 2001 From: The Experienced Programmer Date: Fri, 24 Feb 2023 15:23:03 +0100 Subject: [PATCH] Update Chess.st Fixed bug where white King put itself in check position w.r.t. black Pawn. New method that captures an expression. Renamed local variables. --- Chess.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Chess.st b/Chess.st index f477eab..cd4b2cd 100644 --- a/Chess.st +++ b/Chess.st @@ -1 +1 @@ -Object subclass: #ChessBoard instanceVariableNames: 'blackPlayerName whitePlayerName squares mapFromNameToIndex isInProbingMode undoStack' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoard commentStamp: 'SdJ 12/23/2022 15:20' prior: 0! I hold squares, which may in turn hold pieces. I also know the names of the players.! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 14:28'! blackPlayerName ^ blackPlayerName! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:13'! blackPlayerName: name blackPlayerName := name! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 14:38'! isInProbingMode ^ isInProbingMode! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 14:38'! isInProbingMode: aBoolean isInProbingMode := aBoolean! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 1/27/2023 13:01'! kingWithColor: color ^ ((self piecesWithColor: color) select: [ :p | p isKindOf: King ]) first! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 15:25'! piecesWithColor: color ^ ((squares collect: [ :s | s piece ]) select: [ :p | p isNil not ]) select: [ :p | p color = color ]! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 1/22/2023 13:39'! squareAt: positionName | index | index := mapFromNameToIndex at: positionName ifAbsent: [ ^ nil ]. ^ self squareAtIndex: index.! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:18'! squareAt: file and: rank ^ self squareAtIndex: (8 * (rank - 1) + file) "8 = ChessBoard fileDesignators size."! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:24'! squareAtIndex: index ^ squares at: index! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 11/27/2022 13:24'! squares ^ squares! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 14:28'! whitePlayerName ^ whitePlayerName! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:15'! whitePlayerName: name whitePlayerName := name! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 10:22'! makeEmpty: square square isEmpty ifFalse: [ isInProbingMode ifTrue: [ undoStack push: (ChessPieceState from: square piece) ]. square makeEmpty. ]! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 12:02'! put: piece on: square self makeEmpty: square. isInProbingMode ifTrue: [ undoStack push: (ChessPieceState from: piece) ]. piece square isNil ifFalse: [ piece square makeEmpty ]. "Can happen in case of pawn promotion." square piece: piece. piece hasMoved: true.! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 11:36'! undoMoves [ undoStack isEmpty ] whileFalse: [ undoStack pop restoreToPiece ]! ! !ChessBoard methodsFor: 'private' stamp: 'SdJ 1/14/2023 13:54'! initializeSquares | color firstColor index positionName | squares := Array new: (ChessBoard fileDesignators size * ChessBoard numberOfRanks). mapFromNameToIndex := Dictionary new. firstColor := Color white. index := 1. 1 to: ChessBoard numberOfRanks do: [ :rank | firstColor := ChessGame otherColor: firstColor. color := firstColor. ChessBoard fileDesignators do: [ :file | positionName := (file asString) , (rank asString). squares at: index put: ((ChessBoardSquare withColor: color onPosition: positionName) board: self). mapFromNameToIndex at: positionName put: index. index := index + 1. color := ChessGame otherColor: color ] ]! ! !ChessBoard methodsFor: 'private' stamp: 'SdJ 12/16/2022 15:37'! setup (self squareAt: 'a1') piece: (Rook newWithColor: Color white). (self squareAt: 'b1') piece: (Knight newWithColor: Color white). (self squareAt: 'c1') piece: (Bishop newWithColor: Color white). (self squareAt: 'd1') piece: (Queen newWithColor: Color white). (self squareAt: 'e1') piece: (King newWithColor: Color white). (self squareAt: 'f1') piece: (Bishop newWithColor: Color white). (self squareAt: 'g1') piece: (Knight newWithColor: Color white). (self squareAt: 'h1') piece: (Rook newWithColor: Color white). (self squareAt: 'a2') piece: (Pawn newWithColor: Color white). (self squareAt: 'b2') piece: (Pawn newWithColor: Color white). (self squareAt: 'c2') piece: (Pawn newWithColor: Color white). (self squareAt: 'd2') piece: (Pawn newWithColor: Color white). (self squareAt: 'e2') piece: (Pawn newWithColor: Color white). (self squareAt: 'f2') piece: (Pawn newWithColor: Color white). (self squareAt: 'g2') piece: (Pawn newWithColor: Color white). (self squareAt: 'h2') piece: (Pawn newWithColor: Color white). (self squareAt: 'a8') piece: (Rook newWithColor: Color black). (self squareAt: 'b8') piece: (Knight newWithColor: Color black). (self squareAt: 'c8') piece: (Bishop newWithColor: Color black). (self squareAt: 'd8') piece: (Queen newWithColor: Color black). (self squareAt: 'e8') piece: (King newWithColor: Color black). (self squareAt: 'f8') piece: (Bishop newWithColor: Color black). (self squareAt: 'g8') piece: (Knight newWithColor: Color black). (self squareAt: 'h8') piece: (Rook newWithColor: Color black). (self squareAt: 'a7') piece: (Pawn newWithColor: Color black). (self squareAt: 'b7') piece: (Pawn newWithColor: Color black). (self squareAt: 'c7') piece: (Pawn newWithColor: Color black). (self squareAt: 'd7') piece: (Pawn newWithColor: Color black). (self squareAt: 'e7') piece: (Pawn newWithColor: Color black). (self squareAt: 'f7') piece: (Pawn newWithColor: Color black). (self squareAt: 'g7') piece: (Pawn newWithColor: Color black). (self squareAt: 'h7') piece: (Pawn newWithColor: Color black).! ! !ChessBoard methodsFor: 'initialize-release' stamp: 'SdJ 2/10/2023 14:37'! initialize super initialize. self initializeSquares ; setup. isInProbingMode := false. undoStack := Stack new.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessBoard class instanceVariableNames: ''! !ChessBoard class methodsFor: 'constants' stamp: 'SdJ 12/31/2022 11:12'! fileDesignators ^ 'abcdefgh'! ! !ChessBoard class methodsFor: 'constants' stamp: 'SdJ 12/31/2022 11:09'! numberOfRanks ^ 8! ! !ChessBoard class methodsFor: 'instance creation' stamp: 'SdJ 12/3/2022 14:24'! with: whitePlayerName and: blackPlayerName ^ self new blackPlayerName: blackPlayerName; whitePlayerName: whitePlayerName! ! Object subclass: #ChessBoardSquare instanceVariableNames: 'board file rank name color piece' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardSquare commentStamp: 'SdJ 12/23/2022 15:21' prior: 0! I am a square on the board and may hold a piece. I can be used to access other squares as well.! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 1/27/2023 13:21'! = aSquare ^ (file = aSquare file) & (rank = aSquare rank)! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 17:36'! board: aBoard board := aBoard! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 1/28/2023 09:46'! color ^ color! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 15:01'! file ^ file! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 19:07'! isEmpty ^ piece isNil! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 11:41'! isOccupiedByPieceNotBeing: color "Answer whether self is not empty, but occupied by a piece of the other color. Special provisions for self being a King." self isEmpty ifTrue: [ ^ false ] ifFalse: [ (self piece color) = color ifTrue: [ ^ false ] ifFalse: [ ^ (self piece isKindOf: King) not ] ]! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 10:26'! isOnEnPassantRankFor: color (color = Color white) ifTrue: [ ^ rank = 5 ] ifFalse: [ ^ rank = 4 ]! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:19'! isOnLastRank ^ (rank = 1) | (rank = 8) "8 = ChessBoard numberOfRanks."! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 18:56'! isOnLeftMostFile ^ file = 1! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:19'! isOnRightMostFile ^ file = 8 "8 = ChessBoard fileDesignators size."! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 13:48'! makeEmpty piece square: nil. piece := nil.! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/4/2022 16:19'! name ^ name! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/5/2023 19:06'! numberOfSquaresAhead: number ^ self square: number aheadFrom: file and: rank! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:30'! piece ^ piece! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:22'! piece: aPiece piece := aPiece. piece isNil ifFalse: [ piece square: self ].! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 15:01'! rank ^ rank! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/5/2023 19:03'! square: number aheadFrom: aFile and: aRank "Answer the Square number of squares straight ahead. The orientation depends on the color." ^ board squareAt: aFile and: (piece color = Color white ifTrue: [ aRank + number ] ifFalse: [ aRank - number ])! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:35'! attacks: aSquare via: directions "Answer whether the piece on the receiver attacks aSquare in any of the given directions." directions do: [ :direction | (self attacks: aSquare viaSingle: direction) ifTrue: [ ^ true ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:37'! attacks: aSquare viaOneOf: relativePositions "Answer whether the piece on the receiver attacks aSquare via one of the given relative positions." relativePositions do: [ :relativePosition | | proposedFile proposedRank | proposedFile := file + relativePosition at: 1. proposedRank := rank + relativePosition at: 2. (ChessBoardSquare isLegitCombinationOf: proposedFile and: proposedRank) ifTrue: [ (board squareAt: proposedFile and: proposedRank) = aSquare ifTrue: [ ^ true ] ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 2/3/2023 16:18'! isAttackedBy: aColor "Answer whether the receiver is attacked by any piece with aColor." (board piecesWithColor: aColor) do: [ :aPiece | (aPiece isAttacking: self) ifTrue: [ ^ true ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/21/2023 15:29'! kingSideCastlingMove ^ self castlingMoveFor: 8 "Rightmost file."! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 12/31/2022 09:58'! moveTo: otherSquare ^ ChessMove from: self to: otherSquare! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:30'! permittedMovesFor: relativePositions | permittedMoves | permittedMoves := OrderedCollection new. (self permittedSquaresFrom: relativePositions) do: [ :destinationSquare | permittedMoves add: (self moveTo: destinationSquare) ]. ^ permittedMoves! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:30'! permittedMovesIn: directions | permittedMoves legitDestinationSquares | legitDestinationSquares := OrderedCollection new. directions do: [ :direction | legitDestinationSquares addAll: (self permittedSquaresIn: direction) ]. permittedMoves := OrderedCollection new. legitDestinationSquares do: [ :destinationSquare | permittedMoves add: (self moveTo: destinationSquare) ]. ^ permittedMoves! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/21/2023 15:29'! queenSideCastlingMove ^ self castlingMoveFor: 1 "Leftmost file."! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:25'! allSquaresAreNotAttackedBetween: startFile and: endFile "Precondition: the King is located at self. Checked by this method: none of the following squares are attacked: * The current position of the King * The position to which the King wants to move * Any positions in between The squares checked are at the same rank as the receiver and include the start file and end file." | otherColor | otherColor := ChessGame otherColor: self piece color. startFile to: endFile do: [ :intermediateFile | ((board squareAt: intermediateFile and: rank) isAttackedBy: otherColor) ifTrue: [ ^ false ]. ]. ^ true! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:48'! allSquaresAreNotOccupiedBetween: startFile and: endFile "Precondition: the King is located at self." startFile to: endFile do: [ :intermediateFile | (board squareAt: intermediateFile and: rank) isEmpty ifFalse: [ ^ false ]. ]. ^ true! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:24'! allSquaresBetweenKingAndRookAreNotOccupied: fileOfRook "Precondition: the King is located at self. This method also checks: none of the following squares are attacked: * The current position of the King * The position to which the King wants to move * Any positions in between" (self isAttackedBy: (ChessGame otherColor: self piece color)) ifTrue: [ ^ false ]. fileOfRook = 1 ifTrue: [ ^ (self allSquaresAreNotOccupiedBetween: fileOfRook + 1 and: file - 1) and: [ self allSquaresAreNotAttackedBetween: file - 2 and: file - 1 ] ] ifFalse: [ ^ (self allSquaresAreNotOccupiedBetween: file + 1 and: fileOfRook - 1) and: [ self allSquaresAreNotAttackedBetween: file + 1 and: file + 2 ] ]! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/29/2023 19:36'! attacks: aSquare viaSingle: direction "Answer whether the piece on the receiver attacks aSquare in the given direction." | currentFile currentRank currentSquare | currentFile := file. currentRank := rank. [ currentFile := currentFile + direction at: 1. currentRank := currentRank + direction at: 2. (ChessBoardSquare isLegitCombinationOf: currentFile and: currentRank) ifTrue: [ ((currentSquare := board squareAt: currentFile and: currentRank) = aSquare) ifTrue: [ ^ true ] ifFalse: [ currentSquare isEmpty ifFalse: [ ^ false ] ] ] ifFalse: [ ^ false ] ] repeat! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/5/2023 18:55'! castlingMoveFor: fileOfRook "Precondition: the King (at self) has not moved." | moves horizontalDirection | moves := OrderedCollection new. (self rookIsUnmovedAt: fileOfRook and: rank) ifFalse: [ ^ moves ]. (self allSquaresBetweenKingAndRookAreNotOccupied: fileOfRook) ifFalse: [ ^ moves ]. horizontalDirection := fileOfRook = 1 ifTrue: [ -1 ] ifFalse: [ 1 ]. moves add: (self moveTo: (board squareAt: file + (2 * horizontalDirection) and: rank)). ^ moves! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/27/2023 13:24'! legitSquaresFrom: relativePositions "Answer a collection of ChessBoardSquares. For each of relativePositions, determine if the position is legit. If so, add it to the collection. A relative position is a (horizontalOffset, verticalOffset) pair." | squares | squares := OrderedCollection new. relativePositions do: [ :relativePosition | | proposedFile proposedRank | proposedFile := file + relativePosition at: 1. proposedRank := rank + relativePosition at: 2. (ChessBoardSquare isLegitCombinationOf: proposedFile and: proposedRank) ifTrue: [ squares add: (board squareAt: proposedFile and: proposedRank) ] ]. ^ squares! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:06'! permittedSquaresFrom: relativePositions ^ (self legitSquaresFrom: relativePositions) select: [ :s | s isEmpty or: [ s isOccupiedByPieceNotBeing: piece color ] ]! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:06'! permittedSquaresIn: direction "Answer a collection of ChessBoardSquares. Add all squares in the given direction as long as: - the position is legit - the square is empty - the square is occupied by an opponent piece (then stop) Also stop if the square is occupied by a friendly piece. direction is a (horizontalOffset, verticalOffset) pair." | squares currentFile currentRank currentSquare | squares := OrderedCollection new. currentFile := file. currentRank := rank. [ currentFile := currentFile + direction at: 1. currentRank := currentRank + direction at: 2. (ChessBoardSquare isLegitCombinationOf: currentFile and: currentRank) ifTrue: [ currentSquare := board squareAt: currentFile and: currentRank. (currentSquare isEmpty or: [ currentSquare isOccupiedByPieceNotBeing: piece color ]) ifTrue: [ squares add: currentSquare ]. currentSquare isEmpty ifFalse: [ ^ squares ] ] ifFalse: [ ^ squares ] ] repeat.! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/21/2023 14:35'! rookIsUnmovedAt: fileOfRook and: rankOfRook | rookSquare pieceAtRookSquare | rookSquare := board squareAt: fileOfRook and: rankOfRook. rookSquare isEmpty ifTrue: [ ^ false ]. pieceAtRookSquare := rookSquare piece. ^ (pieceAtRookSquare isKindOf: Rook) and: [ pieceAtRookSquare hasMoved not ]! ! !ChessBoardSquare methodsFor: 'printing' stamp: 'SdJ 12/17/2022 14:23'! printOn: aStream ^ aStream print: name, '(', (color = Color white ifTrue: [ 'w' ] ifFalse: [ 'b' ]), ') : ', piece! ! !ChessBoardSquare methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 11:20'! withColor: aColor onPosition: aName color := aColor. name := aName. rank := (aName last: 1) asInteger. file := ChessBoard fileDesignators findString: (aName first: 1).! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessBoardSquare class instanceVariableNames: ''! !ChessBoardSquare class methodsFor: 'convenience' stamp: 'SdJ 12/31/2022 11:24'! isLegitCombinationOf: file and: rank "First 8 = ChessBoard fileDesignators size, second 8 = ChessBoard numberOfRanks." ^ file >= 1 and: [file <= 8 and: [rank >= 1 and: [rank <= 8]]]! ! !ChessBoardSquare class methodsFor: 'convenience' stamp: 'SdJ 12/24/2022 09:17'! isOnEnPassantRank: color ^ false! ! !ChessBoardSquare class methodsFor: 'instance creation' stamp: 'SdJ 11/27/2022 11:36'! withColor: aColor onPosition: aName ^ self new withColor: aColor onPosition: aName! ! Object subclass: #ChessBoardViewer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardViewer commentStamp: 'SdJ 12/23/2022 15:21' prior: 0! I am an abstract chess board viewer.! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 14:08'! ask: player forNextMoveFrom: permittedMoves on: board ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 10:48'! declareStaleMate ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 12/4/2022 19:06'! declareWinner: player ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'viewing' stamp: 'SdJ 12/9/2022 19:12'! show: aChessBoard and: aScoreSheet ^ self subclassResponsibility! ! ChessBoardViewer subclass: #ChessBoardViewerOnTranscript instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardViewerOnTranscript commentStamp: 'SdJ 12/23/2022 15:22' prior: 0! I show a chess board on the Transcript.! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 14:13'! ask: player forNextMoveFrom: permittedMoves on: board ^ player nextMoveFrom: permittedMoves on: board! ! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 10:49'! declareStaleMate UIManager default inform: ('Stalemate!!')! ! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 12/17/2022 14:21'! declareWinner: player UIManager default inform: ('The winner is ', player name, '!!')! ! !ChessBoardViewerOnTranscript methodsFor: 'private' stamp: 'SdJ 12/31/2022 11:22'! showBoard: aChessBoard | currentPiece | Transcript clear ; cr ; show: ('' expandMacros), (aChessBoard blackPlayerName) ; cr ; show: (' a b c d e f g h' expandMacros). 1 to: ChessBoard numberOfRanks do: [ :rank | Transcript show: String tab, (ChessBoard numberOfRanks + 1 - rank) asString, String tab. 1 to: ChessBoard fileDesignators size do: [ :file | currentPiece := (aChessBoard squareAtIndex: ChessBoard fileDesignators size * (ChessBoard numberOfRanks - rank) + file) piece. Transcript show: (currentPiece isNil ifTrue: [ '__' ] ifFalse: [ currentPiece asString ]), String tab. ]. Transcript show: (ChessBoard numberOfRanks + 1 - rank) asString ; cr. ]. Transcript show: (' a b c d e f g h' expandMacros) ; cr ; show: ('' expandMacros), (aChessBoard whitePlayerName) ; cr. ! ! !ChessBoardViewerOnTranscript methodsFor: 'private' stamp: 'SdJ 12/17/2022 14:22'! showScoreSheet: aScoreSheet | moveCounter | moveCounter := 1. Transcript cr. aScoreSheet do: [ :move | moveCounter \\ 2 = 0 ifFalse: [ Transcript show: (((moveCounter + 1) / 2) asString), String tab, move ] ifTrue: [ Transcript show: String tab, move ; cr ]. moveCounter := moveCounter + 1 ]! ! !ChessBoardViewerOnTranscript methodsFor: 'viewing' stamp: 'SdJ 12/16/2022 14:22'! show: aChessBoard and: aScoreSheet self showBoard: aChessBoard. self showScoreSheet: aScoreSheet.! ! Object subclass: #ChessGame instanceVariableNames: 'board blackPlayer whitePlayer currentPlayer viewer maximumNumberOfMoves showEachMove scoreSheet pawnInEnPassantPosition kingIsInCheck state' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessGame commentStamp: 'SdJ 12/23/2022 15:22' prior: 0! I control the turns and decide when the game is finished. I use a board and a viewer.! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 15:42'! addToScoreSheet: moveAsString board isInProbingMode ifFalse: [ scoreSheet add: moveAsString, (self kingOfOtherPlayerIsInCheck ifTrue: [ '+' ] ifFalse: [ '' ]) ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 15:45'! addToScoreSheet: move with: isCapture and: promotedTo self addToScoreSheet: move from name, (isCapture ifTrue: [ 'x' ] ifFalse: [ '-' ]), move to name, (promotedTo isNil ifTrue: [ '' ] ifFalse: [ promotedTo asChar ])! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:12'! checkWouldResultAfter: move | kingWouldBeInCheck | self saveState. self execute: move. kingWouldBeInCheck := self kingOfCurrentPlayerIsInCheck. board undoMoves. self restoreState. ^ kingWouldBeInCheck! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 11:43'! determineStaleMateOrWinner kingIsInCheck ifTrue: [ viewer declareWinner: (self otherPlayer) ] ifFalse: [ viewer declareStaleMate ]. ^ nil! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 11:00'! doGameLoopWith: aViewer andUpdates: mustShowEachMove | permittedMoves nextMove | viewer := aViewer. showEachMove := mustShowEachMove. [ permittedMoves := self permittedMovesFor: currentPlayer color. permittedMoves isEmpty ifTrue: [ nextMove := self determineStaleMateOrWinner ] ifFalse: [ nextMove := self nextMoveFrom: permittedMoves. ] ] doWhileFalse: [ scoreSheet size >= (maximumNumberOfMoves * 2) | nextMove isNil ]. "Show the final position, if not done already." showEachMove ifFalse: [ viewer show: board and: scoreSheet ].! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 10:56'! execute: move self resetEnPassant. (move from piece isKindOf: Pawn) ifTrue: [ self executePawnMove: move ] ifFalse: [ (move from piece isKindOf: King) ifTrue: [ self executeKingMove: move ] ifFalse: [ self executeOtherMove: move ] ].! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:21'! executeCastlingMove: move with: rookFile and: rookoffset | rookFromSquare rookToSquare notation | rookFromSquare := board squareAt: rookFile and: move from rank. rookToSquare := board squareAt: move to file + rookoffset and: move to rank. notation := '0-0', (rookFile = 1 ifTrue: '-0' ifFalse: ''). board put: rookFromSquare piece on: rookToSquare. self executeSimpleMove: move. self addToScoreSheet: notation.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 12:47'! executeKingMove: move (move from file - move to file) abs > 1 ifTrue: [ move from file > move to file ifTrue: [ "Queenside." self executeCastlingMove: move with: 1 and: 1 "First 1 = leftmost file." ] ifFalse: [ "Kingside." self executeCastlingMove: move with: 8 and: -1 "8 = rightmost file." ]. ] ifFalse: [ self executeOtherMove: move ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 10:55'! executeOtherMove: move | isCapture | isCapture := move to isEmpty not. self executeSimpleMove: move. self addToScoreSheet: move with: isCapture and: nil.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 12:13'! executePawnMove: move | isCapture promotedTo isInitialMoveByTwoSquares | (isCapture := (move from file = move to file) not) ifTrue: [ move to isEmpty ifTrue: [ "En passant capture." board makeEmpty: (move from square: 0 aheadFrom: move to file and: move from rank). ]. self executeSimpleMove: move. ] ifFalse: [ (isInitialMoveByTwoSquares := (move from rank - move to rank) abs > 1) ifTrue: [ pawnInEnPassantPosition := move from piece. ]. (self executeSimpleMove: move) canBeCapturedEnPassant: isInitialMoveByTwoSquares. ]. promotedTo := self promotionChoiceIfApplicable: move. self addToScoreSheet: move with: isCapture and: promotedTo.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:22'! executeSimpleMove: move "Answer the piece that has been moved." | piece | piece := move from piece. board put: piece on: move to. ^ piece! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 12:03'! kingOfCurrentPlayerIsInCheck ^ (board kingWithColor: currentPlayer color) square isAttackedBy: self otherPlayer color! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:22'! kingOfOtherPlayerIsInCheck ^ kingIsInCheck := (board kingWithColor: self otherPlayer color) square isAttackedBy: currentPlayer color! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/14/2023 14:09'! nextMoveFrom: permittedMoves | nextMove | (nextMove := viewer ask: currentPlayer forNextMoveFrom: permittedMoves on: board) isNil ifTrue: [ viewer declareWinner: (self otherPlayer) ] ifFalse: [ self execute: nextMove. showEachMove ifTrue: [ viewer show: board and: scoreSheet ]. currentPlayer := self otherPlayer. ]. ^ nextMove! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 12/3/2022 19:00'! otherPlayer currentPlayer = whitePlayer ifTrue: [ ^ blackPlayer ] ifFalse: [ ^ whitePlayer ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:11'! permittedMovesFor: color | permittedMoves | board isInProbingMode: true. permittedMoves := OrderedCollection new. (board piecesWithColor: color) do: [ :piece | permittedMoves addAll: (piece permittedMoves reject: [ :move | self checkWouldResultAfter: move ]) ]. board isInProbingMode: false. ^ permittedMoves! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:22'! promotionChoiceIfApplicable: move | promotedTo | move to isOnLastRank ifTrue: [ promotedTo := board isInProbingMode ifTrue: [ ^ Queen new color: currentPlayer color ] ifFalse: [ currentPlayer promotionChoice ]. board put: promotedTo on: move to. ]. ^ promotedTo! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/21/2023 19:22'! resetEnPassant pawnInEnPassantPosition isNil ifFalse: [ pawnInEnPassantPosition canBeCapturedEnPassant: false. pawnInEnPassantPosition := nil. ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:10'! restoreState pawnInEnPassantPosition := state pawnInEnPassantPosition. pawnInEnPassantPosition isNil ifFalse: [ pawnInEnPassantPosition canBeCapturedEnPassant: true ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:08'! saveState state := ChessGameState new pawnInEnPassantPosition: pawnInEnPassantPosition; pawnCanBeCapturedEnPassant: (pawnInEnPassantPosition isNil not)! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 11:43'! setupWith: player1 and: player2 player1 game: self. player2 game: self. Random new next < 0.5 ifTrue: [ whitePlayer := player1 color: Color white. blackPlayer := player2 color: Color black. ] ifFalse: [ whitePlayer := player2 color: Color white. blackPlayer := player1 color: Color black. ]. board := ChessBoard with: whitePlayer name and: blackPlayer name. currentPlayer := whitePlayer. kingIsInCheck := false. scoreSheet := OrderedCollection new. maximumNumberOfMoves := 100. "TODO: pass this as a parameter."! ! !ChessGame methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:47'! with: player1 and: player2 viewedWith: viewer self setupWith: player1 and: player2. viewer show: board and: scoreSheet. self doGameLoopWith: viewer andUpdates: false.! ! !ChessGame methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:46'! with: player1 and: player2 viewedWithUpdatesVia: viewer self setupWith: player1 and: player2. viewer show: board and: scoreSheet. self doGameLoopWith: viewer andUpdates: true.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessGame class instanceVariableNames: ''! !ChessGame class methodsFor: 'convenience' stamp: 'SdJ 12/16/2022 15:38'! otherColor: aColor aColor = Color black ifTrue: [ ^ Color white ] ifFalse: [ ^ Color black ]! ! !ChessGame class methodsFor: 'instance creation' stamp: 'SdJ 11/30/2022 18:30'! with: player1 and: player2 viewedWith: viewer ^ self new with: player1 and: player2 viewedWith: viewer! ! !ChessGame class methodsFor: 'instance creation' stamp: 'SdJ 12/16/2022 14:50'! with: player1 and: player2 viewedWithUpdatesVia: viewer ^ self new with: player1 and: player2 viewedWithUpdatesVia: viewer! ! Object subclass: #ChessGameState instanceVariableNames: 'pawnInEnPassantPosition pawnCanBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:05'! pawnCanBeCapturedEnPassant ^ pawnCanBeCapturedEnPassant! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:05'! pawnCanBeCapturedEnPassant: aBoolean pawnCanBeCapturedEnPassant := aBoolean! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:04'! pawnInEnPassantPosition ^ pawnInEnPassantPosition! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:04'! pawnInEnPassantPosition: piece pawnInEnPassantPosition := piece! ! Object subclass: #ChessMove instanceVariableNames: 'from to' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessMove commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I represent a move on the board.! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 1/22/2023 14:25'! = aMove ^ (from = aMove from) & (to = aMove to)! ! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 19:22'! from ^ from! ! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 19:22'! to ^ to! ! !ChessMove methodsFor: 'printing' stamp: 'SdJ 12/31/2022 10:04'! printOn: aStream ^ aStream nextPutAll: (from name, ' - ', to name)! ! !ChessMove methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:19'! from: squareName1 to: squareName2 from := squareName1. to := squareName2.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessMove class instanceVariableNames: ''! !ChessMove class methodsFor: 'instance creation' stamp: 'SdJ 12/3/2022 14:38'! from: square1 to: square2 ^ self new from: square1 to: square2! ! Object subclass: #ChessPiece instanceVariableNames: 'color square hasMoved singleCharRepresentation' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPiece commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I am an abstract chess piece.! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 19:40'! asChar ^ singleCharRepresentation! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/10/2022 19:33'! color ^ color! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:23'! color: aColor color := aColor! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 1/15/2023 13:49'! hasMoved ^ hasMoved! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 1/15/2023 13:49'! hasMoved: aBoolean hasMoved := aBoolean! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:40'! square ^ square! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:24'! square: aSquare square := aSquare! ! !ChessPiece methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:16'! isAttacking: aSquare ^ self subclassResponsibility! ! !ChessPiece methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:09'! permittedMoves ^ self subclassResponsibility! ! !ChessPiece methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:28'! initializeWith: aChar super initialize. singleCharRepresentation := aChar. hasMoved := false.! ! !ChessPiece methodsFor: 'printing' stamp: 'SdJ 12/17/2022 14:25'! printOn: aStream ^ aStream nextPutAll: ((color = Color white ifTrue: [ 'w' ] ifFalse: [ 'b' ]), (singleCharRepresentation asString))! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessPiece class instanceVariableNames: ''! !ChessPiece class methodsFor: 'instance creation' stamp: 'SdJ 11/27/2022 11:36'! newWithColor: aColor ^ self new color: aColor! ! ChessPiece subclass: #Bishop instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Bishop commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I move diagonally on the board.! !Bishop methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:17'! isAttacking: aSquare ^ (square color = aSquare color) and: [(square attacks: aSquare via: Bishop directions)]! ! !Bishop methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 14:20'! permittedMoves "Permitted moves are: All squares along diagonal lines from the currently occupied square." ^ square permittedMovesIn: Bishop directions! ! !Bishop methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:28'! initialize super initializeWith: 'B'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Bishop class instanceVariableNames: ''! !Bishop class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:20'! directions ^ Array newFrom: { #(1 1). #(1 -1). #(-1 -1). #(-1 1) }! ! Object subclass: #ChessPieceState instanceVariableNames: 'piece square hasMoved canBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPieceState commentStamp: 'SdJ 2/10/2023 12:15' prior: 0! I hold all the data that is necessary for restoring a Piece to its previous state.! !ChessPieceState methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 15:02'! restoreToPiece piece square isNil ifFalse: [ piece square makeEmpty ]. square piece: piece. piece hasMoved: hasMoved. (piece isKindOf: Pawn) ifTrue: [ piece canBeCapturedEnPassant: canBeCapturedEnPassant ].! ! !ChessPieceState methodsFor: 'initialize-release' stamp: 'SdJ 2/11/2023 11:33'! from: aPiece piece := aPiece. square := aPiece square. hasMoved := aPiece hasMoved. (aPiece isKindOf: Pawn) ifTrue: [ canBeCapturedEnPassant := aPiece canBeCapturedEnPassant ].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessPieceState class instanceVariableNames: ''! !ChessPieceState class methodsFor: 'instance creation' stamp: 'SdJ 2/10/2023 13:16'! from: piece ^ self new from: piece! ! Object subclass: #ChessPlayer instanceVariableNames: 'color name game' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPlayer commentStamp: 'SdJ 12/23/2022 15:33' prior: 0! I am an abstract chess player.! !ChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 14:11'! nextMoveFrom: permittedMoves on: board ^ self SubclassResponsibility! ! !ChessPlayer methodsFor: 'game playing' stamp: 'SdJ 12/9/2022 13:31'! promotionChoice ^ self SubclassResponsibility! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:11'! color ^ color! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:25'! color: aColor color := aColor! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/23/2022 15:39'! game: aGame game := aGame! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 18:48'! name ^ self SubclassResponsibility! ! ChessPlayer subclass: #ComputerChessPlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ComputerChessPlayer commentStamp: 'SdJ 12/23/2022 15:33' prior: 0! I am an abstract computer chess player.! ChessPlayer subclass: #HumanChessPlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !HumanChessPlayer commentStamp: 'SdJ 12/23/2022 15:34' prior: 0! I am a human chess player, the user must provide me with his/her name and moves.! !HumanChessPlayer methodsFor: 'private' stamp: 'SdJ 1/22/2023 14:12'! askForSquareAt: board with: prompt "Return either a valid square or nil." | squareName square | [ (squareName := UIManager default request: prompt) isEmpty ifTrue: [ ^ nil ] ifFalse: [ square := board squareAt: squareName ] ] doWhileTrue: [ square isNil ]. ^ square! ! !HumanChessPlayer methodsFor: 'private' stamp: 'SdJ 1/21/2023 14:00'! show: permittedMoves Transcript cr; cr; show: (permittedMoves size); show: ' permitted move'. permittedMoves size > 1 ifTrue: [ Transcript show: 's' ]. Transcript show: ':'; cr. permittedMoves do: [ :move | Transcript show: move; cr. ]! ! !HumanChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/22/2023 14:33'! nextMoveFrom: permittedMoves on: board "Answer a valid move or nil, which means: player quits." | from to move isPermittedMove | self show: permittedMoves. [(from := self askForSquareAt: board with: 'Move from square...') isNil ifTrue: [ ^ nil ] ifFalse: [ (to := self askForSquareAt: board with: '...to square?') isNil ifTrue: [ ^ nil ] ifFalse: [ move := ChessMove from: from to: to. (isPermittedMove := (permittedMoves indexOf: move) > 0) ifFalse: [ UIManager default inform: ('Illegal move!!') ] ] ] ] doWhileFalse: [ isPermittedMove ]. ^ move! ! !HumanChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/15/2023 12:11'! promotionChoice | pieceClassNames pieceClassName | pieceClassNames := #(Queen Rook Bishop Knight). pieceClassName := UIManager default chooseFrom: pieceClassNames values: pieceClassNames title: 'To what should the pawn be promoted?'. ^ (Smalltalk at: pieceClassName) new color: color! ! !HumanChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/4/2022 19:27'! name name isNil ifTrue: [ name := UIManager default request: 'Name?' ]. ^ name! ! ChessPiece subclass: #King instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !King commentStamp: 'SdJ 12/23/2022 15:25' prior: 0! I cannot be captured, but I can be put in check.! !King methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:38'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: King relativePositions! ! !King methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:54'! permittedMoves "Permitted moves are: All squares at distance 1 that are empty or occupied by opponent, as well as castling moves." ^ (OrderedCollection newFrom: (square permittedMovesFor: King relativePositions)) addAll: self castlingMoves; yourself! ! !King methodsFor: 'private' stamp: 'SdJ 1/15/2023 14:05'! castlingMoves | moves | moves := OrderedCollection new. hasMoved ifFalse: [ moves addAll: (square queenSideCastlingMove); addAll: (square kingSideCastlingMove) ]. ^ moves! ! !King methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'K'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! King class instanceVariableNames: ''! !King class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 13:53'! relativePositions ^ Array newFrom: { #(0 1). #(1 1). #(1 0). #(1 -1). #(0 -1). #(-1 -1). #(-1 0). #(-1 1) }! ! ChessPiece subclass: #Knight instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Knight commentStamp: 'SdJ 12/23/2022 15:25' prior: 0! I move in peculiar ways on the board.! !Knight methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:38'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: Knight relativePositions! ! !Knight methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:12'! permittedMoves "Permitted moves are: All squares at relative positions (+/-1, +/-2) / (+/-2, +/-1) that are empty or occupied by opponent." ^ square permittedMovesFor: Knight relativePositions ! ! !Knight methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'N'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Knight class instanceVariableNames: ''! !Knight class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 13:11'! relativePositions ^ Array newFrom: { #(1 2). #(2 1). #(2 -1). #(1 -2). #(-1 -2). #(-2 -1). #(-2 1). #(-1 2) }! ! ChessPiece subclass: #Pawn instanceVariableNames: 'canBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Pawn commentStamp: 'SdJ 2/10/2023 11:42' prior: 0! I move in small steps on the board, with some exceptions.! !Pawn methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:39'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: Pawn relativePositions! ! !Pawn methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:09'! permittedMoves ^ (OrderedCollection newFrom: self squaresAhead) addAll: self squareDiagonallyLeftAhead; addAll: self squareDiagonallyRightAhead; addAll: self enPassantMove; yourself! ! !Pawn methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 10:39'! canBeCapturedEnPassant ^ canBeCapturedEnPassant! ! !Pawn methodsFor: 'accessing' stamp: 'SdJ 12/24/2022 09:07'! canBeCapturedEnPassant: value canBeCapturedEnPassant := value! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/18/2023 12:08'! enPassantMove | eligibleMoves | eligibleMoves := OrderedCollection new. (square isOnEnPassantRankFor: color) ifTrue: [ square isOnLeftMostFile ifFalse: [ eligibleMoves addAll: (self enPassantMoveFor: (square square: 0 aheadFrom: square file - 1 and: square rank)) ]. square isOnRightMostFile ifFalse: [ eligibleMoves addAll: (self enPassantMoveFor: (square square: 0 aheadFrom: square file + 1 and: square rank)) ]. ]. ^ eligibleMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:13'! enPassantMoveFor: adjacentSquare | eligibleMoves squareDiagonallyAhead | eligibleMoves := OrderedCollection new. squareDiagonallyAhead := square square: 1 aheadFrom: adjacentSquare file and: adjacentSquare rank. ((adjacentSquare isOccupiedByPieceNotBeing: self color) and: [ (adjacentSquare piece isKindOf: Pawn) and: [ adjacentSquare piece canBeCapturedEnPassant and: [ squareDiagonallyAhead isEmpty ]]]) ifTrue: [ eligibleMoves add: (square moveTo: squareDiagonallyAhead) ]. ^ eligibleMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 12/18/2022 14:44'! squareDiagonallyLeftAhead | eligibleMoves squareDiagonallyAhead | eligibleMoves := OrderedCollection new. square isOnLeftMostFile ifFalse: [ squareDiagonallyAhead := square square: 1 aheadFrom: square file - 1 and: square rank. (squareDiagonallyAhead isOccupiedByPieceNotBeing: color) ifTrue: [ eligibleMoves add: (square moveTo: squareDiagonallyAhead). ] ]. ^ eligibleMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 12/18/2022 14:44'! squareDiagonallyRightAhead | eligibleMoves squareDiagonallyAhead | eligibleMoves := OrderedCollection new. square isOnRightMostFile ifFalse: [ squareDiagonallyAhead := square square: 1 aheadFrom: square file + 1 and: square rank. (squareDiagonallyAhead isOccupiedByPieceNotBeing: color) ifTrue: [ eligibleMoves add: (square moveTo: squareDiagonallyAhead). ] ]. ^ eligibleMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 12/18/2022 14:45'! squaresAhead | eligibleMoves squareAhead twoSquaresAhead | eligibleMoves := OrderedCollection new. squareAhead := square numberOfSquaresAhead: 1. squareAhead isEmpty ifTrue: [ eligibleMoves add: (square moveTo: squareAhead). hasMoved ifFalse: [ twoSquaresAhead := square numberOfSquaresAhead: 2. twoSquaresAhead isEmpty ifTrue: [ eligibleMoves add: (square moveTo: twoSquaresAhead). ] ] ]. ^ eligibleMoves! ! !Pawn methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'P'. canBeCapturedEnPassant := false.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Pawn class instanceVariableNames: ''! !Pawn class methodsFor: 'constants' stamp: 'SdJ 1/28/2023 09:44'! relativePositions ^ Array newFrom: { #(-1 1). #(1 1) }! ! ChessPiece subclass: #Queen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Queen commentStamp: 'SdJ 12/23/2022 15:24' prior: 0! I move diagonally, horizontally and vertically on the board.! !Queen methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:16'! isAttacking: aSquare ^ square attacks: aSquare via: Queen directions! ! !Queen methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 14:33'! permittedMoves "Permitted moves are: All squares along the same file or rank as the currently occupied square and along diagonal lines from the currently occupied square." ^ square permittedMovesIn: Queen directions! ! !Queen methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'Q'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Queen class instanceVariableNames: ''! !Queen class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:32'! directions ^ Array newFrom: { #(0 1). #(1 1). #(1 0). #(1 -1). #(0 -1). #(-1 -1). #(-1 0). #(-1 1) }! ! ComputerChessPlayer subclass: #RandomMovePlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !RandomMovePlayer commentStamp: 'SdJ 2/10/2023 11:43' prior: 0! I play chess by making random, but legal, moves.! !RandomMovePlayer methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 14:15'! nextMoveFrom: permittedMoves on: board "Precondition: permittedMoves is not empty." ^ permittedMoves atRandom! ! !RandomMovePlayer methodsFor: 'game playing' stamp: 'SdJ 12/9/2022 13:31'! promotionChoice ^ Queen new color: color! ! !RandomMovePlayer methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 13:20'! name ^ 'Bobby Fischer'! ! ChessPiece subclass: #Rook instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Rook commentStamp: 'SdJ 12/23/2022 15:24' prior: 0! I move horizontally and vertically on the board.! !Rook methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:27'! isAttacking: aSquare ^ ((square file = aSquare file) | (square rank = aSquare rank)) and: [(square attacks: aSquare via: Rook directions)]! ! !Rook methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:23'! permittedMoves "Permitted moves are: All squares along the same file or rank as the currently occupied square." ^ square permittedMovesIn: (Array newFrom: { #(1 0). #(0 1). #(0 -1). #(-1 0) })! ! !Rook methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'R'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Rook class instanceVariableNames: ''! !Rook class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:34'! directions ^ Array newFrom: { #(1 0). #(0 1). #(0 -1). #(-1 0) }! ! \ No newline at end of file +Object subclass: #ChessBoard instanceVariableNames: 'blackPlayerName whitePlayerName squares mapFromNameToIndex isInProbingMode undoStack' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoard commentStamp: 'SdJ 12/23/2022 15:20' prior: 0! I hold squares, which may in turn hold pieces. I also know the names of the players.! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 14:28'! blackPlayerName ^ blackPlayerName! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:13'! blackPlayerName: name blackPlayerName := name! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 14:38'! isInProbingMode ^ isInProbingMode! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 14:38'! isInProbingMode: aBoolean isInProbingMode := aBoolean! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 1/27/2023 13:01'! kingWithColor: color ^ ((self piecesWithColor: color) select: [ :p | p isKindOf: King ]) first! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 15:25'! piecesWithColor: color ^ ((squares collect: [ :s | s piece ]) select: [ :p | p isNil not ]) select: [ :p | p color = color ]! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 1/22/2023 13:39'! squareAt: positionName | index | index := mapFromNameToIndex at: positionName ifAbsent: [ ^ nil ]. ^ self squareAtIndex: index.! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:18'! squareAt: file and: rank ^ self squareAtIndex: (8 * (rank - 1) + file) "8 = ChessBoard fileDesignators size."! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:24'! squareAtIndex: index ^ squares at: index! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 11/27/2022 13:24'! squares ^ squares! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 14:28'! whitePlayerName ^ whitePlayerName! ! !ChessBoard methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:15'! whitePlayerName: name whitePlayerName := name! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 10:22'! makeEmpty: square square isEmpty ifFalse: [ isInProbingMode ifTrue: [ undoStack push: (ChessPieceState from: square piece) ]. square makeEmpty. ]! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 12:02'! put: piece on: square self makeEmpty: square. isInProbingMode ifTrue: [ undoStack push: (ChessPieceState from: piece) ]. piece square isNil ifFalse: [ piece square makeEmpty ]. "Can happen in case of pawn promotion." square piece: piece. piece hasMoved: true.! ! !ChessBoard methodsFor: 'moving pieces' stamp: 'SdJ 2/11/2023 11:36'! undoMoves [ undoStack isEmpty ] whileFalse: [ undoStack pop restoreToPiece ]! ! !ChessBoard methodsFor: 'private' stamp: 'SdJ 1/14/2023 13:54'! initializeSquares | color firstColor index positionName | squares := Array new: (ChessBoard fileDesignators size * ChessBoard numberOfRanks). mapFromNameToIndex := Dictionary new. firstColor := Color white. index := 1. 1 to: ChessBoard numberOfRanks do: [ :rank | firstColor := ChessGame otherColor: firstColor. color := firstColor. ChessBoard fileDesignators do: [ :file | positionName := (file asString) , (rank asString). squares at: index put: ((ChessBoardSquare withColor: color onPosition: positionName) board: self). mapFromNameToIndex at: positionName put: index. index := index + 1. color := ChessGame otherColor: color ] ]! ! !ChessBoard methodsFor: 'private' stamp: 'SdJ 12/16/2022 15:37'! setup (self squareAt: 'a1') piece: (Rook newWithColor: Color white). (self squareAt: 'b1') piece: (Knight newWithColor: Color white). (self squareAt: 'c1') piece: (Bishop newWithColor: Color white). (self squareAt: 'd1') piece: (Queen newWithColor: Color white). (self squareAt: 'e1') piece: (King newWithColor: Color white). (self squareAt: 'f1') piece: (Bishop newWithColor: Color white). (self squareAt: 'g1') piece: (Knight newWithColor: Color white). (self squareAt: 'h1') piece: (Rook newWithColor: Color white). (self squareAt: 'a2') piece: (Pawn newWithColor: Color white). (self squareAt: 'b2') piece: (Pawn newWithColor: Color white). (self squareAt: 'c2') piece: (Pawn newWithColor: Color white). (self squareAt: 'd2') piece: (Pawn newWithColor: Color white). (self squareAt: 'e2') piece: (Pawn newWithColor: Color white). (self squareAt: 'f2') piece: (Pawn newWithColor: Color white). (self squareAt: 'g2') piece: (Pawn newWithColor: Color white). (self squareAt: 'h2') piece: (Pawn newWithColor: Color white). (self squareAt: 'a8') piece: (Rook newWithColor: Color black). (self squareAt: 'b8') piece: (Knight newWithColor: Color black). (self squareAt: 'c8') piece: (Bishop newWithColor: Color black). (self squareAt: 'd8') piece: (Queen newWithColor: Color black). (self squareAt: 'e8') piece: (King newWithColor: Color black). (self squareAt: 'f8') piece: (Bishop newWithColor: Color black). (self squareAt: 'g8') piece: (Knight newWithColor: Color black). (self squareAt: 'h8') piece: (Rook newWithColor: Color black). (self squareAt: 'a7') piece: (Pawn newWithColor: Color black). (self squareAt: 'b7') piece: (Pawn newWithColor: Color black). (self squareAt: 'c7') piece: (Pawn newWithColor: Color black). (self squareAt: 'd7') piece: (Pawn newWithColor: Color black). (self squareAt: 'e7') piece: (Pawn newWithColor: Color black). (self squareAt: 'f7') piece: (Pawn newWithColor: Color black). (self squareAt: 'g7') piece: (Pawn newWithColor: Color black). (self squareAt: 'h7') piece: (Pawn newWithColor: Color black).! ! !ChessBoard methodsFor: 'initialize-release' stamp: 'SdJ 2/10/2023 14:37'! initialize super initialize. self initializeSquares ; setup. isInProbingMode := false. undoStack := Stack new.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessBoard class instanceVariableNames: ''! !ChessBoard class methodsFor: 'constants' stamp: 'SdJ 12/31/2022 11:12'! fileDesignators ^ 'abcdefgh'! ! !ChessBoard class methodsFor: 'constants' stamp: 'SdJ 12/31/2022 11:09'! numberOfRanks ^ 8! ! !ChessBoard class methodsFor: 'instance creation' stamp: 'SdJ 12/3/2022 14:24'! with: whitePlayerName and: blackPlayerName ^ self new blackPlayerName: blackPlayerName; whitePlayerName: whitePlayerName! ! Object subclass: #ChessBoardSquare instanceVariableNames: 'board file rank name color piece' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardSquare commentStamp: 'SdJ 12/23/2022 15:21' prior: 0! I am a square on the board and may hold a piece. I can be used to access other squares as well.! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 1/27/2023 13:21'! = aSquare ^ (file = aSquare file) & (rank = aSquare rank)! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 17:36'! board: aBoard board := aBoard! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 1/28/2023 09:46'! color ^ color! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 15:01'! file ^ file! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 19:07'! isEmpty ^ piece isNil! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 11:41'! isOccupiedByPieceNotBeing: color "Answer whether self is not empty, but occupied by a piece of the other color. Special provisions for self being a King." self isEmpty ifTrue: [ ^ false ] ifFalse: [ (self piece color) = color ifTrue: [ ^ false ] ifFalse: [ ^ (self piece isKindOf: King) not ] ]! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 10:26'! isOnEnPassantRankFor: color (color = Color white) ifTrue: [ ^ rank = 5 ] ifFalse: [ ^ rank = 4 ]! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:19'! isOnLastRank ^ (rank = 1) | (rank = 8) "8 = ChessBoard numberOfRanks."! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 18:56'! isOnLeftMostFile ^ file = 1! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:19'! isOnRightMostFile ^ file = 8 "8 = ChessBoard fileDesignators size."! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 13:48'! makeEmpty piece square: nil. piece := nil.! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/4/2022 16:19'! name ^ name! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/5/2023 19:06'! numberOfSquaresAhead: number ^ self square: number aheadFrom: file and: rank! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:30'! piece ^ piece! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:22'! piece: aPiece piece := aPiece. piece isNil ifFalse: [ piece square: self ].! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 15:01'! rank ^ rank! ! !ChessBoardSquare methodsFor: 'accessing' stamp: 'SdJ 2/5/2023 19:03'! square: number aheadFrom: aFile and: aRank "Answer the Square number of squares straight ahead. The orientation depends on the color." ^ board squareAt: aFile and: (piece color = Color white ifTrue: [ aRank + number ] ifFalse: [ aRank - number ])! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:35'! attacks: aSquare via: directions "Answer whether the piece on the receiver attacks aSquare in any of the given directions." directions do: [ :direction | (self attacks: aSquare viaSingle: direction) ifTrue: [ ^ true ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:37'! attacks: aSquare viaOneOf: relativePositions "Answer whether the piece on the receiver attacks aSquare via one of the given relative positions." relativePositions do: [ :relativePosition | | proposedFile proposedRank | proposedFile := file + relativePosition at: 1. proposedRank := rank + relativePosition at: 2. (ChessBoardSquare isLegitCombinationOf: proposedFile and: proposedRank) ifTrue: [ (board squareAt: proposedFile and: proposedRank) = aSquare ifTrue: [ ^ true ] ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 2/3/2023 16:18'! isAttackedBy: aColor "Answer whether the receiver is attacked by any piece with aColor." (board piecesWithColor: aColor) do: [ :aPiece | (aPiece isAttacking: self) ifTrue: [ ^ true ] ]. ^ false! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/21/2023 15:29'! kingSideCastlingMove ^ self castlingMoveFor: 8 "Rightmost file."! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 12/31/2022 09:58'! moveTo: otherSquare ^ ChessMove from: self to: otherSquare! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:30'! permittedMovesFor: relativePositions | permittedMoves | permittedMoves := OrderedCollection new. (self permittedSquaresFrom: relativePositions) do: [ :destinationSquare | permittedMoves add: (self moveTo: destinationSquare) ]. ^ permittedMoves! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:30'! permittedMovesIn: directions | permittedMoves legitDestinationSquares | legitDestinationSquares := OrderedCollection new. directions do: [ :direction | legitDestinationSquares addAll: (self permittedSquaresIn: direction) ]. permittedMoves := OrderedCollection new. legitDestinationSquares do: [ :destinationSquare | permittedMoves add: (self moveTo: destinationSquare) ]. ^ permittedMoves! ! !ChessBoardSquare methodsFor: 'game playing' stamp: 'SdJ 1/21/2023 15:29'! queenSideCastlingMove ^ self castlingMoveFor: 1 "Leftmost file."! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:25'! allSquaresAreNotAttackedBetween: startFile and: endFile "Precondition: the King is located at self. Checked by this method: none of the following squares are attacked: * The current position of the King * The position to which the King wants to move * Any positions in between The squares checked are at the same rank as the receiver and include the start file and end file." | otherColor | otherColor := ChessGame otherColor: self piece color. startFile to: endFile do: [ :intermediateFile | ((board squareAt: intermediateFile and: rank) isAttackedBy: otherColor) ifTrue: [ ^ false ]. ]. ^ true! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:48'! allSquaresAreNotOccupiedBetween: startFile and: endFile "Precondition: the King is located at self." startFile to: endFile do: [ :intermediateFile | (board squareAt: intermediateFile and: rank) isEmpty ifFalse: [ ^ false ]. ]. ^ true! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:24'! allSquaresBetweenKingAndRookAreNotOccupied: fileOfRook "Precondition: the King is located at self. This method also checks: none of the following squares are attacked: * The current position of the King * The position to which the King wants to move * Any positions in between" (self isAttackedBy: (ChessGame otherColor: self piece color)) ifTrue: [ ^ false ]. fileOfRook = 1 ifTrue: [ ^ (self allSquaresAreNotOccupiedBetween: fileOfRook + 1 and: file - 1) and: [ self allSquaresAreNotAttackedBetween: file - 2 and: file - 1 ] ] ifFalse: [ ^ (self allSquaresAreNotOccupiedBetween: file + 1 and: fileOfRook - 1) and: [ self allSquaresAreNotAttackedBetween: file + 1 and: file + 2 ] ]! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/29/2023 19:36'! attacks: aSquare viaSingle: direction "Answer whether the piece on the receiver attacks aSquare in the given direction." | currentFile currentRank currentSquare | currentFile := file. currentRank := rank. [ currentFile := currentFile + direction at: 1. currentRank := currentRank + direction at: 2. (ChessBoardSquare isLegitCombinationOf: currentFile and: currentRank) ifTrue: [ ((currentSquare := board squareAt: currentFile and: currentRank) = aSquare) ifTrue: [ ^ true ] ifFalse: [ currentSquare isEmpty ifFalse: [ ^ false ] ] ] ifFalse: [ ^ false ] ] repeat! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/5/2023 18:55'! castlingMoveFor: fileOfRook "Precondition: the King (at self) has not moved." | moves horizontalDirection | moves := OrderedCollection new. (self rookIsUnmovedAt: fileOfRook and: rank) ifFalse: [ ^ moves ]. (self allSquaresBetweenKingAndRookAreNotOccupied: fileOfRook) ifFalse: [ ^ moves ]. horizontalDirection := fileOfRook = 1 ifTrue: [ -1 ] ifFalse: [ 1 ]. moves add: (self moveTo: (board squareAt: file + (2 * horizontalDirection) and: rank)). ^ moves! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/27/2023 13:24'! legitSquaresFrom: relativePositions "Answer a collection of ChessBoardSquares. For each of relativePositions, determine if the position is legit. If so, add it to the collection. A relative position is a (horizontalOffset, verticalOffset) pair." | squares | squares := OrderedCollection new. relativePositions do: [ :relativePosition | | proposedFile proposedRank | proposedFile := file + relativePosition at: 1. proposedRank := rank + relativePosition at: 2. (ChessBoardSquare isLegitCombinationOf: proposedFile and: proposedRank) ifTrue: [ squares add: (board squareAt: proposedFile and: proposedRank) ] ]. ^ squares! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:06'! permittedSquaresFrom: relativePositions ^ (self legitSquaresFrom: relativePositions) select: [ :s | s isEmpty or: [ s isOccupiedByPieceNotBeing: piece color ] ]! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 2/3/2023 16:06'! permittedSquaresIn: direction "Answer a collection of ChessBoardSquares. Add all squares in the given direction as long as: - the position is legit - the square is empty - the square is occupied by an opponent piece (then stop) Also stop if the square is occupied by a friendly piece. direction is a (horizontalOffset, verticalOffset) pair." | squares currentFile currentRank currentSquare | squares := OrderedCollection new. currentFile := file. currentRank := rank. [ currentFile := currentFile + direction at: 1. currentRank := currentRank + direction at: 2. (ChessBoardSquare isLegitCombinationOf: currentFile and: currentRank) ifTrue: [ currentSquare := board squareAt: currentFile and: currentRank. (currentSquare isEmpty or: [ currentSquare isOccupiedByPieceNotBeing: piece color ]) ifTrue: [ squares add: currentSquare ]. currentSquare isEmpty ifFalse: [ ^ squares ] ] ifFalse: [ ^ squares ] ] repeat.! ! !ChessBoardSquare methodsFor: 'private' stamp: 'SdJ 1/21/2023 14:35'! rookIsUnmovedAt: fileOfRook and: rankOfRook | rookSquare pieceAtRookSquare | rookSquare := board squareAt: fileOfRook and: rankOfRook. rookSquare isEmpty ifTrue: [ ^ false ]. pieceAtRookSquare := rookSquare piece. ^ (pieceAtRookSquare isKindOf: Rook) and: [ pieceAtRookSquare hasMoved not ]! ! !ChessBoardSquare methodsFor: 'printing' stamp: 'SdJ 12/17/2022 14:23'! printOn: aStream ^ aStream print: name, '(', (color = Color white ifTrue: [ 'w' ] ifFalse: [ 'b' ]), ') : ', piece! ! !ChessBoardSquare methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 11:20'! withColor: aColor onPosition: aName color := aColor. name := aName. rank := (aName last: 1) asInteger. file := ChessBoard fileDesignators findString: (aName first: 1).! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessBoardSquare class instanceVariableNames: ''! !ChessBoardSquare class methodsFor: 'convenience' stamp: 'SdJ 12/31/2022 11:24'! isLegitCombinationOf: file and: rank "First 8 = ChessBoard fileDesignators size, second 8 = ChessBoard numberOfRanks." ^ file >= 1 and: [file <= 8 and: [rank >= 1 and: [rank <= 8]]]! ! !ChessBoardSquare class methodsFor: 'convenience' stamp: 'SdJ 12/24/2022 09:17'! isOnEnPassantRank: color ^ false! ! !ChessBoardSquare class methodsFor: 'instance creation' stamp: 'SdJ 11/27/2022 11:36'! withColor: aColor onPosition: aName ^ self new withColor: aColor onPosition: aName! ! Object subclass: #ChessBoardViewer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardViewer commentStamp: 'SdJ 12/23/2022 15:21' prior: 0! I am an abstract chess board viewer.! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 14:08'! ask: player forNextMoveFrom: permittedMoves on: board ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 10:48'! declareStaleMate ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'interacting' stamp: 'SdJ 12/4/2022 19:06'! declareWinner: player ^ self subclassResponsibility! ! !ChessBoardViewer methodsFor: 'viewing' stamp: 'SdJ 12/9/2022 19:12'! show: aChessBoard and: aScoreSheet ^ self subclassResponsibility! ! ChessBoardViewer subclass: #ChessBoardViewerOnTranscript instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessBoardViewerOnTranscript commentStamp: 'SdJ 12/23/2022 15:22' prior: 0! I show a chess board on the Transcript.! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 14:13'! ask: player forNextMoveFrom: permittedMoves on: board ^ player nextMoveFrom: permittedMoves on: board! ! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 1/14/2023 10:49'! declareStaleMate UIManager default inform: ('Stalemate!!')! ! !ChessBoardViewerOnTranscript methodsFor: 'interacting' stamp: 'SdJ 12/17/2022 14:21'! declareWinner: player UIManager default inform: ('The winner is ', player name, '!!')! ! !ChessBoardViewerOnTranscript methodsFor: 'private' stamp: 'SdJ 12/31/2022 11:22'! showBoard: aChessBoard | currentPiece | Transcript clear ; cr ; show: ('' expandMacros), (aChessBoard blackPlayerName) ; cr ; show: (' a b c d e f g h' expandMacros). 1 to: ChessBoard numberOfRanks do: [ :rank | Transcript show: String tab, (ChessBoard numberOfRanks + 1 - rank) asString, String tab. 1 to: ChessBoard fileDesignators size do: [ :file | currentPiece := (aChessBoard squareAtIndex: ChessBoard fileDesignators size * (ChessBoard numberOfRanks - rank) + file) piece. Transcript show: (currentPiece isNil ifTrue: [ '__' ] ifFalse: [ currentPiece asString ]), String tab. ]. Transcript show: (ChessBoard numberOfRanks + 1 - rank) asString ; cr. ]. Transcript show: (' a b c d e f g h' expandMacros) ; cr ; show: ('' expandMacros), (aChessBoard whitePlayerName) ; cr. ! ! !ChessBoardViewerOnTranscript methodsFor: 'private' stamp: 'SdJ 12/17/2022 14:22'! showScoreSheet: aScoreSheet | moveCounter | moveCounter := 1. Transcript cr. aScoreSheet do: [ :move | moveCounter \\ 2 = 0 ifFalse: [ Transcript show: (((moveCounter + 1) / 2) asString), String tab, move ] ifTrue: [ Transcript show: String tab, move ; cr ]. moveCounter := moveCounter + 1 ]! ! !ChessBoardViewerOnTranscript methodsFor: 'viewing' stamp: 'SdJ 12/16/2022 14:22'! show: aChessBoard and: aScoreSheet self showBoard: aChessBoard. self showScoreSheet: aScoreSheet.! ! Object subclass: #ChessGame instanceVariableNames: 'board blackPlayer whitePlayer currentPlayer viewer maximumNumberOfMoves showEachMove scoreSheet pawnInEnPassantPosition kingIsInCheck state' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessGame commentStamp: 'SdJ 12/23/2022 15:22' prior: 0! I control the turns and decide when the game is finished. I use a board and a viewer.! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 15:42'! addToScoreSheet: moveAsString board isInProbingMode ifFalse: [ scoreSheet add: moveAsString, (self kingOfOtherPlayerIsInCheck ifTrue: [ '+' ] ifFalse: [ '' ]) ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 15:45'! addToScoreSheet: move with: isCapture and: promotedTo self addToScoreSheet: move from name, (isCapture ifTrue: [ 'x' ] ifFalse: [ '-' ]), move to name, (promotedTo isNil ifTrue: [ '' ] ifFalse: [ promotedTo asChar ])! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:12'! checkWouldResultAfter: move | kingWouldBeInCheck | self saveState. self execute: move. kingWouldBeInCheck := self kingOfCurrentPlayerIsInCheck. board undoMoves. self restoreState. ^ kingWouldBeInCheck! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 11:43'! determineStaleMateOrWinner kingIsInCheck ifTrue: [ viewer declareWinner: (self otherPlayer) ] ifFalse: [ viewer declareStaleMate ]. ^ nil! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:56'! doGameLoopWith: aViewer andUpdates: mustShowEachMove | permittedMoves nextMove | viewer := aViewer. showEachMove := mustShowEachMove. [ permittedMoves := self permittedMovesFor: currentPlayer color. permittedMoves isEmpty ifTrue: [ nextMove := self determineStaleMateOrWinner ] ifFalse: [ nextMove := self executeChosenMoveFrom: permittedMoves. ] ] doWhileFalse: [ self exceededMaximumNumberOfMoves | nextMove isNil ]. "Show the final position, if not done already." showEachMove ifFalse: [ viewer show: board and: scoreSheet ].! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:56'! exceededMaximumNumberOfMoves ^ scoreSheet size >= (maximumNumberOfMoves * 2)! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 10:56'! execute: move self resetEnPassant. (move from piece isKindOf: Pawn) ifTrue: [ self executePawnMove: move ] ifFalse: [ (move from piece isKindOf: King) ifTrue: [ self executeKingMove: move ] ifFalse: [ self executeOtherMove: move ] ].! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:21'! executeCastlingMove: move with: rookFile and: rookoffset | rookFromSquare rookToSquare notation | rookFromSquare := board squareAt: rookFile and: move from rank. rookToSquare := board squareAt: move to file + rookoffset and: move to rank. notation := '0-0', (rookFile = 1 ifTrue: '-0' ifFalse: ''). board put: rookFromSquare piece on: rookToSquare. self executeSimpleMove: move. self addToScoreSheet: notation.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:53'! executeChosenMoveFrom: permittedMoves | nextMove | (nextMove := viewer ask: currentPlayer forNextMoveFrom: permittedMoves on: board) isNil ifTrue: [ viewer declareWinner: (self otherPlayer) ] ifFalse: [ self execute: nextMove. showEachMove ifTrue: [ viewer show: board and: scoreSheet ]. currentPlayer := self otherPlayer. ]. ^ nextMove! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 12:47'! executeKingMove: move (move from file - move to file) abs > 1 ifTrue: [ move from file > move to file ifTrue: [ "Queenside." self executeCastlingMove: move with: 1 and: 1 "First 1 = leftmost file." ] ifFalse: [ "Kingside." self executeCastlingMove: move with: 8 and: -1 "8 = rightmost file." ]. ] ifFalse: [ self executeOtherMove: move ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 10:55'! executeOtherMove: move | isCapture | isCapture := move to isEmpty not. self executeSimpleMove: move. self addToScoreSheet: move with: isCapture and: nil.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 12:13'! executePawnMove: move | isCapture promotedTo isInitialMoveByTwoSquares | (isCapture := (move from file = move to file) not) ifTrue: [ move to isEmpty ifTrue: [ "En passant capture." board makeEmpty: (move from square: 0 aheadFrom: move to file and: move from rank). ]. self executeSimpleMove: move. ] ifFalse: [ (isInitialMoveByTwoSquares := (move from rank - move to rank) abs > 1) ifTrue: [ pawnInEnPassantPosition := move from piece. ]. (self executeSimpleMove: move) canBeCapturedEnPassant: isInitialMoveByTwoSquares. ]. promotedTo := self promotionChoiceIfApplicable: move. self addToScoreSheet: move with: isCapture and: promotedTo.! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:22'! executeSimpleMove: move "Answer the piece that has been moved." | piece | piece := move from piece. board put: piece on: move to. ^ piece! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/10/2023 12:03'! kingOfCurrentPlayerIsInCheck ^ (board kingWithColor: currentPlayer color) square isAttackedBy: self otherPlayer color! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/4/2023 10:22'! kingOfOtherPlayerIsInCheck ^ kingIsInCheck := (board kingWithColor: self otherPlayer color) square isAttackedBy: currentPlayer color! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 12/3/2022 19:00'! otherPlayer currentPlayer = whitePlayer ifTrue: [ ^ blackPlayer ] ifFalse: [ ^ whitePlayer ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:11'! permittedMovesFor: color | permittedMoves | board isInProbingMode: true. permittedMoves := OrderedCollection new. (board piecesWithColor: color) do: [ :piece | permittedMoves addAll: (piece permittedMoves reject: [ :move | self checkWouldResultAfter: move ]) ]. board isInProbingMode: false. ^ permittedMoves! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/11/2023 11:22'! promotionChoiceIfApplicable: move | promotedTo | move to isOnLastRank ifTrue: [ promotedTo := board isInProbingMode ifTrue: [ ^ Queen new color: currentPlayer color ] ifFalse: [ currentPlayer promotionChoice ]. board put: promotedTo on: move to. ]. ^ promotedTo! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/21/2023 19:22'! resetEnPassant pawnInEnPassantPosition isNil ifFalse: [ pawnInEnPassantPosition canBeCapturedEnPassant: false. pawnInEnPassantPosition := nil. ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:10'! restoreState pawnInEnPassantPosition := state pawnInEnPassantPosition. pawnInEnPassantPosition isNil ifFalse: [ pawnInEnPassantPosition canBeCapturedEnPassant: true ]! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 2/18/2023 13:08'! saveState state := ChessGameState new pawnInEnPassantPosition: pawnInEnPassantPosition; pawnCanBeCapturedEnPassant: (pawnInEnPassantPosition isNil not)! ! !ChessGame methodsFor: 'private' stamp: 'SdJ 1/27/2023 11:43'! setupWith: player1 and: player2 player1 game: self. player2 game: self. Random new next < 0.5 ifTrue: [ whitePlayer := player1 color: Color white. blackPlayer := player2 color: Color black. ] ifFalse: [ whitePlayer := player2 color: Color white. blackPlayer := player1 color: Color black. ]. board := ChessBoard with: whitePlayer name and: blackPlayer name. currentPlayer := whitePlayer. kingIsInCheck := false. scoreSheet := OrderedCollection new. maximumNumberOfMoves := 100. "TODO: pass this as a parameter."! ! !ChessGame methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:47'! with: player1 and: player2 viewedWith: viewer self setupWith: player1 and: player2. viewer show: board and: scoreSheet. self doGameLoopWith: viewer andUpdates: false.! ! !ChessGame methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:46'! with: player1 and: player2 viewedWithUpdatesVia: viewer self setupWith: player1 and: player2. viewer show: board and: scoreSheet. self doGameLoopWith: viewer andUpdates: true.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessGame class instanceVariableNames: ''! !ChessGame class methodsFor: 'convenience' stamp: 'SdJ 12/16/2022 15:38'! otherColor: aColor aColor = Color black ifTrue: [ ^ Color white ] ifFalse: [ ^ Color black ]! ! !ChessGame class methodsFor: 'instance creation' stamp: 'SdJ 11/30/2022 18:30'! with: player1 and: player2 viewedWith: viewer ^ self new with: player1 and: player2 viewedWith: viewer! ! !ChessGame class methodsFor: 'instance creation' stamp: 'SdJ 12/16/2022 14:50'! with: player1 and: player2 viewedWithUpdatesVia: viewer ^ self new with: player1 and: player2 viewedWithUpdatesVia: viewer! ! Object subclass: #ChessGameState instanceVariableNames: 'pawnInEnPassantPosition pawnCanBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:05'! pawnCanBeCapturedEnPassant ^ pawnCanBeCapturedEnPassant! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:05'! pawnCanBeCapturedEnPassant: aBoolean pawnCanBeCapturedEnPassant := aBoolean! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:04'! pawnInEnPassantPosition ^ pawnInEnPassantPosition! ! !ChessGameState methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 13:04'! pawnInEnPassantPosition: piece pawnInEnPassantPosition := piece! ! Object subclass: #ChessMove instanceVariableNames: 'from to' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessMove commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I represent a move on the board.! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 1/22/2023 14:25'! = aMove ^ (from = aMove from) & (to = aMove to)! ! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 19:22'! from ^ from! ! !ChessMove methodsFor: 'accessing' stamp: 'SdJ 12/3/2022 19:22'! to ^ to! ! !ChessMove methodsFor: 'printing' stamp: 'SdJ 12/31/2022 10:04'! printOn: aStream ^ aStream nextPutAll: (from name, ' - ', to name)! ! !ChessMove methodsFor: 'initialize-release' stamp: 'SdJ 12/16/2022 14:19'! from: squareName1 to: squareName2 from := squareName1. to := squareName2.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessMove class instanceVariableNames: ''! !ChessMove class methodsFor: 'instance creation' stamp: 'SdJ 12/3/2022 14:38'! from: square1 to: square2 ^ self new from: square1 to: square2! ! Object subclass: #ChessPiece instanceVariableNames: 'color square hasMoved singleCharRepresentation' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPiece commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I am an abstract chess piece.! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 19:40'! asChar ^ singleCharRepresentation! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/10/2022 19:33'! color ^ color! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:23'! color: aColor color := aColor! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 1/15/2023 13:49'! hasMoved ^ hasMoved! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 1/15/2023 13:49'! hasMoved: aBoolean hasMoved := aBoolean! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/31/2022 11:40'! square ^ square! ! !ChessPiece methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:24'! square: aSquare square := aSquare! ! !ChessPiece methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:16'! isAttacking: aSquare ^ self subclassResponsibility! ! !ChessPiece methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:09'! permittedMoves ^ self subclassResponsibility! ! !ChessPiece methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:28'! initializeWith: aChar super initialize. singleCharRepresentation := aChar. hasMoved := false.! ! !ChessPiece methodsFor: 'printing' stamp: 'SdJ 12/17/2022 14:25'! printOn: aStream ^ aStream nextPutAll: ((color = Color white ifTrue: [ 'w' ] ifFalse: [ 'b' ]), (singleCharRepresentation asString))! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessPiece class instanceVariableNames: ''! !ChessPiece class methodsFor: 'instance creation' stamp: 'SdJ 11/27/2022 11:36'! newWithColor: aColor ^ self new color: aColor! ! ChessPiece subclass: #Bishop instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Bishop commentStamp: 'SdJ 12/23/2022 15:23' prior: 0! I move diagonally on the board.! !Bishop methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:17'! isAttacking: aSquare ^ (square color = aSquare color) and: [(square attacks: aSquare via: Bishop directions)]! ! !Bishop methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 14:20'! permittedMoves "Permitted moves are: All squares along diagonal lines from the currently occupied square." ^ square permittedMovesIn: Bishop directions! ! !Bishop methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:28'! initialize super initializeWith: 'B'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Bishop class instanceVariableNames: ''! !Bishop class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:20'! directions ^ Array newFrom: { #(1 1). #(1 -1). #(-1 -1). #(-1 1) }! ! Object subclass: #ChessPieceState instanceVariableNames: 'piece square hasMoved canBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPieceState commentStamp: 'SdJ 2/10/2023 12:15' prior: 0! I hold all the data that is necessary for restoring a Piece to its previous state.! !ChessPieceState methodsFor: 'accessing' stamp: 'SdJ 2/10/2023 15:02'! restoreToPiece piece square isNil ifFalse: [ piece square makeEmpty ]. square piece: piece. piece hasMoved: hasMoved. (piece isKindOf: Pawn) ifTrue: [ piece canBeCapturedEnPassant: canBeCapturedEnPassant ].! ! !ChessPieceState methodsFor: 'initialize-release' stamp: 'SdJ 2/11/2023 11:33'! from: aPiece piece := aPiece. square := aPiece square. hasMoved := aPiece hasMoved. (aPiece isKindOf: Pawn) ifTrue: [ canBeCapturedEnPassant := aPiece canBeCapturedEnPassant ].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChessPieceState class instanceVariableNames: ''! !ChessPieceState class methodsFor: 'instance creation' stamp: 'SdJ 2/10/2023 13:16'! from: piece ^ self new from: piece! ! Object subclass: #ChessPlayer instanceVariableNames: 'color name game' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ChessPlayer commentStamp: 'SdJ 12/23/2022 15:33' prior: 0! I am an abstract chess player.! !ChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 14:11'! nextMoveFrom: permittedMoves on: board ^ self SubclassResponsibility! ! !ChessPlayer methodsFor: 'game playing' stamp: 'SdJ 12/9/2022 13:31'! promotionChoice ^ self SubclassResponsibility! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 19:11'! color ^ color! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/16/2022 14:25'! color: aColor color := aColor! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/23/2022 15:39'! game: aGame game := aGame! ! !ChessPlayer methodsFor: 'accessing' stamp: 'SdJ 11/30/2022 18:48'! name ^ self SubclassResponsibility! ! ChessPlayer subclass: #ComputerChessPlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !ComputerChessPlayer commentStamp: 'SdJ 12/23/2022 15:33' prior: 0! I am an abstract computer chess player.! ChessPlayer subclass: #HumanChessPlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !HumanChessPlayer commentStamp: 'SdJ 12/23/2022 15:34' prior: 0! I am a human chess player, the user must provide me with his/her name and moves.! !HumanChessPlayer methodsFor: 'private' stamp: 'SdJ 1/22/2023 14:12'! askForSquareAt: board with: prompt "Return either a valid square or nil." | squareName square | [ (squareName := UIManager default request: prompt) isEmpty ifTrue: [ ^ nil ] ifFalse: [ square := board squareAt: squareName ] ] doWhileTrue: [ square isNil ]. ^ square! ! !HumanChessPlayer methodsFor: 'private' stamp: 'SdJ 1/21/2023 14:00'! show: permittedMoves Transcript cr; cr; show: (permittedMoves size); show: ' permitted move'. permittedMoves size > 1 ifTrue: [ Transcript show: 's' ]. Transcript show: ':'; cr. permittedMoves do: [ :move | Transcript show: move; cr. ]! ! !HumanChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/22/2023 14:33'! nextMoveFrom: permittedMoves on: board "Answer a valid move or nil, which means: player quits." | from to move isPermittedMove | self show: permittedMoves. [(from := self askForSquareAt: board with: 'Move from square...') isNil ifTrue: [ ^ nil ] ifFalse: [ (to := self askForSquareAt: board with: '...to square?') isNil ifTrue: [ ^ nil ] ifFalse: [ move := ChessMove from: from to: to. (isPermittedMove := (permittedMoves indexOf: move) > 0) ifFalse: [ UIManager default inform: ('Illegal move!!') ] ] ] ] doWhileFalse: [ isPermittedMove ]. ^ move! ! !HumanChessPlayer methodsFor: 'game playing' stamp: 'SdJ 1/15/2023 12:11'! promotionChoice | pieceClassNames pieceClassName | pieceClassNames := #(Queen Rook Bishop Knight). pieceClassName := UIManager default chooseFrom: pieceClassNames values: pieceClassNames title: 'To what should the pawn be promoted?'. ^ (Smalltalk at: pieceClassName) new color: color! ! !HumanChessPlayer methodsFor: 'accessing' stamp: 'SdJ 12/4/2022 19:27'! name name isNil ifTrue: [ name := UIManager default request: 'Name?' ]. ^ name! ! ChessPiece subclass: #King instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !King commentStamp: 'SdJ 12/23/2022 15:25' prior: 0! I cannot be captured, but I can be put in check.! !King methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:38'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: King relativePositions! ! !King methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:54'! permittedMoves "Permitted moves are: All squares at distance 1 that are empty or occupied by opponent, as well as castling moves." ^ (OrderedCollection newFrom: (square permittedMovesFor: King relativePositions)) addAll: self castlingMoves; yourself! ! !King methodsFor: 'private' stamp: 'SdJ 1/15/2023 14:05'! castlingMoves | moves | moves := OrderedCollection new. hasMoved ifFalse: [ moves addAll: (square queenSideCastlingMove); addAll: (square kingSideCastlingMove) ]. ^ moves! ! !King methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'K'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! King class instanceVariableNames: ''! !King class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 13:53'! relativePositions ^ Array newFrom: { #(0 1). #(1 1). #(1 0). #(1 -1). #(0 -1). #(-1 -1). #(-1 0). #(-1 1) }! ! ChessPiece subclass: #Knight instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Knight commentStamp: 'SdJ 12/23/2022 15:25' prior: 0! I move in peculiar ways on the board.! !Knight methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:38'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: Knight relativePositions! ! !Knight methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 13:12'! permittedMoves "Permitted moves are: All squares at relative positions (+/-1, +/-2) / (+/-2, +/-1) that are empty or occupied by opponent." ^ square permittedMovesFor: Knight relativePositions ! ! !Knight methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'N'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Knight class instanceVariableNames: ''! !Knight class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 13:11'! relativePositions ^ Array newFrom: { #(1 2). #(2 1). #(2 -1). #(1 -2). #(-1 -2). #(-2 -1). #(-2 1). #(-1 2) }! ! ChessPiece subclass: #Pawn instanceVariableNames: 'canBeCapturedEnPassant' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Pawn commentStamp: 'SdJ 2/10/2023 11:42' prior: 0! I move in small steps on the board, with some exceptions.! !Pawn methodsFor: 'game playing' stamp: 'SdJ 2/24/2023 15:12'! isAttacking: aSquare ^ square attacks: aSquare viaOneOf: ((color = Color white) ifTrue: [ Pawn relativePositionsUp ] ifFalse: [ Pawn relativePositionsDown ])! ! !Pawn methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:09'! permittedMoves ^ (OrderedCollection newFrom: self squaresAhead) addAll: self squareDiagonallyLeftAhead; addAll: self squareDiagonallyRightAhead; addAll: self enPassantMove; yourself! ! !Pawn methodsFor: 'accessing' stamp: 'SdJ 2/18/2023 10:39'! canBeCapturedEnPassant ^ canBeCapturedEnPassant! ! !Pawn methodsFor: 'accessing' stamp: 'SdJ 12/24/2022 09:07'! canBeCapturedEnPassant: value canBeCapturedEnPassant := value! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:44'! enPassantMove | permittedMoves | permittedMoves := OrderedCollection new. (square isOnEnPassantRankFor: color) ifTrue: [ square isOnLeftMostFile ifFalse: [ permittedMoves addAll: (self enPassantMoveFor: (square square: 0 aheadFrom: square file - 1 and: square rank)) ]. square isOnRightMostFile ifFalse: [ permittedMoves addAll: (self enPassantMoveFor: (square square: 0 aheadFrom: square file + 1 and: square rank)) ]. ]. ^ permittedMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:44'! enPassantMoveFor: adjacentSquare | permittedMoves squareDiagonallyAhead | permittedMoves := OrderedCollection new. squareDiagonallyAhead := square square: 1 aheadFrom: adjacentSquare file and: adjacentSquare rank. ((adjacentSquare isOccupiedByPieceNotBeing: self color) and: [ (adjacentSquare piece isKindOf: Pawn) and: [ adjacentSquare piece canBeCapturedEnPassant and: [ squareDiagonallyAhead isEmpty ]]]) ifTrue: [ permittedMoves add: (square moveTo: squareDiagonallyAhead) ]. ^ permittedMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:44'! squareDiagonallyLeftAhead | permittedMoves squareDiagonallyAhead | permittedMoves := OrderedCollection new. square isOnLeftMostFile ifFalse: [ squareDiagonallyAhead := square square: 1 aheadFrom: square file - 1 and: square rank. (squareDiagonallyAhead isOccupiedByPieceNotBeing: color) ifTrue: [ permittedMoves add: (square moveTo: squareDiagonallyAhead). ] ]. ^ permittedMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:44'! squareDiagonallyRightAhead | permittedMoves squareDiagonallyAhead | permittedMoves := OrderedCollection new. square isOnRightMostFile ifFalse: [ squareDiagonallyAhead := square square: 1 aheadFrom: square file + 1 and: square rank. (squareDiagonallyAhead isOccupiedByPieceNotBeing: color) ifTrue: [ permittedMoves add: (square moveTo: squareDiagonallyAhead). ] ]. ^ permittedMoves! ! !Pawn methodsFor: 'private' stamp: 'SdJ 2/24/2023 14:44'! squaresAhead | permittedMoves squareAhead twoSquaresAhead | permittedMoves := OrderedCollection new. squareAhead := square numberOfSquaresAhead: 1. squareAhead isEmpty ifTrue: [ permittedMoves add: (square moveTo: squareAhead). hasMoved ifFalse: [ twoSquaresAhead := square numberOfSquaresAhead: 2. twoSquaresAhead isEmpty ifTrue: [ permittedMoves add: (square moveTo: twoSquaresAhead). ] ] ]. ^ permittedMoves! ! !Pawn methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'P'. canBeCapturedEnPassant := false.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Pawn class instanceVariableNames: ''! !Pawn class methodsFor: 'constants' stamp: 'SdJ 2/24/2023 15:11'! relativePositionsDown ^ Array newFrom: { #(-1 -1). #(1 -1) }! ! !Pawn class methodsFor: 'constants' stamp: 'SdJ 2/24/2023 15:11'! relativePositionsUp ^ Array newFrom: { #(-1 1). #(1 1) }! ! ChessPiece subclass: #Queen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Queen commentStamp: 'SdJ 12/23/2022 15:24' prior: 0! I move diagonally, horizontally and vertically on the board.! !Queen methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:16'! isAttacking: aSquare ^ square attacks: aSquare via: Queen directions! ! !Queen methodsFor: 'game playing' stamp: 'SdJ 1/27/2023 14:33'! permittedMoves "Permitted moves are: All squares along the same file or rank as the currently occupied square and along diagonal lines from the currently occupied square." ^ square permittedMovesIn: Queen directions! ! !Queen methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'Q'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Queen class instanceVariableNames: ''! !Queen class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:32'! directions ^ Array newFrom: { #(0 1). #(1 1). #(1 0). #(1 -1). #(0 -1). #(-1 -1). #(-1 0). #(-1 1) }! ! ComputerChessPlayer subclass: #RandomMovePlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !RandomMovePlayer commentStamp: 'SdJ 2/10/2023 11:43' prior: 0! I play chess by making random, but legal, moves.! !RandomMovePlayer methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 14:15'! nextMoveFrom: permittedMoves on: board "Precondition: permittedMoves is not empty." ^ permittedMoves atRandom! ! !RandomMovePlayer methodsFor: 'game playing' stamp: 'SdJ 12/9/2022 13:31'! promotionChoice ^ Queen new color: color! ! !RandomMovePlayer methodsFor: 'accessing' stamp: 'SdJ 12/9/2022 13:20'! name ^ 'Bobby Fischer'! ! ChessPiece subclass: #Rook instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chess'! !Rook commentStamp: 'SdJ 12/23/2022 15:24' prior: 0! I move horizontally and vertically on the board.! !Rook methodsFor: 'game playing' stamp: 'SdJ 1/29/2023 19:27'! isAttacking: aSquare ^ ((square file = aSquare file) | (square rank = aSquare rank)) and: [(square attacks: aSquare via: Rook directions)]! ! !Rook methodsFor: 'game playing' stamp: 'SdJ 1/14/2023 10:23'! permittedMoves "Permitted moves are: All squares along the same file or rank as the currently occupied square." ^ square permittedMovesIn: (Array newFrom: { #(1 0). #(0 1). #(0 -1). #(-1 0) })! ! !Rook methodsFor: 'initialize-release' stamp: 'SdJ 12/31/2022 10:30'! initialize super initializeWith: 'R'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Rook class instanceVariableNames: ''! !Rook class methodsFor: 'constants' stamp: 'SdJ 1/27/2023 14:34'! directions ^ Array newFrom: { #(1 0). #(0 1). #(0 -1). #(-1 0) }! ! \ No newline at end of file