path: root/src/game/adventure.lisp

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

(defun has-seer-privs (player adventure)
  (or (eq player (creator adventure))
      (member player (seers adventure))))

;;; QUERIES

(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 adventure-rumors-section (page)
  (let ((adventure (adventure page)))
   (with-html
     (:div
      (: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 adventure-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")))))))



(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 ()
  ((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) :item-name "POSSIBLE-SEER"))
      
      (: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))
  ;; you can only add seers when you are the creator
  (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)))
      (adventure-seers-section page)
      (adventure-quests-section page)
      (adventure-rumors-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* :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)
            (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
              (get-checkboxes-from-body "POSSIBLE-SEER")))
        (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)))))