From cc3f850c514967ae2f9effef7e68e1d4965c6865 Mon Sep 17 00:00:00 2001 From: colin Date: Sat, 1 Apr 2023 09:48:08 -0700 Subject: Refactor to make cooperative hacking nicer --- src/game/abstract.lisp | 47 +++++++++ src/game/adventure.lisp | 261 ++++++++++++++++++++++++++++++++++++++++++++++++ src/game/hazard.lisp | 28 ++++++ src/game/hero.lisp | 123 +++++++++++++++++++++++ src/game/quest.lisp | 51 ++++++++++ src/game/rumor.lisp | 0 src/game/tavern.lisp | 48 +++++++++ 7 files changed, 558 insertions(+) create mode 100644 src/game/abstract.lisp create mode 100644 src/game/adventure.lisp create mode 100644 src/game/hazard.lisp create mode 100644 src/game/hero.lisp create mode 100644 src/game/quest.lisp create mode 100644 src/game/rumor.lisp create mode 100644 src/game/tavern.lisp (limited to 'src/game') 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 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)))) + + + -- cgit v1.2.3