Add: I dunno. lots of little thingsmini-marathon

5 files changed, 87 insertions, 32 deletions

diff --git a/src/app.lisp b/src/app.lisp
index 14765c7..59250e3 100644
--- a/src/app.lisp
+++ b/src/app.lisp
@@ -56,6 +56,11 @@ functions in url parameters in endpoint definitions."
     `(let ((,plist-var ,plist))
        (let ,bindings ,@body))))
 
+(defun get-checkboxes-from-body (name &optional (mapper #'object-with-uid))
+  (loop :for (key val) :on (lzb:request-body) :by #'cddr
+        :when (string-equal key name)
+          :collect (funcall mapper val)))
+
 ;;; VALIDATOR TRANSFORMS
 
 (defmacro define-id-plucker (class)
diff --git a/src/game/adventure.lisp b/src/game/adventure.lisp
index 9c3fafd..e612efc 100644
--- a/src/game/adventure.lisp
+++ b/src/game/adventure.lisp
@@ -59,20 +59,11 @@
 (defmethod unique-name ((adventure adventure))
   (title adventure))
 
-;;; QUERIES
-
-(defun player-adventures (player)
-  "Return a list of adventures one of the players' heroes is involved in."
-  (mapcar #'adventure (player-quests player) ))
+(defun has-seer-privs (player adventure)
+  (or (eq player (creator adventure))
+      (member player (seers adventure))))
 
-(defun adventure-heros (adventure &key (activep t))
-  "All the heros actively involved in this ADVENTURE. 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-adventure adventure))
-               (quests-in-adventure adventure)))))
+;;; QUERIES
 
 (defun all-adventures ()
   (db:store-objects-with-class 'adventure))
@@ -120,13 +111,10 @@ only the active quest(s) are considered, otherwise all quests are considered."
     (with-html
       (:p (subseq reported 0 (min 20 (length reported))) " ..." " -- " (render :inline reporter)))))
 
-(defun rumors-section (page)
+(defun adventure-rumors-section (page)
   (let ((adventure (adventure page)))
    (with-html
      (:div
-      (when (rumors adventure)
-        (:h3 "Rumors")
-        (render :list (rumors adventure)))
       (:h4 "Report a rumor")
       (:form :method "POST" :action (adventure-rumors-path adventure)
              (:label :for "REPORTED" "What did ye have to report?")
@@ -135,7 +123,7 @@ only the active quest(s) are considered, otherwise all quests are considered."
              (:br)
              (:button :type "submit" "Report!"))))))
 
-(defun seers-section (page)
+(defun adventure-seers-section (page)
   (let ((adventure (adventure page)))
     (with-html
       (:div
@@ -151,6 +139,45 @@ only the active quest(s) are considered, otherwise all quests are considered."
                (:button :type "submit" "Add Seer")))))))
 
 
+
+(defun adventure-quests-section (page)
+  (let* ((adventure
+           (adventure page))
+         (player
+           (player page))
+         (quests
+           (quests-in-adventure adventure))
+         (active-quest
+           (find-if #'quest-startedp quests))
+         (not-started-quests
+           (remove-if-not (complement #'quest-startedp) quests)))
+    (with-html
+      (:div
+       (when active-quest
+         (:p (render :inline active-quest) " is active."))
+       (when not-started-quests
+         (:h3 "Planned Quests:")
+         (render :list not-started-quests))
+       (when (and (has-seer-privs player adventure) (rumors adventure))
+         (:h3 "Choose rumors to make into quests")
+         (quest-creation-form adventure))))))
+
+(defun quest-creation-form (adventure)
+  (with-html
+    (:div
+     (:form
+      :method "POST" :action "/conceive-a-quest"
+      (:input :type "hidden" :value (uid adventure) :name "ADVENTURE")
+      (:label :for "NAME" "Quest Name")
+      (:input :type "text" :name "NAME")
+      (render :checkboxes (rumors adventure) :item-name "RUMOR")
+      (:button :type "submit" "Create Quest")))))
+
+(defrender :checkbox ((rumor rumor) (name "RUMOR"))
+  (with-html
+    (:input :type "checkbox" :id (uid rumor) :name name :value (uid rumor))
+    (:label :for (uid rumor) (subseq (reported rumor) 0 (min 20 (length (reported rumor)))))))
+
 ;;; PAGES & PAGE CLASSES
 
 (defclass adventure-awaits ()
@@ -179,7 +206,7 @@ only the active quest(s) are considered, otherwise all quests are considered."
          :for "SEERS"
          "Who may act as a seer on this adventure?")
         (:br)
-        (render :checkboxes (possible-seers page)))
+        (render :checkboxes (possible-seers page) :item-name "POSSIBLE-SEER"))
       
       (:h4 "Describe the adventure you're about to begin:")
       (:textarea  :name "DESCRIPTION" :rows "5" :cols "60")
@@ -191,6 +218,7 @@ only the active quest(s) are considered, otherwise all quests are considered."
   ((adventure player possible-seers)))
 
 (defmethod possible-seers ((page adventure-page))
+  ;; you can only add seers when you are the creator
   (when (eq (player page) (creator (adventure page)))
     (remove (player page) (all-players))))
 
@@ -200,8 +228,9 @@ only the active quest(s) are considered, otherwise all quests are considered."
       (:h1 (title adventure))
       (:p (description adventure))
       (:p "Created by: " (render :link-to (player page)))
-      (rumors-section page)
-      (seers-section page))))
+      (adventure-seers-section page)
+      (adventure-quests-section page)
+      (adventure-rumors-section page))))
 
 (defclass/std tavern-adventures ()
   ((your-adventures)))
@@ -218,6 +247,21 @@ only the active quest(s) are considered, otherwise all quests are considered."
 
 ;;; ENDPOINT DEFINITIONS
 
+(defendpoint* :post "/conceive-a-quest" () ()
+  (with-session (player)
+    (with-checked-plist
+        ((adventure :adventure 'an-adventure-with-id)
+         (name :name 'a-short-string))
+      (lzb:request-body)
+      (unless (has-seer-privs player adventure)
+        (lzb:http-err 403))
+      (let ((rumors
+              (get-checkboxes-from-body "RUMOR")))
+        ;; make a new quest, and remove the rumors from the adventure
+        (create-quest-from-rumors adventure name rumors)
+        ;; redirect to the adventure page:
+        (redirect-to  (urlpath adventure))))))
+
 (defendpoint* :get "/tavern/adventures" () ()
   (with-session (me)
     (render (page-render-mode)
@@ -231,13 +275,13 @@ only the active quest(s) are considered, otherwise all quests are considered."
             (make-instance 'adventure-awaits
                            :possible-seers (remove player (all-players))))))
 
+
+
 (defendpoint* :post "/adventure-awaits" () ()
   (with-session (creator)
     (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))))
+              (get-checkboxes-from-body "POSSIBLE-SEER")))
         (redirect-to
          (urlpath
           (create-adventure creator title
diff --git a/src/game/quest.lisp b/src/game/quest.lisp
index ab1b9a7..bb0d680 100644
--- a/src/game/quest.lisp
+++ b/src/game/quest.lisp
@@ -31,6 +31,9 @@
 
 ;;; HELPERS
 
+(defun quest-startedp (quest)
+  (quest-inception quest))
+
 ;;; QUERIES
 
 (defun player-quests (player)
@@ -39,6 +42,10 @@
 
 ;;; TRANSACTIONS
 
+(defun create-quest-from-rumors (adventure name rumors)
+  ;; TBD
+  )
+
 ;;; MODEL VIEWS
 
 (defrender :link-to ((quest quest))
diff --git a/src/player.lisp b/src/player.lisp
index 6533f59..965812f 100644
--- a/src/player.lisp
+++ b/src/player.lisp
@@ -81,9 +81,9 @@
   (with-html
     (:option :value (uid player) (nickname player))))
 
-(defrender :checkbox ((player player))
+(defrender :checkbox ((player player) (name "PLAYER"))
   (with-html
-    (:input :type "checkbox" :id (uid player) :name "POSSIBLE-SEER" :value (uid player))
+    (:input :type "checkbox" :id (uid player) :name name :value (uid player))
     (:label :for (uid player) (nickname player))))
 
 (defrender :list-item ((player player))
@@ -94,8 +94,7 @@
   (render :inline player))
 
 (defrender :inline ((player player))
-  (with-html (:a :href (urlpath player) (nickname player)))
-  )
+  (with-html (:a :href (urlpath player) (nickname player))))
 
 ;;; PAGES & PAGE CLASSES
 
diff --git a/src/view-components.lisp b/src/view-components.lisp
index 1c21952..ee88628 100644
--- a/src/view-components.lisp
+++ b/src/view-components.lisp
@@ -27,13 +27,13 @@ the class string for the contained list items."
                (dolist (item data)
                  (render :option item))))))
 
-(defrender :checkboxes ((data list) id class)
+(defrender :checkboxes ((data list) id class item-name)
   (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))))
+      (:div :class (or class (format nil "checkboxes ~a" (class-name (class-of (first data)))))
+            :id (or id (format nil "checkboxes-~a" (class-name (class-of (first data)))))
             (dolist (item data)
-              (render :checkbox item)
+              (render :checkbox item :name item-name)
               (:br))))))