diff options
Diffstat (limited to 'src/game/adventure.lisp')
| -rw-r--r-- | src/game/adventure.lisp | 261 |
1 files changed, 261 insertions, 0 deletions
diff --git a/src/game/adventure.lisp b/src/game/adventure.lisp new file mode 100644 index 0000000..801bc5e --- /dev/null +++ b/src/game/adventure.lisp @@ -0,0 +1,261 @@ +;;;; adventure.lisp -- definition and functions operating on adventures + +(in-package :dnd) + +;;; MODEL CLASSES + +(defclass adventure (game-object) + ((creator + :reader creator + :initarg :creator + :initform (error "adventures must have a creator") + :type player + :documentation "The player instance of the user who made this adventure.") + (seers + :accessor seers + :initarg :seers + :initform nil + :type (or nil (cons player)) + :documentation "Seers are the people who peer out into their instruments of divination that heroes may go on quests.") + (title + :accessor title + :initarg :title + :initform (error "A adventure needs a title") + :type string) + (description + :accessor description + :initarg :description + :initform "" + :type string) + (rumors + :accessor rumors + :initform nil + :type (or nil (cons rumor)) + :documentation "Beasts, Monsters, and Hazards rumored to be lurking about.")) + (: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.")) + + +(defclass rumor (game-object) + ((reporter + :reader reporter + :initarg :reporter + :type player + :documentation "The player who hast reported the vile rumor.") + (reported + :accessor reported + :initform (error "A rumor must contain some reported matter") + :initarg :reported + :type string + :documentation "A description of the supposed peril that awaits heroes in a particular adventure.")) + (:metaclass db:persistent-class) + (:documentation "Transcript of a rumor reported by some player related to a Adventure.")) + +;;; HELPERS + +;;; QUERIES + +(defun player-adventures (player) + "Return a list of adventures one of the players' heroes is involved in." + (mapcar #'adventure (player-quests player) )) + +(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))))) + +(defun all-adventures () + (db:store-objects-with-class 'adventure)) + +(defun adventures-visible-by (player) + (declare (ignore player)) + (all-adventures)) + +;;; TRANSACTIONS + +(defun create-adventure (player title &key (description "") seers) + (db:with-transaction () + (make-instance 'adventure :title title :creator player + :seers seers + :description description))) + +(defun report-a-rumor (reporter adventure reported) + (db:with-transaction () + (let ((rumor + (make-instance 'rumor + :reported reported + :reporter reporter))) + (push rumor (rumors adventure))))) + +(defun add-adventure-seer (player adventure) + (db:with-transaction () + (push player (seers adventure)))) + + +;;; MODEL VIEWS + +(defrender :inline ((adventure adventure)) + (with-html + (:a :href (urlpath adventure) (title adventure)))) + +(defrender :option ((adventure adventure)) + (with-html + (:option :value (uid adventure) (title adventure)))) + +(defrender :list-item ((adventure adventure)) + (render :inline adventure)) + + + + +;;; PAGES & PAGE CLASSES + +(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!"))))) + + +(defclass adventure-page () + ((adventure :reader adventure :initarg :adventure) + (player :reader player :initarg :player))) + +(defrender t ((page adventure-page)) + (let ((adventure (adventure page))) + (with-page (:title (title adventure)) + (:h1 (title adventure)) + (:p (description adventure)) + (: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"))))) + +(defclass spymaster () + ((player :reader player :initarg :player) + (adventures :reader adventures :initarg :adventures))) + + +(defrender t ((page spymaster)) + (with-page (:title "spymaster - report a rumor") + (:h1 "Of what hazards have ye heard rumor?") + (:form :method "POST" :action "/spymaster" + (:label :for "ADVENTURE" "What adventure did ye hear a rumor about?") + (:br) + (render :select (adventures page) :name "ADVENTURE") + (:br) + (:label :for "REPORTED" "And what did ye have to report?") + (:br) + (:textarea :name "REPORTED" :rows "5" :cols "60") + (:br) + (:button :type "submit" "Report!")))) + + +;;; ENDPOINT HELPERS +(define-id-plucker adventure) + + +;;; ENDPOINT DEFINITIONS + +(defendpoint* :get "/tavern/adventures" () () + (with-session (me) + (render (page-render-mode) + (make-instance 'tavern-adventures + :your-adventures (adventures-visible-by me))))) + + + + + +(defendpoint* :get "/adventure-awaits" () () + (with-session (player) + (render (page-render-mode) + (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)))) + (redirect-to + (urlpath + (create-adventure creator title + :description description + :seers possible-seers))))))) + + +(defendpoint* :get "/spymaster" () () + (with-session (player) + (render (page-render-mode) + (make-instance 'spymaster + :player player + :adventures (adventures-visible-by player))))) + + +(defendpoint* :post "/spymaster" () () + (with-session (player) + (with-plist ((adventure :adventure) (reported :reported)) (lzb:request-body) + (let ((adventure (an-adventure-with-id adventure))) + (report-a-rumor player adventure reported)) + (redirect-to "/tavern")))) + +;; NB for current hackers (Tue Mar 7 06:44:02 PM PST 2023) +;; Even though these next three all look the same I'm not going to +;; make a macro to generate them. there may be future concerns with +;; permissions or query parameters that will make them look different. + +(defendpoint* :get "/adventure/:adventure an-adventure-with-id:/:title:" () () + (with-session (player) + (render (page-render-mode) + (make-instance 'adventure-page + :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))))) |