From 2b6e1eec2bf5c27223fbf2d09cd10a322fc09909 Mon Sep 17 00:00:00 2001 From: colin Date: Sat, 1 Apr 2023 18:04:45 -0700 Subject: Add: I dunno. lots of little things --- src/app.lisp | 5 +++ src/game/adventure.lisp | 92 +++++++++++++++++++++++++++++++++++------------- src/game/quest.lisp | 7 ++++ src/player.lisp | 7 ++-- src/view-components.lisp | 8 ++--- 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)))))) -- cgit v1.2.3