Refactor: to use render protocol

6 files changed, 125 insertions, 27 deletions

diff --git a/dnd.asd b/dnd.asd
index 90dacf9..5a982d6 100644
--- a/dnd.asd
+++ b/dnd.asd
@@ -20,14 +20,15 @@
                #:jonathan
 	       #:quri
                #:bordeaux-threads
-               #:testiere)
+               #:testiere
+               #:defclass-std)
   :components ((:file "package")
                (:file "utilities")
-               (:file "init")
                (:file "model")
-               (:file "flash")
-               (:file "endpoints")
-               (:file "pages")
                (:file "queries")
 	       (:file "transactions")
+               (:file "flash")
+               (:file "pages")
+               (:file "endpoints")
+               (:file "init")
                (:file "dnd")))
diff --git a/endpoints.lisp b/endpoints.lisp
index e33a362..af07f6e 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -54,7 +54,7 @@ I.e. It should be called within the scope of a request handler."
     `(a:if-let (,session (current-session))
        (let ((,player (session-player ,session)))
          (declare (ignorable ,player))
-         ,@body)
+       ,@body)
        (redirect-to ,redirect))))
 
 
@@ -125,8 +125,8 @@ functions in url parameters in endpoint definitions."
 ;;; SESSION ENDPOINTS
 
 (defendpoint* :get "/tavern" () ()
-  (with-session (player)
-    (tavern player)))
+  (with-session (me)
+    (tavern me)))
 
 (defendpoint* :get "/godess-shrine" () ()
   (with-session (player)
diff --git a/model.lisp b/model.lisp
index e4c8943..0598cf7 100644
--- a/model.lisp
+++ b/model.lisp
@@ -65,7 +65,7 @@
 
 (defclass player (db:store-object has-uid)
   ((nick
-    :reader user-nick
+    :reader player-nick
     :initarg :nick
     :initform (error "Players must have a nick")
     :type string
@@ -97,8 +97,7 @@
     :initarg :player
     :type player
     :index-type idx:hash-index
-    :index-reader player-heroes
-    )
+    :index-reader player-heroes)
    (campaign
     :accessor hero-campaign
     :initarg :campaign
@@ -107,6 +106,8 @@
     :documentation "A hero may be in at mostk one campaign at a time."))
   (:metaclass db:persistent-class))
 
+
+
 ;; TODO expiration?
 (defclass session (db:store-object)
   ((player :reader session-player
@@ -157,7 +158,7 @@
     :initform nil
     :documentation "When all hope becomes lost.")
    (heroes
-    :accessor heroes-in-quest
+    :accessor heroes-on-quest
     :initarg :heroes
     :initform nil
     :documentation "A list of heroes in this quest. Join and flight dates are logged in the chronicle.")
diff --git a/package.lisp b/package.lisp
index 8cc0a0b..20a16d0 100644
--- a/package.lisp
+++ b/package.lisp
@@ -17,6 +17,8 @@
   (:import-from #:spinneret
 		#:with-html
 		#:with-html-string)
+  (:import-from #:defclass-std
+                #:defclass/std)
   (:export :boot))
 
 
diff --git a/pages.lisp b/pages.lisp
index c435e8f..f279aa9 100644
--- a/pages.lisp
+++ b/pages.lisp
@@ -2,26 +2,57 @@
 
 (in-package :dnd)
 
+;;; RENDER PROTOCOL
+
+(defgeneric render (view object &key)
+  (:documentation "Render OBJECT as VIEW. VIEW could be anything, but it is intended to
+be a keyword for usin in EQL method specializers."))
+
+(defmacro defrender (view (spec &rest kwargs) &body body)
+  "A helper macro for defining specializations of render."
+  (let ((viewvar (gensym)))
+    `(defmethod render  ((,viewvar (eql ,view)) ,spec &key ,@kwargs)
+       ,@body)))
+
+(defrender :list ((data list) (class "listview") (item-class "listitem"))
+  "A catch all for rendering lists of renderable data items as unordered
+lists. CLASS is the lass string for the containing list. ITEM-CLASS is
+the class string for the contained list items."
+  (with-html
+    (:ol :class class
+         (dolist (item data)
+           (:li (render :list-item item :class item-class))))))
+
+(defrender :three-column-layout (data)
+  "A catch all specialization for rendering data in three columns. You
+must specialize :left :milsddle :right on your desired data type."
+  (with-html
+    (:div :class "three-column-layout"
+          (:div :class "left-column" (render :left data))
+          (:div :class "middle-column" (render :middle data))
+          (:div :class "right-column" (render :right data)))))
+
+;;; PAGES
+
 (defmacro with-page ((&key title) &body body)
+  "A helper macro fordefining some standard page boilerplate."
   `(with-html-string
      (:doctype)
      (:html
       (:head
        (:title ,title))
-      (:body ,@body))))
+      (:body
+       ,@body))))
 
-(defun godess-shrine ()
-  (with-page (:title "A Sacred Shrine")
-    (:header
-     (:h1 "Pray and become a hero..."))
-    (:form :method "POST" :action "/godess-shrine"
-	   (:label :for "NAME" "Enter the epithet by which the ages shall know thy hero:")
-	   (:input :name "NAME")
-	   (:button :type "submit" "Pray To The Goddess"))))
+(defclass/std doorkeeper ()
+  ((message)))
 
 (defun doorkeeper (&key (message "Come ye player, Wot's yer name?"))
+  (render :page (make-instance 'doorkeeper :message message )))
+
+(defrender :page ((page doorkeeper))
   (with-page (:title "Tavern Door")
-    (:h1 message)
+    (:h1 (message page))
     (:form :method "POST" :action "/tavern-door"
 	   (:label :for "NICK" "Wut's yer handle?:")
 	   (:input :name "NICK")
@@ -29,7 +60,20 @@
     (:h2 "Eh? Ye need to announce thyeself?")
     (:a :href "/register" "Follow me...")))
 
-(defun register ()
+(defclass/std goddess-shrine () ())
+
+(defrender :page ((page goddess-shrine)) 
+  (with-page (:title "A Sacred Shrine")
+    (:header
+     (:h1 "Pray and become a hero..."))
+    (:form :method "POST" :action "/godess-shrine"
+	   (:label :for "NAME" "Enter the epithet by which the ages shall know thy hero:")
+	   (:input :name "NAME")
+	   (:button :type "submit" "Pray To The Goddess"))))
+
+(defclass/std player-registration () ())
+
+(defrender :page ((page player-registration))
   (with-page (:title "Register Player")
     (:header
      (:h1 "Choose a Nickname Player"))
@@ -38,13 +82,44 @@
            (:input :name "NICK" :placeholder "superbob")
            (:button :type "submit" "Register"))))
 
+(defun register ()
+  (render :page (make-instance 'player-registration)))
+
+(defclass/std tavern ()
+  ((player alerts)))
+
 (defun tavern (player)
+  (print "MOO")
+  (render :page (make-instance 'tavern :player player)))
+
+(defrender :page ((tavern tavern))
   (with-page (:title "A Bustling Tavern")
     (navbar)
-    (:div
-     :class "heroes-container"
-     (:h2 "Heroes of rampant renown:")
-     (hall-of-heroes))))
+    (render :three-column-layout tavern)))
+
+(defrender :left ((tavern tavern))
+  (let ((player (player tavern))) 
+    (with-html 
+      (render :details player)
+      (:h4 "Your Heroes")
+      (render :list (player-heroes player)))))
+
+(defrender :middle ((tavern tavern))
+  (with-html
+    (:h4 "Your Campaigns ")
+    (render :list (player-campaigns (player tavern)))))
+
+(defrender :right ((tavern tavern))
+  (with-html
+    (:h4 "Gossip & Gab")
+    (render :list (alerts tavern))
+    (:h4 "Comrades in Arms")
+    (render :list (fetch-comrades (player tavern)))))
+
+(defrender :details ((player player))
+  (with-html
+    (:div :class "player details"
+          (:h3 "Welcome " (player-nick player)))))
 
 (defun navbar ()
   (with-html
diff --git a/queries.lisp b/queries.lisp
index 329ecb2..4538c75 100644
--- a/queries.lisp
+++ b/queries.lisp
@@ -5,3 +5,22 @@
 (defun all-heroes ()
   (db:store-objects-with-class 'hero))
 
+(defun player-campaigns (player)
+  "Return a list of campaigns that that player is involved in."
+  (remove nil (mapcar #'hero-campaign (player-heroes player))))
+
+(defun campaign-heros (campaign &key (activep t))
+  "All the heros actively involved in this CAMPAIGN. If ACTIVEP, then
+only the active quest(s) are considered, otherwise all quests are considered."
+  (remove-duplicates
+   (mapcan #'heroes-on-quest
+           (if activep
+               (remove-if-not #'quest-startedp (quests-in-campaign campaign))
+               (quests-in-campaign campaign)))))
+
+(defun fetch-comrades (player &key (activep t))
+  "Returns all the heroes in any one of the player's campaigns. If
+ACTIVEP, then only heroes involved in active quests are returned."
+  (remove-duplicates
+   (loop :for campaign :in (player-campaigns player)
+         :nconc (campaign-heros campaign :activep activep))))