summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/endpoints.lisp18
-rw-r--r--src/model.lisp5
-rw-r--r--src/names.lisp3
-rw-r--r--src/pages/adventure-awaits.lisp36
-rw-r--r--src/queries.lisp3
-rw-r--r--src/transactions.lisp6
-rw-r--r--src/views/components.lisp21
-rw-r--r--src/views/player.lisp10
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))))