summaryrefslogtreecommitdiff
path: root/src/game
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2023-04-01 09:48:08 -0700
committercolin <colin@cicadas.surf>2023-04-01 09:48:08 -0700
commitcc3f850c514967ae2f9effef7e68e1d4965c6865 (patch)
tree6d0b52c3a65d53f247f4c8272667aca5a4e05bac /src/game
parent56a584ab1b13ff9510dd5145a778000169901a76 (diff)
Refactor to make cooperative hacking nicer
Diffstat (limited to 'src/game')
-rw-r--r--src/game/abstract.lisp47
-rw-r--r--src/game/adventure.lisp261
-rw-r--r--src/game/hazard.lisp28
-rw-r--r--src/game/hero.lisp123
-rw-r--r--src/game/quest.lisp51
-rw-r--r--src/game/rumor.lisp0
-rw-r--r--src/game/tavern.lisp48
7 files changed, 558 insertions, 0 deletions
diff --git a/src/game/abstract.lisp b/src/game/abstract.lisp
new file mode 100644
index 0000000..f54621e
--- /dev/null
+++ b/src/game/abstract.lisp
@@ -0,0 +1,47 @@
+;;;; abstract.lisp -- classes meant to be inherited
+
+(in-package :dnd)
+
+
+;;; PERSISTENT MIXINS
+(defclass has-uid ()
+ ((nuid :reader uid
+ :initform (nuid)
+ :index-type idx:string-unique-index
+ :index-reader object-with-uid))
+ (:metaclass db:persistent-class))
+
+(defclass can-equip ()
+ ((equipment-table
+ :initform nil
+ :type list
+ :documentation "A PLIST mapping 'equipment slots' to instances of LOOT. Equipment slots are things like :head, :torso, :left-ring, etc")
+ (equipment-slot-names
+ :initform +standard-humanoid-equipment+
+ :initarg :slot-names
+ :type (list keyword)
+ :documentation "The list of slots available to this entity."))
+ (:metaclass db:persistent-class))
+
+(defclass has-bag ()
+ ((bag
+ :reader bag
+ :initform nil
+ :type list
+ :documentation "A list of items that this entity is carrying."))
+ (:metaclass db:persistent-class))
+
+(defclass has-chronicle ()
+ ((chronicle :accessor chronicle :initform nil))
+ (:metaclass db:persistent-class)
+ (:documentation "A chronicle is a general purpose log of events."))
+
+(defparameter +standard-humanoid-equipment+
+ '(:head :neck :torso :waist :legs :feet :arms :left-fingers :right-fingers
+ :left-holding :right-holding :cloak)
+ "The equipment slots for standard humanoids")
+
+;;; ABSTRACT CLASSES
+(defclass game-object (db:store-object has-uid has-chronicle)
+ ()
+ (:metaclass db:persistent-class))
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)))))
diff --git a/src/game/hazard.lisp b/src/game/hazard.lisp
new file mode 100644
index 0000000..c6ad58d
--- /dev/null
+++ b/src/game/hazard.lisp
@@ -0,0 +1,28 @@
+(in-package :dnd)
+
+(defclass hazard (game-object)
+ ((quest
+ :accessor quest-of
+ :index-type idx:hash-index
+ :index-reader hazards-in-quest
+ :documentation "The quest to which this hazard belongs. Initially it is unbound. It becomes boudn when the hazard is added to a quest.")
+ (description
+ :accessor description
+ :initarg :description
+ :initform ""
+ :type string
+ :documentation "")
+ (overcomep
+ :accessor is-overcome
+ :initform nil
+ :documentation "indicates whether or not this hazard has been overcome.")
+ (imminence
+ :accessor imminence-of
+ :type priority
+ :documentation "")
+ (menace ;; difficulty
+ :accessor menace-of
+ :type integer
+ :documentation "How dangerous the hazard is." ))
+ (:metaclass db:persistent-class)
+ (:documentation "Hazard is a superclass for all hazards encountered in a quest. It's chronicle includes data about which heroes fought and which overcame."))
diff --git a/src/game/hero.lisp b/src/game/hero.lisp
new file mode 100644
index 0000000..68606b2
--- /dev/null
+++ b/src/game/hero.lisp
@@ -0,0 +1,123 @@
+;;;; hero.lisp -- code related to heros
+
+(in-package :dnd)
+
+;;; MODEL CLASSES
+
+(deftype title ()
+ `(member :noob))
+
+(deftype character-class ()
+ `(member :hero))
+
+(deftype priority ()
+ `(member :low :medium :high))
+
+(defun hero-class (h)
+ "barGaryan") ; TODO: real implementation
+
+(defun hero-title (h)
+ "Scouse Chef") ; TODO: real implementation
+
+(defun renown (hero)
+ (experience hero)) ; TODO: real implementaiton
+
+
+(defclass hero (game-object has-bag can-equip)
+ ((name
+ :accessor name
+ :initarg :name
+ :initform (error "Heroes must be named")
+ :type string
+ :index-type idx:string-unique-index
+ :index-reader hero-known-as)
+ (player
+ :reader player
+ :initarg :player
+ :type player
+ :index-type idx:hash-index
+ :index-reader player-heroes)
+ (quest
+ :accessor quest
+ :initarg :quest
+ :initform nil
+ :type (or nil quest)
+ :documentation "The quest that this hero is on. A hero may be on only one quest at a time."))
+ (:metaclass db:persistent-class))
+
+(defmethod adventure ((hero hero))
+ (a:when-let (quest (quest hero))
+ (adventure quest)))
+
+;;; HELPERS
+
+;;; QUERIES
+(defun all-heroes ()
+ (db:store-objects-with-class 'hero))
+
+;;; TRANSACTIONS
+
+(defun birth-from-the-goddess-loins (player name)
+ (db:with-transaction ()
+ (make-instance 'hero :name name :player player)))
+
+;;; MODEL VIEWS
+
+(defrender :list-item ((hero hero))
+ (with-html
+ (:p
+ (render :link-to hero)
+ (a:when-let (quest (quest hero))
+ (:span "who's quest is to")
+ (:span (render :link-to quest))))))
+
+
+(defrender :link-to ((hero hero))
+ (with-html
+ (:a :href (urlpath hero)
+ (unique-name hero) "the" (hero-class hero) (hero-title hero))))
+
+;;; PAGES & PAGE CLASSES
+
+(defclass hero-page ()
+ ((hero :reader hero :initarg :hero)
+ (player :reader player :initarg :player)))
+
+(defrender t ((page hero-page))
+ (with-page (:title (unique-name (hero page)))
+ (:h1 (unique-name (hero page)))
+ (:p "uhhh.....")))
+
+(defrender t ((page (eql :goddess-shrine)))
+ (with-page (:title "A Sacred Shrine")
+ (:header
+ (:h1 "Pray and become a hero..."))
+ (:form :method "POST" :action "/goddess-shrine"
+ (:label :for "NAME" "Enter the epithet by which the ages shall know thy hero:")
+ (:input :name "NAME")
+ (:button :type "submit" "Pray To The Goddess"))))
+
+
+;;; ENDPOINT HELPERS
+
+(define-id-plucker hero)
+
+;;; ENDPOINT DEFINITIONS
+
+(defendpoint* :get "/goddess-shrine" () ()
+ (with-session (player)
+ (render (page-render-mode) :goddess-shrine)))
+
+(defendpoint* :post "/goddess-shrine" () ()
+ (with-session (player)
+ (with-checked-plist ((name :name 'a-short-string)) (lzb:request-body)
+ (birth-from-the-goddess-loins player name)
+ (redirect-to "/tavern"))))
+
+
+(defendpoint* :get "/hero/:hero a-hero-with-id:/:name:" () ()
+ (with-session (player)
+ (render (page-render-mode)
+ (make-instance 'hero-page
+ :player player
+ :hero hero))))
diff --git a/src/game/quest.lisp b/src/game/quest.lisp
new file mode 100644
index 0000000..ed9a5b4
--- /dev/null
+++ b/src/game/quest.lisp
@@ -0,0 +1,51 @@
+(in-package :dnd)
+
+(defclass quest (game-object)
+ ((adventure
+ :reader adventure
+ :initarg :adventure
+ :initform (error "No quest can fall outside the scope of a adventure.")
+ :type adventure
+ :index-type idx:hash-index
+ :index-reader quests-in-adventure
+ :documentation "The adventure to which this quest belongs")
+ (name
+ :accessor name
+ :initarg :name
+ :type string
+ :initform (format nil "~a" (gensym "QUEST")))
+ (horizon-of-hope
+ :accessor horizon-of-hope
+ :initarg :deadline
+ :type integer
+ :initform nil
+ :documentation "When all hope becomes lost.")
+ (inception
+ :accessor quest-inception
+ :initform nil
+ :type (or nil integer)
+ :documentation "Time at which the quest began."))
+ (:metaclass db:persistent-class)
+ (:documentation "A collection of hazards with a deadline and start date which heroes will attack."))
+
+
+
+(defun player-quests (player)
+ "Return all quests in which one of player's heroes is engaged."
+ (remove nil (mapcar #'quest (player-heroes player))))
+
+(define-id-plucker quest)
+
+
+(defrender :link-to ((quest quest))
+ (with-html
+ (:a :href (urlpath quest)
+ (name quest))))
+
+(defclass quest-page ()
+ ((quest :reader quest :initarg :quest)
+ (player :reader player :initarg :player)))
+
+(defrender t ((page quest))
+ (with-page (:title (unique-name (quest page )))
+ (:h1 (unique-name (quest page)))))
diff --git a/src/game/rumor.lisp b/src/game/rumor.lisp
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/src/game/rumor.lisp
diff --git a/src/game/tavern.lisp b/src/game/tavern.lisp
new file mode 100644
index 0000000..25d6ef0
--- /dev/null
+++ b/src/game/tavern.lisp
@@ -0,0 +1,48 @@
+;;;; pages/tavern.lisp -- enter the tavern
+
+(in-package :dnd)
+
+(defclass/std tavern ()
+ ((player)))
+
+(defrender t ((tavern tavern))
+ (with-page (:title "A Bustling Tavern")
+ (let ((player (player tavern)))
+ (render :details player)
+ (when (player-heroes player)
+ (:h2 "Your Heroes:")
+ (render :list (player-heroes player)))
+ (:a :href "tavern/adventures" "Adventures for which you are seer.")
+ (:br)
+ (:a :href "/goddess-shrine" "Pray a new hero rises.")
+ (:br)
+ (:a :href "/spymaster" "Report a Roguish Rumour...")
+ (:br)
+ (:a :href "/adventure-awaits" "Embark on a new Adventure!"))))
+
+
+(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))))
+
+(defendpoint* :get "/tavern" () ()
+ (with-session (me)
+ (render (page-render-mode)
+ (make-instance 'tavern :player me))))
+
+
+
+
+(defendpoint* :get "/quest/:quest a-quest-with-id:/:name:" () ()
+ (with-session (player)
+ (render (page-render-mode)
+ (make-instance 'quest-page
+ :player player
+ :hero quest))))
+
+
+