[Seaside] [Borges] Squeak Chess
Lukas Renggli
seaside@lists.squeakfoundation.org
Mon, 7 Oct 2002 19:27:34 +0200
This is a multi-part message in MIME format.
------=_NextPart_000_0021_01C26E37.96246760
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
Hi all
There is a quite cool implementation of the chess-game in the standard
Squeak image. My web-application uses this model and makes it playable in a
web-browser.
To run the game, download and file-in the latest sources of Borges. I used
the ones available with CVS. Then file-in the "Chess.cs" change-set, start
the server using the following commands
WAKom startOn: 8080.
WAChessBoard initialize.
and point your preferred web-browser to
http://localhost:8080/chess.
To make the images look much better you have to make a little change to
Borges; these are not included in the change-set! Just change the third line
of the message "WAHtmlRenderer>>imageWithForm: aForm" where the
callback-block is defined to
callback := [ WASession currentSession respondWithDocument:
aForm asWebImage ].
Of course the application is not perfect at all. One of the problems is that
the browser is sometimes not able to load all the images. I don't know, but
that seems to be a problem of Borges.
Another issue is that no status is given while the computer is thinking, but
that could be added later.
Enjoy playing :-)
Lukas
------=_NextPart_000_0021_01C26E37.96246760
Content-Type: application/octet-stream;
name="Chess.st"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="Chess.st"
WAComponent subclass: #WAChessBoard=0D instanceVariableNames: 'squares =
board sourcePos possibleMoves undoList redoList '=0D classVariableNames: =
''=0D poolDictionaries: ''=0D category: =
'Seaside/Applications-Chess'!=0D=0D!WAChessBoard methodsFor: 'actions' =
stamp: 'LR 10/7/2002 17:54'!=0Dhint=0D self inform: 'I suggest: ', board =
searchAgent think moveString.! !=0D=0D!WAChessBoard methodsFor: =
'actions' stamp: 'LR 10/7/2002 18:28'!=0Dnew=0D self prepareGame! =
!=0D=0D!WAChessBoard methodsFor: 'actions' stamp: 'LR 10/7/2002 =
17:54'!=0Dredo=0D redoList size >=3D 2=0D ifTrue: [ board nextMove: =
redoList removeLast.=0D board nextMove: redoList removeLast ]! =
!=0D=0D!WAChessBoard methodsFor: 'actions' stamp: 'LR 10/7/2002 =
17:54'!=0Dundo=0D undoList size >=3D 2=0D ifTrue: [ board undoMove: =
undoList removeLast. =0D board undoMove: undoList removeLast ]! =
!=0D=0D=0D!WAChessBoard methodsFor: 'rendering' stamp: 'LR 10/7/2002 =
17:51'!=0Drender=0D html heading: 'Squeak Chess'.=0D self =
renderCommands.=0D self renderBoard.=0D html paragraph.=0D self =
renderUndoRedo! !=0D=0D!WAChessBoard methodsFor: 'rendering' stamp: 'LR =
10/7/2002 17:27'!=0DrenderBoard=0D | square |=0D html attributes: { =0D =
'border' -> 0.=0D 'cellspacing' -> 0.=0D 'cellpadding' -> 0.=0D }.=0D =
html table: [=0D 1 to: 9 do: [ :row |=0D html tableRow: [=0D 1 to: =
9 do: [ :col | =0D square _ squares at: 9 * (9 - row) + col.=0D =
html render: square=0D ]=0D ]=0D ]=0D ]=0D =0D! =
!=0D=0D!WAChessBoard methodsFor: 'rendering' stamp: 'LR 10/7/2002 =
18:28'!=0DrenderCommands=0D html form: [=0D html =
submitButtonWithAction: [ self new ] text: 'New'; space.=0D html =
submitButtonWithAction: [ self hint ] text: 'Hint'; space.=0D html =
submitButtonWithAction: [ self undo ] text: 'Undo'; space.=0D html =
submitButtonWithAction: [ self redo ] text: 'Redo'; space.=0D ]! =
!=0D=0D!WAChessBoard methodsFor: 'rendering' stamp: 'LR 10/7/2002 =
17:54'!=0DrenderUndoRedo=0D html text: '<strong>Undo:</strong> '.=0D =
undoList do: [ :item |=0D html text: item moveString, ' ' ].=0D html =
paragraph.=0D=0D html text: '<strong>Redo:</strong> '.=0D redoList do: [ =
:item |=0D html text: item moveString, ' ' ].=0D html paragraph! =
!=0D=0D=0D!WAChessBoard methodsFor: 'initialize' stamp: 'LR 10/7/2002 =
17:54'!=0Dinitialize =0D super initialize.=0D board _ ChessBoard new.=0D =
squares _ OrderedCollection new.=0D self prepareSquares.=0D self =
prepareGame! !=0D=0D!WAChessBoard methodsFor: 'initialize' stamp: 'LR =
10/7/2002 16:34'!=0DprepareGame=0D board =0D initialize;=0D =
initializeNewBoard;=0D userAgent: self.=0D undoList _ OrderedCollection =
new.=0D redoList _ OrderedCollection new.=0D self prepareMove! =
!=0D=0D!WAChessBoard methodsFor: 'initialize' stamp: 'LR 10/7/2002 =
16:34'!=0DprepareMove=0D sourcePos _ nil.=0D possibleMoves _ nil! =
!=0D=0D!WAChessBoard methodsFor: 'initialize' stamp: 'LR 10/7/2002 =
16:33'!=0DprepareSquares=0D | square index |=0D index _ 0. =0D self =
class boardLayout do: [ :row |=0D row do: [ :cell |=0D square _ =
WAChessSquare new.=0D square code: cell.=0D ( #( $W $B ) includes: =
cell) ifTrue: [=0D square index: (index _ index + 1).=0D square =
target: self=0D ].=0D squares add: square.=0D ].=0D ].=0D! =
!=0D=0D=0D!WAChessBoard methodsFor: 'accessing' stamp: 'LR 10/7/2002 =
17:54'!=0Dboard=0D ^ board! !=0D=0D!WAChessBoard methodsFor: 'accessing' =
stamp: 'LR 10/7/2002 17:54'!=0DboardAt: pos=0D ^ (board whitePlayer =
pieceAt: pos) - (board blackPlayer pieceAt: pos)! !=0D=0D!WAChessBoard =
methodsFor: 'accessing' stamp: 'LR 10/7/2002 17:54'!=0DpossibleMoves=0D =
^ possibleMoves! !=0D=0D!WAChessBoard methodsFor: 'accessing' stamp: 'LR =
10/7/2002 17:56'!=0DsourcePos=0D ^ sourcePos! !=0D=0D=0D!WAChessBoard =
methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 22:16'!=0DaddedPiece: =
piece at: square white: isWhite! !=0D=0D!WAChessBoard methodsFor: 'game =
callbacks' stamp: 'LR 10/7/2002 17:49'!=0DcompletedMove: aMove white: =
aBool=0D undoList addLast: aMove.=0D self prepareMove! =
!=0D=0D!WAChessBoard methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 =
22:19'!=0DfinishedGame: result=0D (result =3D 0) ifTrue: [ self inform: =
'Congratulation: You won this game!!' ].=0D (result =3D 0.5) ifTrue: [ =
self inform: 'This game endet with draw.' ].=0D (result =3D 1) ifTrue: [ =
self inform: 'Sorry, you lost this game.' ]=0D ! !=0D=0D!WAChessBoard =
methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 22:39'!=0DgameReset! =
!=0D=0D!WAChessBoard methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 =
22:14'!=0DmovedPiece: piece from: sourceSquare to: destSquare! =
!=0D=0D!WAChessBoard methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 =
22:15'!=0DremovedPiece: piece at: square! !=0D=0D!WAChessBoard =
methodsFor: 'game callbacks' stamp: 'LR 9/18/2002 =
22:16'!=0DreplacedPiece: oldPiece with: newPiece at: square white: =
isWhite! !=0D=0D!WAChessBoard methodsFor: 'game callbacks' stamp: 'LR =
10/7/2002 17:49'!=0DundoMove: aMove white: aBool=0D redoList addLast: =
aMove.=0D self prepareMove! !=0D=0D=0D!WAChessBoard methodsFor: 'events' =
stamp: 'LR 10/7/2002 18:49'!=0DmouseClickOn: aChessSquare=0D | =
destinationPos |=0D (sourcePos isNil or: [ aChessSquare isPieceWhite =
])=0D ifTrue: [ =0D aChessSquare isPieceWhite ifTrue: [ =0D =
sourcePos _ aChessSquare index. =0D ^ possibleMoves _ board =
activePlayer findValidMovesAt: sourcePos ] ]=0D ifFalse: [=0D =
destinationPos _ aChessSquare index.=0D possibleMoves do: [ :move | =
=0D (move destinationSquare =3D destinationPos) ifTrue: [ =0D =
board nextMove: move.=0D board nextMove: board searchAgent think ] ] =
].=0D self prepareMove! !=0D=0D"-- -- -- -- -- -- -- -- -- -- -- -- -- =
-- -- -- -- -- "!=0D=0DWAChessBoard class=0D instanceVariableNames: =
''!=0D=0D!WAChessBoard class methodsFor: 'defaults' stamp: 'LR 10/7/2002 =
17:26'!=0DboardLayout=0D ^ #( =0D ( $ $a $b $c $d $e $f $g $h )=0D =
( $1 $B $W $B $W $B $W $B $W )=0D ( $2 $W $B $W $B $W $B $W $B =
)=0D ( $3 $B $W $B $W $B $W $B $W )=0D ( $4 $W $B $W $B $W $B $W =
$B )=0D ( $5 $B $W $B $W $B $W $B $W )=0D ( $6 $W $B $W $B $W $B =
$W $B )=0D ( $7 $B $W $B $W $B $W $B $W )=0D ( $8 $W $B $W $B $W =
$B $W $B )=0D ) ! !=0D=0D=0D!WAChessBoard class methodsFor: =
'initialization' stamp: 'LR 10/7/2002 15:10'!=0Dinitialize=0D self =
registerAsApplication: 'chess'! !=0D=0D=0C=0DWAComponent subclass: =
#WAChessSquare=0D instanceVariableNames: 'index code target '=0D =
classVariableNames: 'Images '=0D poolDictionaries: ''=0D category: =
'Seaside/Applications-Chess'!=0D=0D!WAChessSquare methodsFor: =
'accessing' stamp: 'LR 10/7/2002 14:24'!=0Dcode=0D ^ code! =
!=0D=0D!WAChessSquare methodsFor: 'accessing' stamp: 'LR 10/7/2002 =
14:24'!=0Dcode: aCharacter=0D code _ aCharacter! !=0D=0D!WAChessSquare =
methodsFor: 'accessing' stamp: 'LR 10/7/2002 18:38'!=0Dcolor=0D | color =
|=0D (code =3D $W) ifTrue: [ color _ Color r: 0.9101 g: 0.9257 b: 0.9726 =
].=0D (code =3D $B) ifTrue: [ color _ Color r: 0.1367 g: 0.4687 b: =
0.7421 ].=0D self isSource ifTrue: [ ^ color mixed: 0.5 with: Color =
green ].=0D self isJumpTarget ifTrue: [ ^ color mixed: 0.5 with: Color =
red ].=0D ^ color! !=0D=0D!WAChessSquare methodsFor: 'accessing' stamp: =
'LR 10/7/2002 13:28'!=0Dindex=0D ^ index! !=0D=0D!WAChessSquare =
methodsFor: 'accessing' stamp: 'LR 10/7/2002 13:28'!=0Dindex: =
anInteger=0D index _ anInteger! !=0D=0D!WAChessSquare methodsFor: =
'accessing' stamp: 'LR 10/7/2002 17:42'!=0Dpiece=0D ^ self target =
boardAt: index! !=0D=0D!WAChessSquare methodsFor: 'accessing' stamp: 'LR =
10/7/2002 14:25'!=0Dtarget=0D ^ target! !=0D=0D!WAChessSquare =
methodsFor: 'accessing' stamp: 'LR 10/7/2002 14:25'!=0Dtarget: =
anObject=0D target _ anObject! !=0D=0D=0D!WAChessSquare methodsFor: =
'rendering' stamp: 'LR 10/7/2002 17:31'!=0Drender=0D html attributes: { =
=0D 'align' -> 'center'.=0D 'valign' -> 'middle'.=0D 'width' -> =
50.=0D 'height' -> 50.=0D }.=0D self isBoardCell =0D ifTrue: [ =0D =
html attributeAt: 'bgColor' put: '#', self color hex.=0D html =
tableData: [ self renderBoardCell ] ] =0D ifFalse: [=0D html =
tableData: [ self renderOutsideCell ] ]! !=0D=0D!WAChessSquare =
methodsFor: 'rendering' stamp: 'LR 10/7/2002 =
18:42'!=0DrenderBoardCell=0D | form |=0D form _ self class images at: =
self piece.=0D html imageMapWithAction: [ :point | self mouseClick ] =
form: form=0D=0D! !=0D=0D!WAChessSquare methodsFor: 'rendering' stamp: =
'LR 10/7/2002 17:19'!=0DrenderOutsideCell=0D html text: code asUppercase =
asString=0D! !=0D=0D=0D!WAChessSquare methodsFor: 'actions' stamp: 'LR =
10/7/2002 17:33'!=0DmouseClick=0D self target mouseClickOn: self! =
!=0D=0D=0D!WAChessSquare methodsFor: 'testing' stamp: 'LR 10/7/2002 =
17:29'!=0DisBoardCell=0D ^ index isNil not! !=0D=0D!WAChessSquare =
methodsFor: 'testing' stamp: 'LR 10/7/2002 18:41'!=0DisJumpTarget=0D =
self isBoardCell ifTrue: [=0D target possibleMoves ifNotNil: [=0D =
target possibleMoves do: [ :move |=0D move destinationSquare =3D =
index ifTrue: [ =0D ^ true ] ] ] ].=0D ^ false! =
!=0D=0D!WAChessSquare methodsFor: 'testing' stamp: 'LR 10/7/2002 =
17:44'!=0DisPiece=0D ^ self isBoardCell and: [ self piece isZero not ]! =
!=0D=0D!WAChessSquare methodsFor: 'testing' stamp: 'LR 10/7/2002 =
17:44'!=0DisPieceBlack=0D ^ self isBoardCell and: [ self piece < 0 ]! =
!=0D=0D!WAChessSquare methodsFor: 'testing' stamp: 'LR 10/7/2002 =
17:44'!=0DisPieceWhite=0D ^ self isBoardCell and: [ self piece > 0 ]! =
!=0D=0D!WAChessSquare methodsFor: 'testing' stamp: 'LR 10/7/2002 =
18:37'!=0DisSource=0D ^ self isBoardCell and: [ target sourcePos =3D =
index ]! !=0D=0D"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- =
"!=0D=0DWAChessSquare class=0D instanceVariableNames: =
''!=0D=0D!WAChessSquare class methodsFor: 'default' stamp: 'LR 10/7/2002 =
17:21'!=0Dimages=0D ^ Images ifNil: [=0D Images _ Dictionary new=0D =
at: -6 put: ChessMorph blackKingImage;=0D at: -5 put: ChessMorph =
blackQueenImage;=0D at: -4 put: ChessMorph blackRookImage;=0D at: -3 =
put: ChessMorph blackBishopImage;=0D at: -2 put: ChessMorph =
blackKnightImage;=0D at: -1 put: ChessMorph blackPawnImage;=0D at: 0 =
put: (Form extent: 40@40 depth: 2);=0D at: 1 put: ChessMorph =
whitePawnImage;=0D at: 2 put: ChessMorph whiteKnightImage;=0D at: 3 =
put: ChessMorph whiteBishopImage;=0D at: 4 put: ChessMorph =
whiteRookImage;=0D at: 5 put: ChessMorph whiteQueenImage;=0D at: 6 =
put: ChessMorph whiteKingImage;=0D yourself=0D ]! =
!=0D=0D=0D!WAChessSquare class methodsFor: 'initialization' stamp: 'LR =
10/7/2002 17:01'!=0Dinitialize=0D super initialize.=0D=0D! =
!=0D=0DWAChessBoard initialize!=0DWAChessSquare initialize!
------=_NextPart_000_0021_01C26E37.96246760--