diff options
| -rw-r--r-- | dnd.asd | 35 | ||||
| -rw-r--r-- | pages.lisp | 173 | ||||
| -rw-r--r-- | src/build.lisp (renamed from build.lisp) | 0 | ||||
| -rw-r--r-- | src/dnd.lisp (renamed from dnd.lisp) | 2 | ||||
| -rw-r--r-- | src/endpoints.lisp (renamed from endpoints.lisp) | 69 | ||||
| -rw-r--r-- | src/flash.lisp (renamed from flash.lisp) | 0 | ||||
| -rw-r--r-- | src/init.lisp (renamed from init.lisp) | 0 | ||||
| -rw-r--r-- | src/model.lisp (renamed from model.lisp) | 82 | ||||
| -rw-r--r-- | src/names.lisp | 25 | ||||
| -rw-r--r-- | src/package.lisp (renamed from package.lisp) | 0 | ||||
| -rw-r--r-- | src/pages.lisp | 17 | ||||
| -rw-r--r-- | src/pages/doorkeeper.lisp | 19 | ||||
| -rw-r--r-- | src/pages/goddess-shrine.lisp | 13 | ||||
| -rw-r--r-- | src/pages/join-gaming-group.lisp | 13 | ||||
| -rw-r--r-- | src/pages/join.lisp | 13 | ||||
| -rw-r--r-- | src/pages/tavern.lisp | 20 | ||||
| -rw-r--r-- | src/queries.lisp (renamed from queries.lisp) | 12 | ||||
| -rw-r--r-- | src/render.lisp | 23 | ||||
| -rw-r--r-- | src/transactions.lisp (renamed from transactions.lisp) | 2 | ||||
| -rw-r--r-- | src/utilities.lisp (renamed from utilities.lisp) | 4 | ||||
| -rw-r--r-- | src/views/campaign.lisp | 8 | ||||
| -rw-r--r-- | src/views/components.lisp | 33 | ||||
| -rw-r--r-- | src/views/hazard.lisp | 4 | ||||
| -rw-r--r-- | src/views/hero.lisp | 11 | ||||
| -rw-r--r-- | src/views/player.lisp | 8 | ||||
| -rw-r--r-- | src/views/quest.lisp | 4 | ||||
| -rw-r--r-- | src/views/rumor.lisp | 4 |
27 files changed, 321 insertions, 273 deletions
@@ -22,13 +22,28 @@ #:bordeaux-threads #:testiere #:defclass-std) - :components ((:file "package") - (:file "utilities") - (:file "model") - (:file "queries") - (:file "transactions") - (:file "flash") - (:file "pages") - (:file "endpoints") - (:file "init") - (:file "dnd"))) + :components ((:module "src" + :serial t + :components ((:file "package") + (:file "utilities") + (:file "model") + (:file "queries") + (:file "transactions") + (:file "flash") + (:file "names") + (:file "render") + (:module "views" + :serial t + :components ((:file "components") + (:file "hero") + (:file "player") + (:file "quest") + (:file "hazard") + (:file "campaign"))) + (:module "pages" + :serial t + :components ((:file "doorkeeper") + (:file "tavern"))) + (:FILE "endpoints") + (:file "init") + (:file "dnd"))))) diff --git a/pages.lisp b/pages.lisp deleted file mode 100644 index 378156a..0000000 --- a/pages.lisp +++ /dev/null @@ -1,173 +0,0 @@ -;;;; pages.lisp -- html generation functions for dnd - -(in-package :dnd) - -;;; RENDER PROTOCOL - -(defgeneric render (view object &key) - (:documentation "Render OBJECT as VIEW. VIEW could be anything, but it is intended to -be a keyword for usin in EQL method specializers.")) - -(defmacro defrender (view (spec &rest kwargs) &body body) - "A helper macro for defining specializations of render." - (let ((viewvar (gensym))) - `(defmethod render ((,viewvar (eql ,view)) ,spec &key ,@kwargs) - ,@body))) - -(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 (render :list-item item :class item-class)))))) - -(defrender :three-column-layout (data) - "A catch all specialization for rendering data in three columns. You -must specialize :left :milsddle :right on your desired data type." - (with-html - (:div :class "three-column-layout" - (:div :class "left-column" (render :left data)) - (:div :class "middle-column" (render :middle data)) - (:div :class "right-column" (render :right data))))) - -;;; Object-Endpoint Helpers - -(defgeneric url-path-to (obj) - (:documentation "Return a string that is the absolute url path to OBJ.")) - -(defmethod url-path-to ((obj campaign)) - (format nil "/campaign/~a" (urlify (title obj)))) - -;;; PAGES - -(defmacro with-page ((&key title) &body body) - "A helper macro fordefining some standard page boilerplate." - `(with-html-string - (:doctype) - (:html - (:head - (:title ,title)) - (:body - ,@body)))) - -(defclass/std doorkeeper () - ((message))) - -(defun doorkeeper (&key (message "Come ye player, Wot's yer name?")) - (render :page (make-instance 'doorkeeper :message message ))) - -(defrender :page ((page doorkeeper)) - (with-page (:title "Tavern Door") - (:h1 (message page)) - (:form :method "POST" :action "/tavern-door" - (:label :for "NICK" "Wut's yer handle?:") - (:input :name "NICK") - (:button :type "submit" "Announce Thyself")) - (:h2 "Eh? Ye need to announce thyeself?") - (:a :href "/register" "Follow me..."))) - -(defclass/std goddess-shrine () ()) - -(defrender :page ((page goddess-shrine)) - (with-page (:title "A Sacred Shrine") - (:header - (:h1 "Pray and become a hero...")) - (:form :method "POST" :action "/godess-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")))) - -(defclass/std player-registration () ()) - -(defrender :page ((page player-registration)) - (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 register () - (render :page (make-instance 'player-registration))) - -(defclass/std tavern () - ((player alerts))) - -(defun tavern (player) - (render :page (make-instance 'tavern :player player))) - -(defrender :page ((tavern tavern)) - (with-page (:title "A Bustling Tavern") - (render :three-column-layout tavern))) - -(defrender :text-page ((tavern tavern)) - (let ((player (player tavern))) - (with-html - (render :details player) - (render :list (player-heroes player)) - (:a :href "/spymaster" "Report a Roguish Rumour...") - ;; (:table - ;; (:tr (:td (:h4 "Your Heroes")) - ;; (:td (:h4 "Your Campaigns"))) - ;; (:tr (:td (:h4 "Gossip & Gab")) - ;; (:td (:h4 "Comrades in Arms")))) - - ))) - -(defrender :list-item ((hero hero)) - (with-html - (with-slots ((name campaign) hero) - (:p name "the" (hero-class hero) (hero-title hero) - (when campaign - (:span "who is off in the campaign") - (:span (render :inline campaign))))))) - -(defrender :inline ((campaign campaign)) - (with-html - (:a :href (url-path-to campaign) (title campaign)))) - -(defrender :left ((tavern tavern)) - (let ((player (player tavern))) - (with-html - (render :details player) - (:h4 "Your Heroes") - (render :list (player-heroes player))))) - -(defrender :middle ((tavern tavern)) - (with-html - (:h4 "Your Campaigns ") - (render :list (player-campaigns (player tavern))))) - -(defrender :right ((tavern tavern)) - (with-html - (:h4 "Gossip & Gab") - (render :list (alerts tavern)) - (:h4 "Comrades in Arms") - (render :list (fetch-comrades (player tavern))))) - -(defrender :details ((player player)) - (with-html - (:div :class "player details" - (:h3 "Welcome " (player-nick player))))) - -(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" "πΊ")))))) - -(defun hall-of-heroes () - (with-html - (:ul :class "hall-of-heroes" - (dolist (hero (all-heroes)) - (:li (hero-name hero) - "the" - (hero-class hero) - (hero-title hero)))))) diff --git a/build.lisp b/src/build.lisp index 8bb5ec5..8bb5ec5 100644 --- a/build.lisp +++ b/src/build.lisp @@ -5,7 +5,7 @@ (defvar *dnd-arena* nil "The instance of the HTTP server") -(defun conjure-arena () +(defun start () (init-db) (setf *dnd-arena* (lzb:create-server)) (lzb:install-app *dnd-arena* (lzb:app 'dnd)) diff --git a/endpoints.lisp b/src/endpoints.lisp index 96e3876..e33682b 100644 --- a/endpoints.lisp +++ b/src/endpoints.lisp @@ -9,29 +9,6 @@ (defparameter +session-cookie-name+ "dnd-session") -;;; DND ROUTE PROTOCOL - -(defgeneric unique-name (object) - (:documentation "Returns a unique name for an object, or NIL if it does not have one.") - (:method ((ob t)) nil)) - -(defmethod unique-name ((campaign campaign)) - (campaign-title campaign)) - -(defmethod unique-name ((hero hero)) - (hero-name hero)) - -(defgeneric urlpath (inflection object) - (:documentation "Return the path to the object given a particular") - (:method ((inflection t) (object has-uid)) - "If the object has a unique human readable name, urlify that name and -incorporate it into the urlpath. Otherwise use the object's uid. - -Returns /inflection/class/identifier." - (format nil "~a/~a/~a" - (urlify inflection) - (urlify (class-name (class-of object))) - (urlify (or (unique-name object) (uid object)))))) ;;; UTILITIES @@ -53,12 +30,15 @@ I.e. It should be called within the scope of a request handler." "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 (user-agent) +(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." - (cond ((text-browser-p user-agent) :text-page) - (t :page))) + (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")))) @@ -100,35 +80,36 @@ functions in url parameters in endpoint definitions." ;;; OPEN ENDPOINTS - (defendpoint* :get "/" () () (redirect-to "/tavern")) (defendpoint* :get "/tavern-door" () () "Tavern door is where the player logs into the system." - (a:if-let (name (flashed-value :tavern-door)) - (doorkeeper :message (format nil "Ne'er 'erd of ye ~a" name)) - (doorkeeper))) + (let ((doorkeeper + (make-instance 'doorkeeper :message (or (flashed-value :tavern-door) "")))) + (render (page-render-mode) + doorkeeper))) (defendpoint* :post "/tavern-door" () () - (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 + (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 "localhost") ; TODO: generalize domain (redirect-to "/tavern")) (progn (flash :tavern-door nick) (redirect-to "/tavern-door")))) ) -(defendpoint* :get "/register" () () - (register)) - - +(defendpoint* :get "/join" () () + (render (page-render-mode) :join)) -(defendpoint* :post "/register" () () +(defendpoint* :post "/join" () () "Registers a new player" - (with-checked-plist ((nick :nick 'a-valid-nick)) (lzb:request-body) + (with-checked-plist ((nick :nickname 'a-valid-nick)) (lzb:request-body) (register-player nick) (redirect-to "/tavern-door"))) @@ -136,12 +117,12 @@ functions in url parameters in endpoint definitions." (defendpoint* :get "/tavern" () () (with-session (me) - (render (page-render-mode (lzb:request-header :user-agent)) + (render (page-render-mode) (make-instance 'tavern :player me)))) (defendpoint* :get "/godess-shrine" () () (with-session (player) - (godess-shrine))) + (render (page-render-mode) :goddess-shrine))) (defendpoint* :post "/godess-shrine" () () (with-session (player) @@ -154,5 +135,5 @@ functions in url parameters in endpoint definitions." (with-checked-plist ((title :title 'a-short-string)) (lzb:request-body) (let ((campaign (create-campaign creator title))) - (redirect-to (urlpath :details campaign)))))) + (redirect-to (urlpath campaign)))))) diff --git a/flash.lisp b/src/flash.lisp index b655fa0..b655fa0 100644 --- a/flash.lisp +++ b/src/flash.lisp diff --git a/init.lisp b/src/init.lisp index 68b2a16..68b2a16 100644 --- a/init.lisp +++ b/src/init.lisp diff --git a/model.lisp b/src/model.lisp index fef01da..49cd03a 100644 --- a/model.lisp +++ b/src/model.lisp @@ -20,7 +20,8 @@ (defun renown (hero) (experience hero)) ; TODO: real implementaiton -;;; persistent mixins + +;;; PERSISTENT MIXINS (defclass has-uid () ((nuid :reader uid :initform (nuid) @@ -51,22 +52,24 @@ (defclass has-chronicle () ((chronicle :accessor chronicle :initform nil)) (:metaclass db:persistent-class) - (:documentation "A chronicle is a general purpose log of events. It stores a single slot that")) + (: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 class +;;; 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 player-nick - :initarg :nick + :reader nickname + :initarg :nickname :initform (error "Players must have a nick") :type string :index-type idx:string-unique-index @@ -83,50 +86,55 @@ :documentation "Salt for this hero's password hash.")) (:metaclass db:persistent-class)) -;; a user + +;; 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 hero-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 hero-player + :reader player :initarg :player :type player :index-type idx:hash-index :index-reader player-heroes) - (campaign - :accessor hero-campaign - :initarg :campaign + (quest + :accessor quest + :initarg :quest :initform nil - :type campaign - :documentation "A hero may be in at most one campaign at a time.")) + :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)) - -;; 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)) +(defmethod campaign ((hero hero)) + (a:when-let (quest (quest hero)) + (campaign quest))) (defclass campaign (game-object) ((creator - :reader campaign-creator + :reader creator :initarg :creator :initform (error "campaigns must have a creator") :type player :documentation "The player instance of the user who made this campaign.") (seers - :accessor campaign-seers + :accessor seers :initarg :seers :initform nil :type (or nil (cons player)) @@ -137,7 +145,7 @@ :initform (error "A campaign needs a title") :type string) (rumors - :accessor campaign-rumors + :accessor rumors :initform nil :type (or nil (cons rumor)) :documentation "Beasts, Monsters, and Hazards rumored to be lurking about.")) @@ -146,14 +154,14 @@ (defclass rumor (db:store-object) ((reporter - :reader rumor-reporter + :reader reporter :initarg :reporter :type player :documentation "The player who hast reported the vile rumor.") - (content - :accessor rumor-content - :initform (error "A rumor must have content") - :initarg :content + (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 campaign.")) (:metaclass db:persistent-class) @@ -161,7 +169,7 @@ (defclass quest (game-object) ((campaign - :reader quest-campaign + :reader campaign :initarg :campaign :initform (error "No quest can fall outside the scope of a campaign.") :type campaign @@ -169,7 +177,7 @@ :index-reader quests-in-campaign :documentation "The campaign to which this quest belongs") (name - :accessor quest-name + :accessor name :initarg :name :type string :initform (format nil "~a" (gensym "QUEST"))) @@ -179,12 +187,6 @@ :type integer :initform nil :documentation "When all hope becomes lost.") - (heroes - :accessor heroes-on-quest - :initarg :heroes - :initform nil - :type (or nil (cons hero)) - :documentation "A list of heroes in this quest. Join and flight dates are logged in the chronicle.") (inception :accessor quest-inception :initform nil @@ -220,7 +222,7 @@ (: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.")) -;; (defclass monster ()) + diff --git a/src/names.lisp b/src/names.lisp new file mode 100644 index 0000000..8cc64af --- /dev/null +++ b/src/names.lisp @@ -0,0 +1,25 @@ +;;;; names.lisp -- a protocol for getting the names of things, and +;;;; generally referring to objects with strings. + +(in-package :dnd) + +(defgeneric unique-name (object) + (:documentation "Returns a unique name for an object, or NIL if it does not have one.") + (:method ((ob t)) nil)) + +(defmethod unique-name ((campaign campaign)) + (campaign-title campaign)) + +(defmethod unique-name ((hero hero)) + (hero-name hero)) + +(defgeneric urlpath (object) + (:documentation "Return the path to the object given a particular") + (:method ((object has-uid)) + "If the object has a unique human readable name, urlify that name and +incorporate it into the urlpath. Otherwise use the object's uid. + +Returns /inflection/class/identifier." + (format nil "/~a/~a" + (urlify (class-name (class-of object))) + (urlify (or (unique-name object) (uid object)))))) diff --git a/package.lisp b/src/package.lisp index 20a16d0..20a16d0 100644 --- a/package.lisp +++ b/src/package.lisp diff --git a/src/pages.lisp b/src/pages.lisp new file mode 100644 index 0000000..e7e5673 --- /dev/null +++ b/src/pages.lisp @@ -0,0 +1,17 @@ +;;;; pages.lisp -- html generation functions for dnd + +(in-package :dnd) + + +;;; PAGES + + + + + + + + + + + diff --git a/src/pages/doorkeeper.lisp b/src/pages/doorkeeper.lisp new file mode 100644 index 0000000..560637d --- /dev/null +++ b/src/pages/doorkeeper.lisp @@ -0,0 +1,19 @@ +;;;; 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") + (:button :type "submit" "Announce Thyself")) + (:h2 "Eh? Ye need to announce thyeself?") + (:a :href "/join" "Follow me..."))) + diff --git a/src/pages/goddess-shrine.lisp b/src/pages/goddess-shrine.lisp new file mode 100644 index 0000000..3b25e5a --- /dev/null +++ b/src/pages/goddess-shrine.lisp @@ -0,0 +1,13 @@ +;;;; 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 "/godess-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/join-gaming-group.lisp b/src/pages/join-gaming-group.lisp new file mode 100644 index 0000000..e758ec7 --- /dev/null +++ b/src/pages/join-gaming-group.lisp @@ -0,0 +1,13 @@ +;;;; pages/join-gaming-group.lisp + +(in-package :dnd) + +(defrender t ((page (eql :join-gaming-group))) + (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")))) + diff --git a/src/pages/join.lisp b/src/pages/join.lisp new file mode 100644 index 0000000..b48d102 --- /dev/null +++ b/src/pages/join.lisp @@ -0,0 +1,13 @@ +;;;; pages/join-gaming-group.lisp + +(in-package :dnd) + +(defrender t ((page (eql :join))) + (with-page (:title "Register Player") + (:header + (:h1 "Choose a Nickname Player")) + (:form :method "POST" :action "/join" + (:label :for "NICKNAME" "Choose a nickname. No spaces. Letters, Numbers, and -._") + (:input :name "NICKNAME" :placeholder "superbob") + (:button :type "submit" "Register")))) + diff --git a/src/pages/tavern.lisp b/src/pages/tavern.lisp new file mode 100644 index 0000000..79b0e58 --- /dev/null +++ b/src/pages/tavern.lisp @@ -0,0 +1,20 @@ +;;;; pages/tavern.lisp -- enter the tavern + +(in-package :dnd) + +(defclass/std tavern () + ((player))) + +(defrender t ((tavern tavern)) + (let ((player (player tavern))) + (with-html + (render :details player) + (render :list (player-heroes player)) + (:a :href "/spymaster" "Report a Roguish Rumour...") + ;; (:table + ;; (:tr (:td (:h4 "Your Heroes")) + ;; (:td (:h4 "Your Campaigns"))) + ;; (:tr (:td (:h4 "Gossip & Gab")) + ;; (:td (:h4 "Comrades in Arms")))) + + ))) diff --git a/queries.lisp b/src/queries.lisp index 4538c75..c657979 100644 --- a/queries.lisp +++ b/src/queries.lisp @@ -5,9 +5,17 @@ (defun all-heroes () (db:store-objects-with-class 'hero)) +(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-campaigns (player) - "Return a list of campaigns that that player is involved in." - (remove nil (mapcar #'hero-campaign (player-heroes player)))) + "Return a list of campaigns one of the players' heroes is involved in." + (mapcar #'campaign (player-quests player) )) + +(defun campaign-heroes (campaign) + "" + ) (defun campaign-heros (campaign &key (activep t)) "All the heros actively involved in this CAMPAIGN. If ACTIVEP, then diff --git a/src/render.lisp b/src/render.lisp new file mode 100644 index 0000000..140e1ec --- /dev/null +++ b/src/render.lisp @@ -0,0 +1,23 @@ +;;;; render.lisp -- render protocol and tools + +(in-package :dnd) + +(defgeneric render (view object &key) + (:documentation "Render OBJECT as VIEW. VIEW could be anything, but it is intended to +be a keyword for usin in EQL method specializers.")) + +(defmacro defrender (view (spec &rest kwargs) &body body) + "A helper macro for defining specializations of render." + (let ((viewvar (gensym))) + `(defmethod render ((,viewvar ,(if (eq t view) t `(eql ,view))) ,spec &key ,@kwargs) + ,@body))) + +(defmacro with-page ((&key title) &body body) + "A helper macro fordefining some standard page boilerplate." + `(with-html-string + (:doctype) + (:html + (:head + (:title ,title)) + (:body + ,@body)))) diff --git a/transactions.lisp b/src/transactions.lisp index acfa8c2..ad9c9e8 100644 --- a/transactions.lisp +++ b/src/transactions.lisp @@ -15,7 +15,7 @@ (defun register-player (nick) (db:with-transaction () - (make-instance 'player :nick nick))) + (make-instance 'player :nickname nick))) (defun create-campaign (player title) (db:with-transaction () diff --git a/utilities.lisp b/src/utilities.lisp index fee21fe..1e16931 100644 --- a/utilities.lisp +++ b/src/utilities.lisp @@ -51,7 +51,7 @@ (and (characterp thing) (<= 0 (char-code thing) 127))) -(defun/t urlify (string) +(defun/t urlify (string &optional (sub #\-)) "Canonical transformation for strings that makes them appropriate for urls." :tests (equal ("THIS IS COOL") "this-is-cool") @@ -59,7 +59,7 @@ (equal ("Mc'this is ΞΊoΓΆl ") "mc-this-is-o-l") :end (str:join - #\- + sub (str:split-omit-nulls #\space (substitute-if-not diff --git a/src/views/campaign.lisp b/src/views/campaign.lisp new file mode 100644 index 0000000..5e1498a --- /dev/null +++ b/src/views/campaign.lisp @@ -0,0 +1,8 @@ +;;;; views/campaign.lisp -- views of for campaign instances + +(in-package :dnd) + + +(defrender :inline ((campaign campaign)) + (with-html + (:a :href (urlpath campaign) (title campaign)))) diff --git a/src/views/components.lisp b/src/views/components.lisp new file mode 100644 index 0000000..95ed062 --- /dev/null +++ b/src/views/components.lisp @@ -0,0 +1,33 @@ +;;;; 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 :calss item-class (render :list-item item)))))) + +;;;; 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 new file mode 100644 index 0000000..a842c6f --- /dev/null +++ b/src/views/hazard.lisp @@ -0,0 +1,4 @@ +;;;; hazard.lisp -- views of hazard insances + +(in-package :dnd) + diff --git a/src/views/hero.lisp b/src/views/hero.lisp new file mode 100644 index 0000000..7387901 --- /dev/null +++ b/src/views/hero.lisp @@ -0,0 +1,11 @@ +;;;; views/hero.lisp + +(in-package :dnd) + +(defrender :list-item ((hero hero)) + (with-html + (with-slots ((name campaign) hero) + (:p name "the" (hero-class hero) (hero-title hero) + (when campaign + (:span "who is off in the campaign") + (:span (render :inline campaign))))))) diff --git a/src/views/player.lisp b/src/views/player.lisp new file mode 100644 index 0000000..087848e --- /dev/null +++ b/src/views/player.lisp @@ -0,0 +1,8 @@ +;;;; views/player.lisp + +(in-package :dnd) + +(defrender :details ((player player)) + (with-html + (:div :class "player details" + (:h3 "Welcome " (nickname player))))) diff --git a/src/views/quest.lisp b/src/views/quest.lisp new file mode 100644 index 0000000..0312dba --- /dev/null +++ b/src/views/quest.lisp @@ -0,0 +1,4 @@ +;;;; views/quest.lisp + +(in-package :dnd) + diff --git a/src/views/rumor.lisp b/src/views/rumor.lisp new file mode 100644 index 0000000..90f56ae --- /dev/null +++ b/src/views/rumor.lisp @@ -0,0 +1,4 @@ +;;;; views/rumor.lisp + +(in-package :dnd) + |