summaryrefslogtreecommitdiff
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
parent56a584ab1b13ff9510dd5145a778000169901a76 (diff)
Refactor to make cooperative hacking nicer
-rw-r--r--DEV.org20
-rw-r--r--dnd.asd27
-rw-r--r--src/app.lisp81
-rw-r--r--src/endpoints.lisp227
-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.lisp (renamed from src/pages/tavern.lisp)18
-rw-r--r--src/model.lisp233
-rw-r--r--src/pages/adventure-awaits.lisp36
-rw-r--r--src/pages/adventure-page.lisp24
-rw-r--r--src/pages/doorkeeper.lisp19
-rw-r--r--src/pages/goddess-shrine.lisp13
-rw-r--r--src/pages/hero-page.lisp12
-rw-r--r--src/pages/join.lisp13
-rw-r--r--src/pages/quest-page.lisp11
-rw-r--r--src/pages/spymaster.lisp18
-rw-r--r--src/player.lisp160
-rw-r--r--src/queries.lisp50
-rw-r--r--src/transactions.lisp29
-rw-r--r--src/view-components.lisp (renamed from src/views/components.lisp)2
-rw-r--r--src/views/adventure.lisp14
-rw-r--r--src/views/hazard.lisp4
-rw-r--r--src/views/hero.lisp17
-rw-r--r--src/views/player.lisp22
-rw-r--r--src/views/quest.lisp10
-rw-r--r--src/views/rumor.lisp4
30 files changed, 806 insertions, 768 deletions
diff --git a/DEV.org b/DEV.org
index 67f59da..83015fe 100644
--- a/DEV.org
+++ b/DEV.org
@@ -7,12 +7,28 @@
- [X] Wot's Yer Name, Fella? (make the form)
- [X] handle post (set a cookie/header)
- [X] make a tavern page
+
+** TODO Add Nav
+
** TODO Make Adventures
+ - [X] create adventures
- [X] creator
- - [ ] seers
+ - [X] seers
- [X] title
- - rumors
+ - [ ] description
+ - [X] report rumors
+ - [ ] add seers
+
+
+** TODO View Adventures
+
+- [ ] See rumors
+- [ ] See Quests
+- [ ] Make Quests
+- [ ] Launch Quests
+- [ ]
+
As a player, I can "petition the Emperor" to submit a request for a adventure
against the darkness. I give this adventure a title it shall be known by.
I will become the CREATOR of the adventure, and one of its SEERS. I can
diff --git a/dnd.asd b/dnd.asd
index b2be4fc..692f4cc 100644
--- a/dnd.asd
+++ b/dnd.asd
@@ -29,32 +29,19 @@
:components
((:file "package")
(:file "utilities")
- (:file "model")
- (:file "queries")
- (:file "transactions")
(:file "flash")
- (:file "names")
(:file "render")
- (:module "views"
+ (:file "view-components")
+ (:file "app")
+ (:file "player")
+ (:module "game"
:serial t
- :components ((:file "adventure")
- (:file "components")
+ :components ((:file "abstract")
+ (:file "adventure")
(:file "hazard")
(:file "hero")
- (:file "player")
(:file "quest")
- (:file "rumor")))
- (:module "pages"
- :serial t
- :components ((:file "adventure-awaits")
- (:file "adventure-page")
- (:file "doorkeeper")
- (:file "goddess-shrine")
- (:file "hero-page")
- (:file "join")
- (:file "quest-page")
- (:file "spymaster")
(:file "tavern")))
- (:file "endpoints")
+ (:file "names")
(:file "init")
(:file "dnd")))))
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
--- /dev/null
+++ b/src/game/rumor.lisp
diff --git a/src/pages/tavern.lisp b/src/game/tavern.lisp
index 2fb7498..25d6ef0 100644
--- a/src/pages/tavern.lisp
+++ b/src/game/tavern.lisp
@@ -28,3 +28,21 @@
(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/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/views/components.lisp b/src/view-components.lisp
index bb9772d..0711dda 100644
--- a/src/views/components.lisp
+++ b/src/view-components.lisp
@@ -1,4 +1,4 @@
-;;;; views/components.lisp -- reusable components
+;;;; views-components.lisp -- reusable components
(in-package :dnd)
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/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)
-