summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dnd.asd11
-rw-r--r--endpoints.lisp6
-rw-r--r--model.lisp9
-rw-r--r--package.lisp2
-rw-r--r--pages.lisp105
-rw-r--r--queries.lisp19
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))))