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/app.lisp | 81 +++++++++++++ src/endpoints.lisp | 227 ---------------------------------- 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 ++++++++ src/model.lisp | 233 ----------------------------------- src/pages/adventure-awaits.lisp | 36 ------ src/pages/adventure-page.lisp | 24 ---- src/pages/doorkeeper.lisp | 19 --- src/pages/goddess-shrine.lisp | 13 -- src/pages/hero-page.lisp | 12 -- src/pages/join.lisp | 13 -- src/pages/quest-page.lisp | 11 -- src/pages/spymaster.lisp | 18 --- src/pages/tavern.lisp | 30 ----- src/player.lisp | 160 ++++++++++++++++++++++++ src/queries.lisp | 50 ++------ src/transactions.lisp | 29 ----- src/view-components.lisp | 51 ++++++++ src/views/adventure.lisp | 14 --- src/views/components.lisp | 51 -------- src/views/hazard.lisp | 4 - src/views/hero.lisp | 17 --- src/views/player.lisp | 22 ---- src/views/quest.lisp | 10 -- src/views/rumor.lisp | 4 - 30 files changed, 861 insertions(+), 826 deletions(-) create mode 100644 src/app.lisp delete mode 100644 src/endpoints.lisp 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 delete mode 100644 src/model.lisp delete mode 100644 src/pages/adventure-awaits.lisp delete mode 100644 src/pages/adventure-page.lisp delete mode 100644 src/pages/doorkeeper.lisp delete mode 100644 src/pages/goddess-shrine.lisp delete mode 100644 src/pages/hero-page.lisp delete mode 100644 src/pages/join.lisp delete mode 100644 src/pages/quest-page.lisp delete mode 100644 src/pages/tavern.lisp create mode 100644 src/player.lisp create mode 100644 src/view-components.lisp delete mode 100644 src/views/adventure.lisp delete mode 100644 src/views/components.lisp delete mode 100644 src/views/hazard.lisp delete mode 100644 src/views/hero.lisp delete mode 100644 src/views/player.lisp delete mode 100644 src/views/quest.lisp delete mode 100644 src/views/rumor.lisp (limited to 'src') diff --git a/src/app.lisp b/src/app.lisp new file mode 100644 index 0000000..14765c7 --- /dev/null +++ b/src/app.lisp @@ -0,0 +1,81 @@ +;;;; app.lisp -- lazybones application definition and helpers + +(in-package :dnd) + +(lzb:provision-app () + :title "Dungeons & Deadlines" + :version "0.1.0" + :content-type "text/html") + +(defparameter +session-cookie-name+ "dnd-session") + +;;; UTILITIES + +(defun redirect-to (location) + "Set the lazybones response header and response code for redirecting to LOCATION. +This procedure will error if lazybones:*request* is not currently bound." + (setf (lzb:response-header :location) location + (lzb:response-code) "303")) + +(defun current-session () + "Get the session associated with the current request. Will throw an +error if lazybones:*request* is not currently bound. It will return +NIL if there is no session for the current request. + +I.e. It should be called within the scope of a request handler." + (session-with-id (lzb:request-cookie +session-cookie-name+ ))) + +(defun text-browser-p (user-agent) + "Returns T if user agent string matches on a list of known text browsers." + (some (lambda (s) (search s user-agent)) '("Emacs" "Lynx" "w3m"))) + +(defun page-render-mode (&optional user-agent) + "Given the USER-AGENT string from request headers, returns a symbol which +indicates which render mode to use. For example if Emacs is the user-agent, +return :text-12mode." + (let ((user-agent + (or user-agent + (lzb:request-header :user-agent)))) + (cond ((text-browser-p user-agent) :text-page) + (t :page)))) + + +(defmacro with-checked-plist (typed-keys plist &rest body) + "Like WITH-PLIST, but allows you to pass a checking function to +automatically tansform plist values into something you actually +want. This is modelled after the way LAZYBONES allows for similar +functions in url parameters in endpoint definitions." + (let* ((plist-var + (gensym)) + (bindings + (loop :for (var key . pred) :in typed-keys + :when pred + :collect `(,var (funcall ,(first pred) (getf ,plist-var ',key))) + :else + :collect `(,var (getf ,plist-var ',key))))) + `(let ((,plist-var ,plist)) + (let ,bindings ,@body)))) + +;;; VALIDATOR TRANSFORMS + +(defmacro define-id-plucker (class) + (let ((function-name + (intern (format nil "~a-~a-WITH-ID" + (if (starts-with-vowel-p (symbol-name class)) + "AN" "A") + class) + :dnd))) + `(defun ,function-name (id) + (let ((object (object-with-uid (string-upcase id)))) + (unless (typep object ',class) + (lzb:http-err 404 (format nil "No ~a with id = ~a" ',class id))) + object)))) + + +(defun a-short-string (str) + (unless (and (stringp str) (< (length str) 50)) + (lzb:http-err 400 "The value must be a string at most 50 characters long.")) + str) + + + diff --git a/src/endpoints.lisp b/src/endpoints.lisp deleted file mode 100644 index a29dc3f..0000000 --- a/src/endpoints.lisp +++ /dev/null @@ -1,227 +0,0 @@ -;;;; endpoints.lisp -- http endpoints for dnd - -(in-package :dnd) - -(lzb:provision-app () - :title "Dungeons & Deadlines" - :version "0.1.0" - :content-type "text/html") - -(defparameter +session-cookie-name+ "dnd-session") - -;;; UTILITIES - -(defun redirect-to (location) - "Set the lazybones response header and response code for redirecting to LOCATION. -This procedure will error if lazybones:*request* is not currently bound." - (setf (lzb:response-header :location) location - (lzb:response-code) "303")) - -(defun current-session () - "Get the session associated with the current request. Will throw an -error if lazybones:*request* is not currently bound. It will return -NIL if there is no session for the current request. - -I.e. It should be called within the scope of a request handler." - (session-with-id (lzb:request-cookie +session-cookie-name+ ))) - -(defun text-browser-p (user-agent) - "Returns T if user agent string matches on a list of known text browsers." - (some (lambda (s) (search s user-agent)) '("Emacs" "Lynx" "w3m"))) - -(defun page-render-mode (&optional user-agent) - "Given the USER-AGENT string from request headers, returns a symbol which -indicates which render mode to use. For example if Emacs is the user-agent, -return :text-12mode." - (let ((user-agent - (or user-agent - (lzb:request-header :user-agent)))) - (cond ((text-browser-p user-agent) :text-page) - (t :page)))) - -(defmacro with-session ((player &key session (redirect "/tavern-door")) &body body) - (let ((session (or session (gensym "SESSION")))) - `(a:if-let (,session (current-session)) - (let ((,player (session-player ,session))) - (declare (ignorable ,player)) - ,@body) - (redirect-to ,redirect)))) - -(defmacro with-checked-plist (typed-keys plist &rest body) - "Like WITH-PLIST, but allows you to pass a checking function to -automatically tansform plist values into something you actually -want. This is modelled after the way LAZYBONES allows for similar -functions in url parameters in endpoint definitions." - (let* ((plist-var - (gensym)) - (bindings - (loop :for (var key . pred) :in typed-keys - :when pred - :collect `(,var (funcall ,(first pred) (getf ,plist-var ',key))) - :else - :collect `(,var (getf ,plist-var ',key))))) - `(let ((,plist-var ,plist)) - (let ,bindings ,@body)))) - -;;; VALIDATOR TRANSFORMS - -(defmacro define-id-plucker (class) - (let ((function-name - (intern (format nil "~a-~a-WITH-ID" - (if (starts-with-vowel-p (symbol-name class)) - "AN" "A") - class) - :dnd))) - `(defun ,function-name (id) - (let ((object (object-with-uid (string-upcase id)))) - (unless (typep object ',class) - (lzb:http-err 404 (format nil "No ~a with id = ~a" ',class id))) - object)))) - -(define-id-plucker adventure) - -(define-id-plucker hero) - -(define-id-plucker quest) - -(defun a-valid-nick (name) - "Errors with 400 if the name is not a valid hero name." - (unless (valid-nick-p name) - (lzb:http-err 400 (format nil "Player Nick Invalid"))) - name) - -(defun a-short-string (str) - (unless (and (stringp str) (< (length str) 50)) - (lzb:http-err 400 "The value must be a string at most 50 characters long.")) - str) - - -;;; OPEN ENDPOINTS - -(defendpoint* :get "/" () () - (redirect-to "/tavern")) - -(defendpoint* :get "/tavern-door" () () - "Tavern door is where the player logs into the system." - (let ((doorkeeper - (make-instance 'doorkeeper :message (or (flashed-value :tavern-door) "")))) - (render (page-render-mode) - doorkeeper))) - -(defendpoint* :post "/tavern-door" () () - (with-plist ((nick :nickname)) (lzb:request-body) - (a:if-let ((player - (player-with-nick (string-trim " " nick)))) - (a:when-let ((sesh - (new-sesh player))) - (lzb:set-response-cookie - +session-cookie-name+ (session-id sesh) - :path "/" :domain (host *config*)) - (redirect-to "/tavern")) - (progn - (flash :tavern-door (format nil "Hrmm... ~a you say? It ain't on the register." nick)) - (redirect-to "/tavern-door"))))) - -(defendpoint* :get "/join" () () - (render (page-render-mode) :join)) - -(defendpoint* :post "/join" () () - "Registers a new player" - (with-checked-plist ((nick :nickname 'a-valid-nick)) (lzb:request-body) - (register-player nick) - (redirect-to "/tavern-door"))) - -;;; SESSION ENDPOINTS - -(defendpoint* :get "/tavern" () () - (with-session (me) - (render (page-render-mode) - (make-instance 'tavern :player me)))) - -(defendpoint* :get "/tavern/adventures" () () - (with-session (me) - (render (page-render-mode) - (make-instance 'tavern-adventures - :your-adventures (adventures-visible-by me))))) - -(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 "/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))))) - - -(defendpoint* :get "/hero/:hero a-hero-with-id:/:name:" () () - (with-session (player) - (render (page-render-mode) - (make-instance 'hero-page - :player player - :hero hero)))) - -(defendpoint* :get "/quest/:quest a-quest-with-id:/:name:" () () - (with-session (player) - (render (page-render-mode) - (make-instance 'quest-page - :player player - :hero quest)))) - - - 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)))) + + + diff --git a/src/model.lisp b/src/model.lisp deleted file mode 100644 index e44d3b9..0000000 --- a/src/model.lisp +++ /dev/null @@ -1,233 +0,0 @@ -;;;; model.lisp -- bknr.datastore class definitions for dnd - -(in-package :dnd) - -(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 - - -;;; 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)) - -;;; SYSTEM CLASSES - -(defclass player (db:store-object has-uid) - ((nick - :reader nickname - :initarg :nickname - :initform (error "Players must have a nick") - :type string - :index-type idx:string-unique-index - :index-reader player-with-nick) - (pwhash - :accessor pwhash - :type string - :initarg :pwhash - :documentation "A hash of the password, hashed with the value of the pwsalt slot.") - (pwsalt - :reader pwsalt - :initform (nuid) - :type string - :documentation "Salt for this hero's password hash.")) - (:metaclass db:persistent-class)) - - -;; TODO expiration? -(defclass session (db:store-object) - ((player :reader session-player - :initarg :player) - (id :reader session-id - :initform (nuid) - :index-type idx:string-unique-index - :index-reader session-with-id)) - (:metaclass db:persistent-class)) - -;;; GAME CLASSES - -(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))) - -(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.")) - -(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.")) - -(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/pages/adventure-awaits.lisp b/src/pages/adventure-awaits.lisp deleted file mode 100644 index 8255d2e..0000000 --- a/src/pages/adventure-awaits.lisp +++ /dev/null @@ -1,36 +0,0 @@ -;;;; adventure-awaits.lisp -- page make to make a new adventure - -(in-package :dnd) - -(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!"))))) diff --git a/src/pages/adventure-page.lisp b/src/pages/adventure-page.lisp deleted file mode 100644 index 96264e3..0000000 --- a/src/pages/adventure-page.lisp +++ /dev/null @@ -1,24 +0,0 @@ -;;;; adventure-page.lisp -- shows a particular adventure - -(in-package :dnd) - -(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"))))) diff --git a/src/pages/doorkeeper.lisp b/src/pages/doorkeeper.lisp deleted file mode 100644 index 15774fb..0000000 --- a/src/pages/doorkeeper.lisp +++ /dev/null @@ -1,19 +0,0 @@ -;;;; pages/doorkeeper.lisp -- announce yourself and enter the hero's tavern - -(in-package :dnd) - -;;; DOORKEEPER CLASS -(defclass/std doorkeeper () - ((message))) - -;; the t specialization works for all render targets -(defrender t ((page doorkeeper)) - (with-page (:title "Tavern Door") - (:h1 (message page)) - (:form :method "POST" :action "/tavern-door" - (:label :for "NICKNAME" "Wut's yer handle?:") - (:input :name "NICKNAME") (:br) - (:button :type "submit" "Announce Thyself")) - (:h2 "Eh? Ye need to register for admission?") - (:a :href "/join" "Follow me..."))) - diff --git a/src/pages/goddess-shrine.lisp b/src/pages/goddess-shrine.lisp deleted file mode 100644 index 33e8011..0000000 --- a/src/pages/goddess-shrine.lisp +++ /dev/null @@ -1,13 +0,0 @@ -;;;; pages/goddess-shrine.lisp - -(in-package :dnd) - -(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")))) - diff --git a/src/pages/hero-page.lisp b/src/pages/hero-page.lisp deleted file mode 100644 index f413d9f..0000000 --- a/src/pages/hero-page.lisp +++ /dev/null @@ -1,12 +0,0 @@ -;;;; hero-apge.lisp -- shows a particular hero - -(in-package :dnd) - -(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....."))) diff --git a/src/pages/join.lisp b/src/pages/join.lisp deleted file mode 100644 index f1ebeff..0000000 --- a/src/pages/join.lisp +++ /dev/null @@ -1,13 +0,0 @@ -;;;; pages/join-gaming-group.lisp - -(in-package :dnd) - -(defrender t ((page (eql :join))) - (with-page (:title "Register Player") - (:header - (:h1 "Choose a Player Nickname")) - (:form :method "POST" :action "/join" - (:label :for "NICKNAME" "Choose a nickname using only letters, numbers, and -._ (no spaces)") (:br) - (:input :name "NICKNAME" :placeholder "superbob") - (:button :type "submit" "Register")))) - diff --git a/src/pages/quest-page.lisp b/src/pages/quest-page.lisp deleted file mode 100644 index 9c02d51..0000000 --- a/src/pages/quest-page.lisp +++ /dev/null @@ -1,11 +0,0 @@ -;;;; quest-page.lisp - -(in-package :dnd) - -(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/pages/spymaster.lisp b/src/pages/spymaster.lisp index 01deef2..0068862 100644 --- a/src/pages/spymaster.lisp +++ b/src/pages/spymaster.lisp @@ -2,21 +2,3 @@ (in-package :dnd) -(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!")))) diff --git a/src/pages/tavern.lisp b/src/pages/tavern.lisp deleted file mode 100644 index 2fb7498..0000000 --- a/src/pages/tavern.lisp +++ /dev/null @@ -1,30 +0,0 @@ -;;;; 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)))) diff --git a/src/player.lisp b/src/player.lisp new file mode 100644 index 0000000..db78e57 --- /dev/null +++ b/src/player.lisp @@ -0,0 +1,160 @@ +;;;; player.lisp + +(in-package :dnd) + +;;; MODEL CLASSES + +(defclass player (db:store-object has-uid) + ((nick + :reader nickname + :initarg :nickname + :initform (error "Players must have a nick") + :type string + :index-type idx:string-unique-index + :index-reader player-with-nick) + (pwhash + :accessor pwhash + :type string + :initarg :pwhash + :documentation "A hash of the password, hashed with the value of the pwsalt slot.") + (pwsalt + :reader pwsalt + :initform (nuid) + :type string + :documentation "Salt for this hero's password hash.")) + (:metaclass db:persistent-class)) + +(defclass session (db:store-object) + ((player :reader session-player + :initarg :player) + (id :reader session-id + :initform (nuid) + :index-type idx:string-unique-index + :index-reader session-with-id)) + (:metaclass db:persistent-class)) + +;;; HELPERS + +;;; QUERIES + +(defun all-players () + (db:store-objects-with-class 'player)) + +(defun all-other-players (player) + (remove-if (lambda (p) (eq player p)) (all-players))) + +;;; TRANSACTIONS + +(defun new-sesh (player) + (db:with-transaction () (make-instance 'session :player player))) + +(defun destroy-sesh (session) + (db:with-transaction () + (db:delete-object session))) + +(defun register-player (nick) + (db:with-transaction () + (make-instance 'player :nickname nick))) + + + +;;; MODEL VIEWS + +(defrender :details ((player player)) + (with-html + (:div :class "player details" + (:h3 "Welcome " (nickname player))))) + +(defrender :option ((player player)) + (with-html + (:option :value (uid player) (nickname player)))) + + +(defrender :checkbox ((player player)) + (with-html + (:input :type "checkbox" :id (uid player) :name "POSSIBLE-SEER" :value (uid player)) + (:label :for (uid player) (nickname player)))) + +(defrender :list-item ((player player)) + (with-html + (nickname player))) + +;;; PAGES & PAGE CLASSES + +(defclass/std doorkeeper () + ((message))) + +;; the t specialization works for all render targets +(defrender t ((page doorkeeper)) + (with-page (:title "Tavern Door") + (:h1 (message page)) + (:form :method "POST" :action "/tavern-door" + (:label :for "NICKNAME" "Wut's yer handle?:") + (:input :name "NICKNAME") (:br) + (:button :type "submit" "Announce Thyself")) + (:h2 "Eh? Ye need to register for admission?") + (:a :href "/join" "Follow me..."))) + + +(defrender t ((page (eql :join))) + (with-page (:title "Register Player") + (:header + (:h1 "Choose a Player Nickname")) + (:form :method "POST" :action "/join" + (:label :for "NICKNAME" + "Choose a nickname using only letters, numbers, and -._ (no spaces)") (:br) + (:input :name "NICKNAME" :placeholder "superbob") + (:button :type "submit" "Register")))) + + +;;; ENDPOINT HELPERS + +(defmacro with-session ((player &key session (redirect "/tavern-door")) &body body) + (let ((session (or session (gensym "SESSION")))) + `(a:if-let (,session (current-session)) + (let ((,player (session-player ,session))) + (declare (ignorable ,player)) + ,@body) + (redirect-to ,redirect)))) + +(defun a-valid-nick (name) + "Errors with 400 if the name is not a valid hero name." + (unless (valid-nick-p name) + (lzb:http-err 400 (format nil "Player Nick Invalid"))) + name) + + +;;; ENDPOINT DEFINITIONS + +(defendpoint* :get "/" () () + (redirect-to "/tavern")) + +(defendpoint* :get "/tavern-door" () () + "Tavern door is where the player logs into the system." + (let ((doorkeeper + (make-instance 'doorkeeper :message (or (flashed-value :tavern-door) "")))) + (render (page-render-mode) + doorkeeper))) + +(defendpoint* :post "/tavern-door" () () + (with-plist ((nick :nickname)) (lzb:request-body) + (a:if-let ((player + (player-with-nick (string-trim " " nick)))) + (a:when-let ((sesh + (new-sesh player))) + (lzb:set-response-cookie + +session-cookie-name+ (session-id sesh) + :path "/" :domain (host *config*)) + (redirect-to "/tavern")) + (progn + (flash :tavern-door (format nil "Hrmm... ~a you say? It ain't on the register." nick)) + (redirect-to "/tavern-door"))))) + +(defendpoint* :get "/join" () () + (render (page-render-mode) :join)) + +(defendpoint* :post "/join" () () + "Registers a new player" + (with-checked-plist ((nick :nickname 'a-valid-nick)) (lzb:request-body) + (register-player nick) + (redirect-to "/tavern-door"))) diff --git a/src/queries.lisp b/src/queries.lisp index 13c1d26..5184575 100644 --- a/src/queries.lisp +++ b/src/queries.lisp @@ -2,43 +2,15 @@ (in-package :dnd) -(defun all-heroes () - (db:store-objects-with-class 'hero)) - -(defun all-players () - (db:store-objects-with-class 'player)) - -(defun all-other-players (player) - (remove-if (lambda (p) (eq player p)) (all-players))) - -(defun player-quests (player) - "Return all quests in which one of player's heroes is engaged." - (remove nil (mapcar #'quest (player-heroes player)))) - -(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 fetch-comrades (player &key (activep t)) - "Returns all the heroes in any one of the player's adventures. If -ACTIVEP, then only heroes involved in active quests are returned." - (remove-duplicates - (loop :for adventure :in (player-adventures player) - :nconc (adventure-heros adventure :activep activep)))) - -(defun all-adventures () - (db:store-objects-with-class 'adventure)) - -(defun adventures-visible-by (player) - (declare (ignore player)) - (all-adventures)) + + + + + + + + + + + diff --git a/src/transactions.lisp b/src/transactions.lisp index 3372520..94ca83a 100644 --- a/src/transactions.lisp +++ b/src/transactions.lisp @@ -2,35 +2,6 @@ (in-package :dnd) -(defun birth-from-the-goddess-loins (player name) - (db:with-transaction () - (make-instance 'hero :name name :player player))) -(defun new-sesh (player) - (db:with-transaction () (make-instance 'session :player player))) -(defun destroy-sesh (session) - (db:with-transaction () - (db:delete-object session))) -(defun register-player (nick) - (db:with-transaction () - (make-instance 'player :nickname nick))) - -(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)))) diff --git a/src/view-components.lisp b/src/view-components.lisp new file mode 100644 index 0000000..0711dda --- /dev/null +++ b/src/view-components.lisp @@ -0,0 +1,51 @@ +;;;; views-components.lisp -- reusable components + +(in-package :dnd) + +;;; LIST DATA + +(defrender :list ((data list) (class "listview") (item-class "listitem")) + "A catch all for rendering lists of renderable data items as unordered +lists. CLASS is the lass string for the containing list. ITEM-CLASS is +the class string for the contained list items." + (with-html + (:ol :class class + (dolist (item data) + (:li :class item-class (render :list-item item)))))) + +(defrender :horiz-list ((data list) (class "hlistview") (item-class "listitem")) + (with-html + (:ol :class class + (dolist (item data) + (:li :class item-class (render :list-item item)))))) + +(defrender :select ((data list) name class) + (with-html + (when data + (:select :name (or name (format nil "select-~a" (class-of (first data)))) + :class (or class (format nil "select ~a" (class-of (first data)))) + (dolist (item data) + (render :option item)))))) + +(defrender :checkboxes ((data list) id class) + (with-html + (when data + (:div :class (or class (format nil "checkboxes ~a" (class-of (first data)))) + :id (or id (format nil "checkboxes-~a" (class-of (first data)))) + (dolist (item data) + (render :checkbox item) + (:br)))))) + + +;;;; PAGE ELEMENTS + +(defun navbar () + (with-html + (:nav :class "navbar" :aria-label "Navigation" + (:div :class "logo" :aria-label "DND logo" "DND") + (:ul :class "nav-links" :aria-label "Nav links" + (:li (:a :href "/hero" :aria-label "Hero profile" "🧝")) + (:li (:a :href "/inventory" :aria-label "Inventory" "🎒")) + (:li (:a :href "/quests" :aria-label "Quests" "📜")) + (:li (:a :href "/tavern" :aria-label "Tavern" "🍺")))))) + diff --git a/src/views/adventure.lisp b/src/views/adventure.lisp deleted file mode 100644 index 85d8e3d..0000000 --- a/src/views/adventure.lisp +++ /dev/null @@ -1,14 +0,0 @@ -;;;; views/adventure.lisp -- views of for adventure instances - -(in-package :dnd) - -(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)) diff --git a/src/views/components.lisp b/src/views/components.lisp deleted file mode 100644 index bb9772d..0000000 --- a/src/views/components.lisp +++ /dev/null @@ -1,51 +0,0 @@ -;;;; views/components.lisp -- reusable components - -(in-package :dnd) - -;;; LIST DATA - -(defrender :list ((data list) (class "listview") (item-class "listitem")) - "A catch all for rendering lists of renderable data items as unordered -lists. CLASS is the lass string for the containing list. ITEM-CLASS is -the class string for the contained list items." - (with-html - (:ol :class class - (dolist (item data) - (:li :class item-class (render :list-item item)))))) - -(defrender :horiz-list ((data list) (class "hlistview") (item-class "listitem")) - (with-html - (:ol :class class - (dolist (item data) - (:li :class item-class (render :list-item item)))))) - -(defrender :select ((data list) name class) - (with-html - (when data - (:select :name (or name (format nil "select-~a" (class-of (first data)))) - :class (or class (format nil "select ~a" (class-of (first data)))) - (dolist (item data) - (render :option item)))))) - -(defrender :checkboxes ((data list) id class) - (with-html - (when data - (:div :class (or class (format nil "checkboxes ~a" (class-of (first data)))) - :id (or id (format nil "checkboxes-~a" (class-of (first data)))) - (dolist (item data) - (render :checkbox item) - (:br)))))) - - -;;;; PAGE ELEMENTS - -(defun navbar () - (with-html - (:nav :class "navbar" :aria-label "Navigation" - (:div :class "logo" :aria-label "DND logo" "DND") - (:ul :class "nav-links" :aria-label "Nav links" - (:li (:a :href "/hero" :aria-label "Hero profile" "🧝")) - (:li (:a :href "/inventory" :aria-label "Inventory" "🎒")) - (:li (:a :href "/quests" :aria-label "Quests" "📜")) - (:li (:a :href "/tavern" :aria-label "Tavern" "🍺")))))) - diff --git a/src/views/hazard.lisp b/src/views/hazard.lisp deleted file mode 100644 index a842c6f..0000000 --- a/src/views/hazard.lisp +++ /dev/null @@ -1,4 +0,0 @@ -;;;; hazard.lisp -- views of hazard insances - -(in-package :dnd) - diff --git a/src/views/hero.lisp b/src/views/hero.lisp deleted file mode 100644 index 90c2803..0000000 --- a/src/views/hero.lisp +++ /dev/null @@ -1,17 +0,0 @@ -;;;; views/hero.lisp - -(in-package :dnd) - -(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)))) diff --git a/src/views/player.lisp b/src/views/player.lisp deleted file mode 100644 index 9150626..0000000 --- a/src/views/player.lisp +++ /dev/null @@ -1,22 +0,0 @@ -;;;; views/player.lisp - -(in-package :dnd) - -(defrender :details ((player player)) - (with-html - (:div :class "player details" - (:h3 "Welcome " (nickname player))))) - -(defrender :option ((player player)) - (with-html - (:option :value (uid player) (nickname player)))) - - -(defrender :checkbox ((player player)) - (with-html - (:input :type "checkbox" :id (uid player) :name "POSSIBLE-SEER" :value (uid player)) - (:label :for (uid player) (nickname player)))) - -(defrender :list-item ((player player)) - (with-html - (nickname player))) diff --git a/src/views/quest.lisp b/src/views/quest.lisp deleted file mode 100644 index b289d76..0000000 --- a/src/views/quest.lisp +++ /dev/null @@ -1,10 +0,0 @@ -;;;; views/quest.lisp - -(in-package :dnd) - - - -(defrender :link-to ((quest quest)) - (with-html - (:a :href (urlpath quest) - (name quest)))) diff --git a/src/views/rumor.lisp b/src/views/rumor.lisp deleted file mode 100644 index 90f56ae..0000000 --- a/src/views/rumor.lisp +++ /dev/null @@ -1,4 +0,0 @@ -;;;; views/rumor.lisp - -(in-package :dnd) - -- cgit v1.2.3