From 56a584ab1b13ff9510dd5145a778000169901a76 Mon Sep 17 00:00:00 2001
From: Grant Shoshin Shangreaux <shoshin@cicadas.surf>
Date: Sat, 1 Apr 2023 09:59:16 -0500
Subject: Add: aventure seers form

---
 src/endpoints.lisp            | 10 +++++++++-
 src/model.lisp                |  3 ---
 src/pages/adventure-page.lisp | 17 +++++++++++------
 src/queries.lisp              |  3 +++
 src/transactions.lisp         |  4 ++++
 5 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/src/endpoints.lisp b/src/endpoints.lisp
index acc62c9..a29dc3f 100644
--- a/src/endpoints.lisp
+++ b/src/endpoints.lisp
@@ -75,7 +75,7 @@ functions in url parameters in endpoint definitions."
     `(defun ,function-name (id)
        (let ((object (object-with-uid (string-upcase id))))
          (unless (typep object ',class)
-           (lzb:http-err 404))
+           (lzb:http-err 404 (format nil "No ~a with id = ~a" ',class id)))
          object))))
 
 (define-id-plucker adventure)
@@ -201,6 +201,14 @@ functions in url parameters in endpoint definitions."
                            :player player
                            :adventure adventure)))) ;; for now, render raw adventure.
 
+(defendpoint* :post "/adventure/:adventure an-adventure-with-id:/:title:" () ()
+  (with-session (player)
+    (with-plist ((seer :seer)) (lzb:request-body)
+      (when (player-with-nick seer)
+	(add-adventure-seer (player-with-nick seer) adventure))
+      (redirect-to (urlpath adventure)))))
+
+
 (defendpoint* :get "/hero/:hero a-hero-with-id:/:name:" () ()
   (with-session (player)
     (render (page-render-mode)
diff --git a/src/model.lisp b/src/model.lisp
index f8d19bc..e44d3b9 100644
--- a/src/model.lisp
+++ b/src/model.lisp
@@ -157,9 +157,6 @@
   (:metaclass db:persistent-class)
   (:documentation "A adventure is a container of quests. Adventures are expected to be engaged with on a particular schedule, and are run by particular people."))
 
-(defun adventure-seers (adventure)
-  (cons (creator adventure) (seers adventure)))
-
 (defclass rumor (game-object)
   ((reporter
     :reader reporter
diff --git a/src/pages/adventure-page.lisp b/src/pages/adventure-page.lisp
index 795f3db..96264e3 100644
--- a/src/pages/adventure-page.lisp
+++ b/src/pages/adventure-page.lisp
@@ -11,9 +11,14 @@
     (with-page (:title (title adventure))
       (:h1 (title adventure))
       (:p (description adventure))
-      (:h2 "Seers: " (render :list (adventure-seers adventure)))
-      (:form :method "POST" :action ""
-	     (:label :for "SEER" "Add a seer to this adventure:") (:br)
-	     (:select :name "SEER"
-		      (loop :for p :in (db:store-objects-with-class 'player)
-			    :collect (:option :value (nickname p) (nickname p))))))))
+      (:h2 "Rumors: ")
+					; (render :list (rumors adventure))
+      (:h2 "Architect of this Adventure: " (nickname (creator adventure)))
+      (:h2 "Seers: ")
+      (render :list (seers adventure))
+      (:form :method "POST" :action (urlpath adventure)
+             (:label :for "SEER" "Add a seer to this adventure:") (:br)
+             (:select :name "SEER"
+                      (loop :for p :in (all-other-players (player page))
+                            :collect (:option :value (nickname p) (nickname p))))
+             (:button :type "submit" "Add Seer")))))
diff --git a/src/queries.lisp b/src/queries.lisp
index 07a8d5f..13c1d26 100644
--- a/src/queries.lisp
+++ b/src/queries.lisp
@@ -8,6 +8,9 @@
 (defun all-players ()
   (db:store-objects-with-class 'player))
 
+(defun all-other-players (player)
+  (remove-if (lambda (p) (eq player p)) (all-players)))
+
 (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 61f7f9b..3372520 100644
--- a/src/transactions.lisp
+++ b/src/transactions.lisp
@@ -30,3 +30,7 @@
                            :reported reported
                            :reporter reporter)))
       (push rumor (rumors adventure)))))
+
+(defun add-adventure-seer (player adventure)
+  (db:with-transaction ()
+    (push player (seers adventure))))
-- 
cgit v1.2.3