summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dnd.asd4
-rw-r--r--endpoints.lisp38
-rw-r--r--model.lisp59
-rw-r--r--package.lisp2
-rw-r--r--pages.lisp22
-rw-r--r--queries.lisp7
-rw-r--r--transactions.lisp11
-rw-r--r--utilities.lisp12
8 files changed, 115 insertions, 40 deletions
diff --git a/dnd.asd b/dnd.asd
index a0bb68a..90dacf9 100644
--- a/dnd.asd
+++ b/dnd.asd
@@ -19,7 +19,8 @@
#:ironclad
#:jonathan
#:quri
- #:bordeaux-threads)
+ #:bordeaux-threads
+ #:testiere)
:components ((:file "package")
(:file "utilities")
(:file "init")
@@ -27,5 +28,6 @@
(:file "flash")
(:file "endpoints")
(:file "pages")
+ (:file "queries")
(:file "transactions")
(:file "dnd")))
diff --git a/endpoints.lisp b/endpoints.lisp
index 87fc51e..c9a8612 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -25,38 +25,54 @@ 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+ )))
-(defmacro with-hero-session ((hero &key session (redirect "/tavern-door")) &body body)
+(defmacro with-session ((player &key session (redirect "/game-room")) &body body)
(let ((session (or session (gensym "SESSION"))))
`(a:if-let (,session (current-session))
- (let ((,hero (session-hero ,session)))
+ (let ((,player (session-player ,session)))
,@body)
(redirect-to ,redirect))))
;;; OPEN ENDPOINTS
+
(defendpoint* :get "/" () ()
(redirect-to "/tavern-door"))
(defendpoint* :get "/tavern-door" () ()
- (a:if-let (name (flashed-value :tavern-door))
- (doorkeeper :message (format nil "M'fraid I've n'er 'eard o' ~a." name))
+ (a:if-let (name (flashed-value :game-room))
+ (doorkeeper :message (format nil "Ne'er 'erd of ye ~a" name))
(doorkeeper)))
(defendpoint* :post "/tavern-door" () ()
- (with-plist ((name :name)) (lzb:request-body)
- (a:if-let ((hero (hero-known-as name)))
- (a:when-let ((sesh (new-sesh hero)))
+ (with-plist ((nick :nick)) (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 "localhost") ; TODO: generalize domain
(redirect-to "/tavern"))
(progn
- (flash :tavern-door name)
- (redirect-to (format nil "/tavern-door"))))))
+ (flash :game-room nick)
+ (redirect-to "/tavern-door")))) )
+
+(defendpoint* :get "/register" () ()
+ (register))
+
+(defun check-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"))))
+
+(defendpoint* :post "/register" () ()
+ (with-plist ((nick :nick)) (lzb:request-body)
+ (check-valid-nick nick)
+ (register-player nick)
+ (redirect-to "/tavern-door")))
(defendpoint* :get "/godess-shrine" () ()
(godess-shrine))
+
(defendpoint* :post "/godess-shrine" () ()
(with-plist ((name :name)) (lzb:request-body)
(birth-from-the-goddess-loins name)
@@ -65,5 +81,5 @@ I.e. It should be called within the scope of a request handler."
;;; SESSION ENDPOINTS
(defendpoint* :get "/tavern" () ()
- (with-hero-session (hero)
- (tavern hero)))
+ (with-session (player)
+ (tavern player)))
diff --git a/model.lisp b/model.lisp
index 9bcaadb..e4c8943 100644
--- a/model.lisp
+++ b/model.lisp
@@ -31,7 +31,7 @@
(defclass can-equip ()
((equipment-table
:initform nil
- :type cons
+ :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+
@@ -40,6 +40,13 @@
: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))
@@ -56,19 +63,14 @@
()
(:metaclass db:persistent-class))
-;; a user
-(defclass hero (game-object can-equip)
- ((name
- :accessor hero-name
- :initarg :name
- :initform (error "Heroes must be named")
+(defclass player (db:store-object has-uid)
+ ((nick
+ :reader user-nick
+ :initarg :nick
+ :initform (error "Players must have a nick")
:type string
:index-type idx:string-unique-index
- :index-reader hero-known-as)
- (experience
- :accessor experience
- :initform 0
- :type integer)
+ :index-reader player-with-nick)
(pwhash
:accessor pwhash
:type string
@@ -81,13 +83,34 @@
:documentation "Salt for this hero's password hash."))
(:metaclass db:persistent-class))
-(defun all-heroes ()
- (db:store-objects-with-class 'hero))
+;; a user
+(defclass hero (game-object has-bag can-equip)
+ ((name
+ :accessor hero-name
+ :initarg :name
+ :initform (error "Heroes must be named")
+ :type string
+ :index-type idx:string-unique-index
+ :index-reader hero-known-as)
+ (player
+ :reader hero-player
+ :initarg :player
+ :type player
+ :index-type idx:hash-index
+ :index-reader player-heroes
+ )
+ (campaign
+ :accessor hero-campaign
+ :initarg :campaign
+ :initform nil
+ :type campaign
+ :documentation "A hero may be in at mostk one campaign at a time."))
+ (:metaclass db:persistent-class))
;; TODO expiration?
(defclass session (db:store-object)
- ((hero :reader session-hero
- :initarg :hero)
+ ((player :reader session-player
+ :initarg :player)
(id :reader session-id
:initform (nuid)
:index-type idx:string-unique-index
@@ -121,7 +144,7 @@
:reader quest-campaign
:initarg :campaign
:initform (error "No quest can fall outside the scope of a campaign.")
- :index-type idx:hash-list-index
+ :index-type idx:hash-index
:index-reader quests-in-campaign
:documentation "The campaign to which this quest belongs")
(name
@@ -148,7 +171,7 @@
(defclass hazard (game-object)
((quest
:accessor quest-of
- :index-type idx:hash-list-index
+ :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.")
(overcomep
diff --git a/package.lisp b/package.lisp
index 582e854..8cc0a0b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -8,6 +8,8 @@
(#:re #:cl-ppcre)
(#:json #:jonathan)
(#:a #:alexandria-2))
+ (:import-from #:testiere
+ #:defun/t)
(:import-from #:lazybones
#:defendpoint*)
(:import-from #:derrida
diff --git a/pages.lisp b/pages.lisp
index fb4026b..c435e8f 100644
--- a/pages.lisp
+++ b/pages.lisp
@@ -19,20 +19,28 @@
(:input :name "NAME")
(:button :type "submit" "Pray To The Goddess"))))
-(defun doorkeeper (&key (message "Wot's yer name 'ero?"))
+(defun doorkeeper (&key (message "Come ye player, Wot's yer name?"))
(with-page (:title "Tavern Door")
(:h1 message)
(:form :method "POST" :action "/tavern-door"
- (:label :for "NAME" "Thy Hero's Appelation:")
- (:input :name "NAME")
+ (:label :for "NICK" "Wut's yer handle?:")
+ (:input :name "NICK")
(:button :type "submit" "Announce Thyself"))
- (:h2 "Eh? Ye need to birth a new hero?")
- (:a :href "/godess-shrine" "Follow me...")))
+ (:h2 "Eh? Ye need to announce thyeself?")
+ (:a :href "/register" "Follow me...")))
+
+(defun register ()
+ (with-page (:title "Register Player")
+ (:header
+ (:h1 "Choose a Nickname Player"))
+ (:form :method "POST" :action "/register"
+ (:label :for "NICK" "Choose a nickname. No spaces. Letters, Numbers, and -._")
+ (:input :name "NICK" :placeholder "superbob")
+ (:button :type "submit" "Register"))))
-(defun tavern (hero)
+(defun tavern (player)
(with-page (:title "A Bustling Tavern")
(navbar)
- (:h1 "Aye! Welcome " (hero-name hero))
(:div
:class "heroes-container"
(:h2 "Heroes of rampant renown:")
diff --git a/queries.lisp b/queries.lisp
new file mode 100644
index 0000000..329ecb2
--- /dev/null
+++ b/queries.lisp
@@ -0,0 +1,7 @@
+;;;; queries.lisp -- query the database
+
+(in-package :dnd)
+
+(defun all-heroes ()
+ (db:store-objects-with-class 'hero))
+
diff --git a/transactions.lisp b/transactions.lisp
index 6a50fc1..2c65434 100644
--- a/transactions.lisp
+++ b/transactions.lisp
@@ -6,8 +6,13 @@
(db:with-transaction ()
(make-instance 'hero :name name)))
-(defun new-sesh (hero)
- (db:with-transaction () (make-instance 'session :hero hero)))
+(defun new-sesh (player)
+ (db:with-transaction () (make-instance 'session :player player)))
(defun destroy-sesh (session)
- (db:delete-object session))
+ (db:with-transaction ()
+ (db:delete-object session)))
+
+(defun register-player (nick)
+ (db:with-transaction ()
+ (make-instance 'player :nick nick)))
diff --git a/utilities.lisp b/utilities.lisp
index b6cf16a..5644f2e 100644
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -23,3 +23,15 @@
:external-format :utf-8))
:external-format :latin1))
+(defparameter +user-nick-chars+ "0123456789abcdefghijklmnopqrstuvwxyz-._")
+
+(defun/t valid-nick-p (nick)
+ :tests
+ (eql ("??????") nil)
+ (eql ("⚔") nil)
+ (eql ("cool_beans") t)
+ (eql ("COOOL_BEANS") t)
+ (eql ("COOL beans") nil)
+ :end
+ (unless (zerop (length nick))
+ (every (lambda (char) (find char +user-nick-chars+)) (string-downcase nick))))