;;;; 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)))))