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