[bknr-cvs] r2229 - branches/trunk-reorg/projects/scrabble/src
bknr at bknr.net
bknr at bknr.net
Sun Oct 7 22:04:17 UTC 2007
Author: hhubner
Date: 2007-10-07 18:04:17 -0400 (Sun, 07 Oct 2007)
New Revision: 2229
Added:
branches/trunk-reorg/projects/scrabble/src/test-store.lisp
Modified:
branches/trunk-reorg/projects/scrabble/src/game.lisp
branches/trunk-reorg/projects/scrabble/src/package.lisp
branches/trunk-reorg/projects/scrabble/src/rules.lisp
branches/trunk-reorg/projects/scrabble/src/web.lisp
Log:
make-game works now, and some xml can be generated. snapshot and restore
works, but I found a very embarrasing problem with anonymous transactions
and make-object. In a nutshell, one would expect to be able to group a
number of make-object calls using an (anonymous) transaction in order to
create a few interdependent objets. In practice, this does not work. The
order of the objects as they appear in the transaction log is wrong when
using an anonymous transaction, and snapshots don't work with either
anonymous or named transactions. This is very embarrasing and I will need
to find time to fix this soon, as it makes the store useless for many real
world application scenarios.
Modified: branches/trunk-reorg/projects/scrabble/src/game.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/game.lisp 2007-10-06 23:09:39 UTC (rev 2228)
+++ branches/trunk-reorg/projects/scrabble/src/game.lisp 2007-10-07 22:04:17 UTC (rev 2229)
@@ -24,7 +24,7 @@
(random-index (random (fill-pointer tiles))))
(setf (aref tiles i) (aref tiles random-index))
(setf (aref tiles random-index) tmp)))
- (make-instance 'tile-bag :tiles tiles)))
+ (make-object 'tile-bag :tiles tiles)))
(define-condition no-tiles-remaining (simple-error)
())
@@ -54,17 +54,45 @@
((games :initform nil :accessor games-of))
(:metaclass persistent-class))
+(defclass participant (store-object)
+ ((player :initarg :player :reader player-of)
+ (tray :initarg :tray :accessor tray-of))
+ (:metaclass persistent-class))
+
+(defmethod tray-size ((participant participant))
+ (length (tray-of participant)))
+
(defclass game (store-object)
((language :initarg :language
:reader language-of)
- (players :initarg :players
- :reader players-of
- :documentation "List of players in this game")
- (board :accessor board-of)
- (tile-bag :accessor tile-bag-of))
+ (board :initarg :board
+ :accessor board-of)
+ (tile-bag :initarg :tile-bag
+ :accessor tile-bag-of)
+ (participants :initarg :participants
+ :reader participants-of
+ :documentation "List of participants in this game"))
(:metaclass persistent-class))
-(defmethod initialize-persistent-instance :after ((game game))
- (setf (board-of game) (make-instance 'board))
- (setf (tile-bag-of game) (make-tile-bag (language-of game)))
- game)
\ No newline at end of file
+(defun make-game (language players)
+ ;; Because of a serious deficiency in the BKNR datastore, we need to create all the parts of a game in seperate transactions.
+ ;; Only when all components have been created in the right order, restoring from either the transaction log or a snapshot
+ ;; will work. A real fix would involve ordering object creations in transactions so that when restoring, all objects are
+ ;; created before they are referenced.
+ (let* ((board (make-object 'board))
+ (tile-bag (make-tile-bag language))
+ (trays (mapcar (lambda (player)
+ (declare (ignore player))
+ (loop for i from 0 below 7
+ collect (draw-tile tile-bag)))
+ players))
+ (participants (loop for player in players
+ for tray in trays
+ collect (make-object 'participant
+ :player player
+ :tray tray))))
+ (make-object 'game
+ :language language
+ :board board
+ :tile-bag tile-bag
+ :participants participants)))
Modified: branches/trunk-reorg/projects/scrabble/src/package.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/package.lisp 2007-10-06 23:09:39 UTC (rev 2228)
+++ branches/trunk-reorg/projects/scrabble/src/package.lisp 2007-10-07 22:04:17 UTC (rev 2229)
@@ -21,12 +21,18 @@
"REMAINING-TILE-COUNT"
"PLAYER"
+ "GAMES-OF"
+ "PARTICIPANT"
+ "PLAYER-OF"
+ "TRAY-OF"
+
"GAME"
"LANGUAGE-OF"
- "PLAYERS-OF"
+ "PARTICIPANTS-OF"
"BOARD-OF"
- "TILE-BAG-OF"))
+ "TILE-BAG-OF"
+ "MAKE-GAME"))
(defpackage :scrabble.graphics
(:use :cl
Modified: branches/trunk-reorg/projects/scrabble/src/rules.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/rules.lisp 2007-10-06 23:09:39 UTC (rev 2228)
+++ branches/trunk-reorg/projects/scrabble/src/rules.lisp 2007-10-07 22:04:17 UTC (rev 2229)
@@ -66,7 +66,7 @@
(defmethod at-placement ((board board) tile-placement)
(at-xy board (x-of tile-placement) (y-of tile-placement)))
-(defmethod put-letter ((board board) tile x y)
+(deftransaction put-letter (board tile x y)
(setf (aref (placed-tiles-of board) x y) tile))
(defclass tile (store-object)
Added: branches/trunk-reorg/projects/scrabble/src/test-store.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/test-store.lisp 2007-10-06 23:09:39 UTC (rev 2228)
+++ branches/trunk-reorg/projects/scrabble/src/test-store.lisp 2007-10-07 22:04:17 UTC (rev 2229)
@@ -0,0 +1,9 @@
+(in-package :scrabble)
+
+(defun test-store ()
+ (ignore-errors (close-store))
+ (sb-ext:run-program "/bin/rm" '("-rf" "/tmp/scrabble-store/") :environment nil)
+ (make-instance 'mp-store :directory "/tmp/scrabble-store/")
+ (let ((user1 (make-user "user1" :class 'player :full-name "User Eins"))
+ (user2 (make-user "user2" :class 'player :full-name "User Zwei")))
+ (make-game :de (list user1 user2))))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-06 23:09:39 UTC (rev 2228)
+++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-10-07 22:04:17 UTC (rev 2229)
@@ -2,23 +2,24 @@
(defmethod as-xml ((board board))
(with-element "board"
- (dotimes (x 15)
- (dotimes (y 15)
- (awhen (at-xy board x y)
- (with-element "tile"
- (attribute "x" x)
- (attribute "y" y)
- (attribute "letter" (char-of it))
- (attribute "value" (value-of it))))))))
+ (dotimes (x 15)
+ (dotimes (y 15)
+ (awhen (at-xy board x y)
+ (with-element "tile"
+ (attribute "x" x)
+ (attribute "y" y)
+ (attribute "letter" (princ-to-string (char-of it)))
+ (attribute "value" (value-of it))))))))
-(defmethod as-xml ((player player))
- (with-element "player"
- (attribute "name" (user-full-name player))))
+(defmethod as-xml ((participant participant))
+ (with-element "participant"
+ (attribute "name" (user-full-name (player-of participant)))
+ (attribute "tiles" (length (tray-of participant)))))
(defmethod as-xml ((game game))
(with-element "game"
(attribute "language" (princ-to-string (language-of game)))
(attribute "remaining-tiles" (remaining-tile-count (tile-bag-of game)))
- (dolist (player (players-of game))
- (as-xml player))
+ (dolist (participant (participants-of game))
+ (as-xml participant))
(as-xml (board-of game))))
More information about the Bknr-cvs
mailing list