[bknr-cvs] r2231 - in branches/trunk-reorg/projects/scrabble: src website/de - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

7 Oct 2007

Author: hhubner
Date: 2007-10-07 19:19:21 -0400 (Sun, 07 Oct 2007)
New Revision: 2231
Modified:
   branches/trunk-reorg/projects/scrabble/src/package.lisp
   branches/trunk-reorg/projects/scrabble/src/scrabble.asd
   branches/trunk-reorg/projects/scrabble/src/web.lisp
   branches/trunk-reorg/projects/scrabble/website/de/scrabble.js
Log:
Generate JSON instead of XML from game data.  Proof of concept that this
works.
Modified: branches/trunk-reorg/projects/scrabble/src/package.lisp
===================================================================

--- branches/trunk-reorg/projects/scrabble/src/package.lisp	2007-10-07 23:18:29 UTC (rev 2230)
+++ branches/trunk-reorg/projects/scrabble/src/package.lisp	2007-10-07 23:19:21 UTC (rev 2231)
@@ -48,6 +48,6 @@
    :hunchentoot
    :bknr.datastore
    :bknr.user
-	:cxml
+	:json
    :scrabble))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/scrabble/src/scrabble.asd
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/scrabble.asd	2007-10-07 23:18:29 UTC (rev 2230)
+++ branches/trunk-reorg/projects/scrabble/src/scrabble.asd	2007-10-07 23:19:21 UTC (rev 2231)
@@ -13,7 +13,7 @@
     :depends-on (:bknr-datastore
    	 :bknr-web
    	 :hunchentoot
-		 :cxml
+		 :cl-json
    	 :vecto
    	 :alexandria
    	 :anaphora)
Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp
===================================================================
--- branches/trunk-reorg/projects/scrabble/src/web.lisp	2007-10-07 23:18:29 UTC (rev 2230)
+++ branches/trunk-reorg/projects/scrabble/src/web.lisp	2007-10-07 23:19:21 UTC (rev 2231)
@@ -1,25 +1,41 @@
 (in-package :scrabble.web)
-(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" (princ-to-string (char-of it)))
-	    (attribute "value" (value-of it))))))))
+(defparameter *ignore-slots* '(bknr.datastore::id bknr.indices::destroyed-p))
-(defmethod as-xml ((participant participant))
-  (with-element "participant"
-    (attribute "name" (user-full-name (player-of participant)))
-    (attribute "tiles" (length (tray-of participant)))))
+(defun encode-json-alist (alist stream)
+  (princ #{ stream)
+  (loop for (key value) on alist by #'cddr
+	do (encode-json key stream)
+	do (princ #: stream)
+	do (encode-json value stream)
+	do (princ #, stream))
+  (princ #} stream))
-(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 (participant (participants-of game))
-      (as-xml participant))
-    (as-xml (board-of game))))
+(defmethod encode-json ((object store-object) stream)
+  (princ #{ stream)
+  (dolist (slotdef (closer-mop:class-slots (class-of object)))
+    (when (and (slot-boundp object (closer-mop:slot-definition-name slotdef))
+	       (not (find (closer-mop:slot-definition-name slotdef) *ignore-slots*)))
+      (encode-json (closer-mop:slot-definition-name slotdef) stream)
+      (princ #: stream)
+      (encode-json (slot-value object (closer-mop:slot-definition-name slotdef)) stream)
+      (princ #, stream)))
+  (princ #} stream))
+
+(defmethod encode-json ((tile-bag tile-bag) stream)
+  (encode-json-alist (list "remainingTiles" (remaining-tile-count tile-bag)) stream))
+
+(defmethod encode-json ((board board) stream)
+  (princ #[ stream)
+  (dotimes (x 15)
+    (dotimes (y 15)
+      (awhen (at-xy board x y)
+	(encode-json (list x y (char-of it) (value-of it)) stream)
+	(princ #, stream))))
+  (princ #] stream))
+
+(defmethod encode-json ((participant participant) stream)
+  (encode-json-alist (list :name (user-login (player-of participant))
+			   :remaining-tiles (length (tray-of participant)))
+		     stream))
+
Modified: branches/trunk-reorg/projects/scrabble/website/de/scrabble.js
===================================================================
--- branches/trunk-reorg/projects/scrabble/website/de/scrabble.js	2007-10-07 23:18:29 UTC (rev 2230)
+++ branches/trunk-reorg/projects/scrabble/website/de/scrabble.js	2007-10-07 23:19:21 UTC (rev 2231)
@@ -16,7 +16,12 @@
 }
function init() {
-    setWord(6, 6, "ICH");
-    setWord(7, 7, "LIEBE");
-    setWord(8, 8, "DICH");
+    var gameState = {"language":"de","board":[[7,7,"E",1],[7,8,"I",1],[7,9,"M",3],],"tileBag":{"remainingTiles":88,},"participants":[{"player":{"login":"user1","flags":null,"email":null,"fullName":"User Eins","lastLogin":0,"password":"$1$GNNXDZNW$hrPGuT8YOoGzJ6IXoUZGo1","preferences":{},"subscriptions":null,"games":null,},"tray":[{"char":"I","value":1,},{"char":"N","value":1,},{"char":"H","value":2,},{"char":"S","value":1,},{"char":"S","value":1,},{"char":"G","value":2,},{"char":"I","value":1,}],},{"player":{"login":"user2","flags":null,"email":null,"fullName":"User Zwei","lastLogin":0,"password":"$1$NSOVKSSC$enFJIydIQa.X77ATDtBNU1","preferences":{},"subscriptions":null,"games":null,},"tray":[{"char":"T","value":1,},{"char":"F","value":4,},{"char":"A","value":1,},{"char":"J","value":6,},{"char":"E","value":1,},{"char":"H","value":2,},{"char":"E","value":1,}],}],};
+
+    for (var i = 0; i < gameState.board.length; i++) {
+	var x = gameState.board[i][0];
+	var y = gameState.board[i][1];
+	var char = gameState.board[i][2];
+	setLetter(x, y, char);
+    }
 }

    