Add: adventure creation

8 files changed, 93 insertions, 9 deletions

diff --git a/src/endpoints.lisp b/src/endpoints.lisp
index 5b65ff7..288f39e 100644
--- a/src/endpoints.lisp
+++ b/src/endpoints.lisp
@@ -133,12 +133,20 @@ functions in url parameters in endpoint definitions."
 (defendpoint* :get "/adventure-awaits" () ()
   (with-session (player)
     (render (page-render-mode)
-            (make-instance 'new-adventure))))
+            (make-instance 'adventure-awaits
+                           :possible-seers (remove player (all-players))))))
 
 (defendpoint* :post "/adventure-awaits" () ()
   (with-session (creator)
-    (with-checked-plist ((title :title 'a-short-string)) (lzb:request-body)
-      (let ((adventure
-              (create-adventure creator title)))
-        (redirect-to (urlpath adventure))))))
+    (with-plist ((title :title) (description :description)) (lzb:request-body)
+      (let ((possible-seers
+              (loop :for (key val) :on (lzb:request-body) :by #'cddr
+                    :when (string-equal key "POSSIBLE-SEER")
+                      :collect (object-with-uid val))))
+        (redirect-to
+         (urlpath
+          (create-adventure creator title
+                            :description description
+                            :seers possible-seers)))))))
+
 
diff --git a/src/model.lisp b/src/model.lisp
index f64e28f..381687e 100644
--- a/src/model.lisp
+++ b/src/model.lisp
@@ -144,6 +144,11 @@
     :initarg :title
     :initform (error "A adventure needs a title")
     :type string)
+   (description
+    :accessor description
+    :initarg :description
+    :initform ""
+    :type string)
    (rumors
     :accessor rumors
     :initform nil
diff --git a/src/names.lisp b/src/names.lisp
index b355405..3bc0c16 100644
--- a/src/names.lisp
+++ b/src/names.lisp
@@ -13,13 +13,14 @@
 (defmethod unique-name ((hero hero))
   (name hero))
 
+
 (defgeneric urlpath (object)
   (:documentation "Return the path to the object given a particular")
   (:method ((object has-uid))
     "If the object has a unique human readable name, urlify that name and
 incorporate it into the urlpath. Otherwise use the object's uid.  
 
-Returns /inflection/class/identifier."
+Returns /class/identifier."
     (format nil "/~a/~a"
             (urlify (class-name (class-of object)))
             (urlify (or (unique-name object) (uid object))))))
diff --git a/src/pages/adventure-awaits.lisp b/src/pages/adventure-awaits.lisp
new file mode 100644
index 0000000..8255d2e
--- /dev/null
+++ b/src/pages/adventure-awaits.lisp
@@ -0,0 +1,36 @@
+;;;; adventure-awaits.lisp -- page make to make a new adventure
+
+(in-package :dnd)
+
+(defclass adventure-awaits ()
+  ((possible-seers
+    :reader possible-seers
+    :initarg :possible-seers
+    :initform nil)))
+
+
+(defrender t ((page adventure-awaits))
+  (with-page (:title "What sparkles in yer eye?")
+    (:h2 "Enscribe your new adventure in the book of the bards.")
+    (:div 
+     (:form :method "POST" :action "/adventure-awaits" :id "new-adventure-form"
+            (:label
+             :for "TITLE"
+             "To sing of deeds, the bards require a title equal in greatness to the adventure before you.")
+            (:br)
+            (:input :name "TITLE"
+                    :minlength "2"
+                    :maxlength "40"
+                    :placeholder "Dungeons & Deadlines")
+            (when (possible-seers page)
+              (:br)
+              (:label
+               :for "SEERS"
+               "Who may act as a seer on this adventure?")
+              (:br)
+              (render :checkboxes (possible-seers page)))
+            
+            (:h4 "Describe the adventure you're about to begin:")
+            (:textarea  :name "DESCRIPTION" :rows "5" :cols "60")
+            (:br)
+            (:button :type "submit" "Embark!")))))
diff --git a/src/queries.lisp b/src/queries.lisp
index 9cd581c..de3f8c3 100644
--- a/src/queries.lisp
+++ b/src/queries.lisp
@@ -5,6 +5,9 @@
 (defun all-heroes ()
   (db:store-objects-with-class 'hero))
 
+(defun all-players ()
+  (db:store-objects-with-class 'player))
+
 (defun player-quests (player)
   "Return all quests in which one of player's heroes is engaged."
   (remove nil (mapcar #'quest (player-heroes player))))
diff --git a/src/transactions.lisp b/src/transactions.lisp
index 647452b..dff037d 100644
--- a/src/transactions.lisp
+++ b/src/transactions.lisp
@@ -17,6 +17,8 @@
   (db:with-transaction ()
     (make-instance 'player :nickname nick)))
 
-(defun create-adventure (player title)
+(defun create-adventure (player title &key (description "") seers)
   (db:with-transaction ()
-    (make-instance 'adventure :title title :creator player)))
+    (make-instance 'adventure :title title :creator player
+                   :seers seers
+                   :description description)))
diff --git a/src/views/components.lisp b/src/views/components.lisp
index 95ed062..de4cc5c 100644
--- a/src/views/components.lisp
+++ b/src/views/components.lisp
@@ -17,7 +17,26 @@ the class string for the contained list items."
   (with-html
     (:ol :class class
          (dolist (item data)
-           (:li :calss item-class (render :list-item item))))))
+           (:li :class item-class (render :list-item item))))))
+
+(defrender :select ((data list) (multiple "false") name class)
+  (with-html
+    (when data
+      (:select :multiple multiple
+               :name (or name (format nil "select-~a" (class-of (first data))))
+               :class (or class (format nil "select ~a" (class-of (first data))))
+               (dolist (item data)
+                 (render :option item))))))
+
+(defrender :checkboxes ((data list) id class)
+  (with-html
+    (when data
+      (:div :class (or class (format nil "checkboxes ~a" (class-of (first data))))
+            :id (or id (format nil "checkboxes-~a" (class-of (first data))))
+            (dolist (item data)
+              (render :checkbox item)
+              (:br))))))
+
 
 ;;;; PAGE ELEMENTS
 
diff --git a/src/views/player.lisp b/src/views/player.lisp
index 087848e..5a3d074 100644
--- a/src/views/player.lisp
+++ b/src/views/player.lisp
@@ -6,3 +6,13 @@
   (with-html
     (:div :class "player details"
           (:h3 "Welcome " (nickname player)))))
+
+(defrender :option ((player player))
+  (with-html
+    (:option :value (uid player) (nickname player))))
+
+
+(defrender :checkbox ((player player))
+  (with-html
+    (:input :type "checkbox" :id (uid player) :name "POSSIBLE-SEER" :value (uid player))
+    (:label :for (uid player) (nickname player))))