blob: 56c57861c1a6afa3442a3ac2abd1ef3122e24718 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;;; 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
(defmethod unique-name ((hero hero))
(name hero))
;;; 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)))
(:div
(if (quest (hero page))
(:p "This hero is questing on "
(render :link-to (quest (hero page))))
(:p "this hero is free to join a quest")))))
(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))))
|
