diff options
| -rw-r--r-- | src/endpoints.lisp | 18 | ||||
| -rw-r--r-- | src/model.lisp | 5 | ||||
| -rw-r--r-- | src/names.lisp | 3 | ||||
| -rw-r--r-- | src/pages/adventure-awaits.lisp | 36 | ||||
| -rw-r--r-- | src/queries.lisp | 3 | ||||
| -rw-r--r-- | src/transactions.lisp | 6 | ||||
| -rw-r--r-- | src/views/components.lisp | 21 | ||||
| -rw-r--r-- | src/views/player.lisp | 10 |
8 files changed, 93 insertions, 9 deletions
diff --git a/src/endpoints.lisp b/src/endpoints.lisp index 5b65ff7..288f39e 100644 --- a/src/endpoints.lisp +++ b/src/endpoints.lisp @@ -133,12 +133,20 @@ functions in url parameters in endpoint definitions." (defendpoint* :get "/adventure-awaits" () () (with-session (player) (render (page-render-mode) - (make-instance 'new-adventure)))) + (make-instance 'adventure-awaits + :possible-seers (remove player (all-players)))))) (defendpoint* :post "/adventure-awaits" () () (with-session (creator) - (with-checked-plist ((title :title 'a-short-string)) (lzb:request-body) - (let ((adventure - (create-adventure creator title))) - (redirect-to (urlpath adventure)))))) + (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))))))) + diff --git a/src/model.lisp b/src/model.lisp index f64e28f..381687e 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -144,6 +144,11 @@ :initarg :title :initform (error "A adventure needs a title") :type string) + (description + :accessor description + :initarg :description + :initform "" + :type string) (rumors :accessor rumors :initform nil diff --git a/src/names.lisp b/src/names.lisp index b355405..3bc0c16 100644 --- a/src/names.lisp +++ b/src/names.lisp @@ -13,13 +13,14 @@ (defmethod unique-name ((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." +Returns /class/identifier." (format nil "/~a/~a" (urlify (class-name (class-of object))) (urlify (or (unique-name object) (uid object)))))) diff --git a/src/pages/adventure-awaits.lisp b/src/pages/adventure-awaits.lisp new file mode 100644 index 0000000..8255d2e --- /dev/null +++ b/src/pages/adventure-awaits.lisp @@ -0,0 +1,36 @@ +;;;; 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/queries.lisp b/src/queries.lisp index 9cd581c..de3f8c3 100644 --- a/src/queries.lisp +++ b/src/queries.lisp @@ -5,6 +5,9 @@ (defun all-heroes () (db:store-objects-with-class 'hero)) +(defun all-players () + (db:store-objects-with-class 'player)) + (defun player-quests (player) "Return all quests in which one of player's heroes is engaged." (remove nil (mapcar #'quest (player-heroes player)))) diff --git a/src/transactions.lisp b/src/transactions.lisp index 647452b..dff037d 100644 --- a/src/transactions.lisp +++ b/src/transactions.lisp @@ -17,6 +17,8 @@ (db:with-transaction () (make-instance 'player :nickname nick))) -(defun create-adventure (player title) +(defun create-adventure (player title &key (description "") seers) (db:with-transaction () - (make-instance 'adventure :title title :creator player))) + (make-instance 'adventure :title title :creator player + :seers seers + :description description))) diff --git a/src/views/components.lisp b/src/views/components.lisp index 95ed062..de4cc5c 100644 --- a/src/views/components.lisp +++ b/src/views/components.lisp @@ -17,7 +17,26 @@ the class string for the contained list items." (with-html (:ol :class class (dolist (item data) - (:li :calss item-class (render :list-item item)))))) + (:li :class item-class (render :list-item item)))))) + +(defrender :select ((data list) (multiple "false") name class) + (with-html + (when data + (:select :multiple multiple + :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 diff --git a/src/views/player.lisp b/src/views/player.lisp index 087848e..5a3d074 100644 --- a/src/views/player.lisp +++ b/src/views/player.lisp @@ -6,3 +6,13 @@ (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)))) |