;;;; 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 (defun adventure-rumors-path (adventure) (format nil "/rumors-about/~a" (uid adventure))) (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 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)) (defrender :list-item ((rumor rumor)) (with-slots (reporter reported) rumor (with-html (:p (subseq reported 0 (min 20 (length reported))) " ..." " -- " (render :inline reporter))))) (defun 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?") (:br) (:textarea :name "REPORTED" :rows "5" :cols "40") (:br) (:button :type "submit" "Report!")))))) (defun seers-section (page) (let ((adventure (adventure page))) (with-html (:div (when (seers adventure) (:h4 "Seers: ") (render :list (seers adventure))) (when (possible-seers page) (: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"))))))) ;;; 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/std adventure-page () ((adventure player possible-seers))) (defmethod possible-seers ((page adventure-page)) (when (eq (player page) (creator (adventure page))) (remove (player page) (all-players)))) (defrender t ((page adventure-page)) (let ((adventure (adventure page))) (with-page (:title (title adventure)) (:h1 (title adventure)) (:p (description adventure)) (:p "Created by: " (render :link-to (player page))) (rumors-section page) (seers-section page)))) (defclass/std tavern-adventures () ((your-adventures))) (defrender t ((page tavern-adventures)) (with-page (:title "Your Adventures") (:h1 "You are seer on the following adventures") (render :list (your-adventures page)))) ;;; 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* :post "/rumors-about/:adventure an-adventure-with-id:" () () (with-session (player) (with-plist ((reported :reported)) (lzb:request-body) (report-a-rumor player adventure reported) (redirect-to (urlpath adventure))))) ;; 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)))))