Commit | Line | Data |
---|---|---|
46d528a4 MW |
1 | ;;; |
2 | ||
3 | (defun d (n &optional (k 1) &key (bias 0) best worst) | |
4 | (let ((rolls (sort (loop repeat k | |
5 | collect (1+ (max 0 (min (1- n) | |
6 | (+ (random n) bias))))) | |
7 | #'<))) | |
8 | (reduce #'+ (cond (best (subseq rolls (- k best))) | |
9 | (worst (subseq rolls 0 worst)) | |
10 | (t rolls))))) | |
11 | ||
12 | (defvar *dnd-alist* nil) | |
13 | ||
14 | (defun do-lookup (name default defaultp) | |
15 | (let ((item (assoc name *dnd-alist*))) | |
16 | (cond (item (cdr item)) | |
17 | (defaultp default) | |
18 | (t (error "Missing required item ~S." name))))) | |
19 | ||
20 | (defun lookup-list (name &optional (default nil defaultp)) | |
21 | (do-lookup name default defaultp)) | |
22 | ||
23 | (defun lookup (name &optional (default nil defaultp)) | |
24 | (car (do-lookup name (list default) defaultp))) | |
25 | ||
26 | (defun hp-from-hd (&optional (hd (lookup-list :hit-dice))) | |
27 | (destructuring-bind (dice &key (plus 0) (stars 0)) hd | |
28 | (declare (ignore stars)) | |
29 | (+ (cond ((zerop dice) 0) | |
30 | ((= dice 1/8) 1) | |
31 | ((= dice 1/4) (d 2)) | |
32 | ((= dice 1/2) (d 4)) | |
33 | ((and (integerp dice) (plusp dice)) (d 8 dice)) | |
34 | (t (error "Bad hit dice ~S." hd))) | |
35 | plus))) | |
36 | ||
37 | (defun hd-table-lookup (hd table) | |
38 | (flet ((hd<= (a b) | |
39 | (let ((aa (if (consp a) (car a) a)) | |
40 | (bb (if (consp b) (car b) b))) | |
41 | (or (< aa bb) | |
42 | (and (= aa bb) | |
43 | (or (consp a) | |
44 | (not (consp b)))))))) | |
45 | (loop for ((lo . hi) . rest) in table | |
46 | when (and (hd<= lo hd) | |
47 | (hd<= hd hi)) | |
48 | return rest | |
49 | finally (return nil)))) | |
50 | ||
51 | (let ((xp-table '((( 0 . (0 +)) 5 1) | |
52 | (( 1 . 1) 10 3) | |
53 | ((( 1 +) . (1 +)) 15 4) | |
54 | (( 2 . 2) 20 5) | |
55 | ((( 2 +) . (2 +)) 25 10) | |
56 | (( 3 . 3) 30 15) | |
57 | ((( 3 +) . (3 +)) 50 25) | |
58 | (( 4 . 4) 75 50) | |
59 | ((( 4 +) . (4 +)) 125 75) | |
60 | (( 5 . 5) 175 125) | |
61 | ((( 5 +) . (5 +)) 225 175) | |
62 | (( 6 . 6) 275 225) | |
63 | ((( 6 +) . (6 +)) 350 300) | |
64 | (( 7 . 7) 450 400) | |
65 | ((( 7 +) . (7 +)) 550 475) | |
66 | (( 8 . 8) 650 550) | |
67 | ((( 8 +) . (8 +)) 775 625) | |
68 | (( 9 . 9) 900 700) | |
69 | ((( 9 +) . 10) 1000 750) | |
70 | (((10 +) . 11) 1100 800) | |
71 | (((11 +) . 12) 1250 875) | |
72 | (((12 +) . 13) 1350 950) | |
73 | (((13 +) . 14) 1500 1000) | |
74 | (((14 +) . 15) 1650 1050) | |
75 | (((15 +) . 16) 1850 1100) | |
76 | (((16 +) . 17) 2000 1150) | |
77 | (((17 +) . 18) 2125 1350) | |
78 | (((18 +) . 19) 2250 1550) | |
79 | (((19 +) . 20) 2375 1800) | |
80 | (((20 +) . 21) 2500 2000)))) | |
81 | (defun xp-from-hd (&optional (hd (lookup-list :hit-dice))) | |
82 | (destructuring-bind (dice &key (plus 0) (stars 0)) hd | |
83 | (multiple-value-bind (hd-base hd-plus) | |
84 | (cond ((zerop plus) (values dice 0)) | |
85 | ((plusp plus) (values dice 1)) | |
86 | ((minusp plus) (values (1- dice) 1))) | |
87 | (let ((result (hd-table-lookup (if (zerop hd-plus) | |
88 | hd-base | |
89 | (list hd-base '+)) | |
90 | xp-table))) | |
91 | (if result | |
92 | (destructuring-bind (base bonus) result | |
93 | (+ base (* stars bonus))) | |
94 | (let ((steps (+ hd-base -21 hd-plus))) | |
95 | (+ 2500 | |
96 | (* 250 steps) | |
97 | (* (+ 2000 (* 250 steps)) stars))))))))) | |
98 | ||
99 | (let ((thac0-table '((( 0 . 1) . 19) | |
100 | ((( 1 . +) . 2) . 18) | |
101 | ((( 2 . +) . 3) . 17) | |
102 | ((( 3 . +) . 4) . 16) | |
103 | ((( 4 . +) . 5) . 15) | |
104 | ((( 5 . +) . 6) . 14) | |
105 | ((( 6 . +) . 7) . 13) | |
106 | ((( 7 . +) . 8) . 12) | |
107 | ((( 8 . +) . 9) . 11) | |
108 | ((( 9 . +) . 11) . 10) | |
109 | (((11 . +) . 13) . 9) | |
110 | (((13 . +) . 15) . 8) | |
111 | (((15 . +) . 17) . 7) | |
112 | (((17 . +) . 19) . 6) | |
113 | (((19 . +) . 21) . 5) | |
114 | (((21 . +) . 23) . 4) | |
115 | (((23 . +) . 25) . 3) | |
116 | (((25 . +) . 27) . 2) | |
117 | (((27 . +) . 29) . 1) | |
118 | (((29 . +) . 31) . 0) | |
119 | (((31 . +) . 33) . -1) | |
120 | (((33 . +) . 35) . -2)))) | |
121 | (defun thac0-from-hd (&optional (hd (lookup-list :hit-dice))) | |
122 | (destructuring-bind (dice &key (plus 0) (stars 0)) hd | |
123 | (declare (ignore stars)) | |
124 | (multiple-value-bind (hd-base hd-plus) | |
125 | (cond ((zerop plus) (values dice 0)) | |
126 | ((plusp plus) (values dice 1)) | |
127 | ((minusp plus) (values (1- dice) 1))) | |
128 | (or (hd-table-lookup (if (zerop hd-plus) | |
129 | hd-base | |
130 | (list hd-base '+)) | |
131 | thac0-table) | |
132 | -3))))) | |
133 | ||
134 | (defparameter monster-template | |
135 | `((:hit-dice :required) | |
136 | (:thac0 :list ,#'thac0-from-hd) | |
137 | (:hit-points :list ,#'hp-from-hd) | |
138 | (:experience-points :list ,#'xp-from-hd))) | |
139 | ||
140 | (defun apply-template (def tpl) | |
141 | (flet ((run (tag func) | |
142 | (unless (assoc tag *dnd-alist*) | |
143 | (push (cons tag (funcall func)) *dnd-alist*)))) | |
144 | (loop with *dnd-alist* = def | |
145 | for (tag key . tail) in tpl do | |
146 | (case key | |
147 | (:required (lookup-list tag)) | |
148 | (:eval (run tag (car tail))) | |
149 | (:list (run tag (lambda () (list (funcall (car tail)))))) | |
150 | (t (run tag key))) | |
151 | finally (return *dnd-alist*)))) | |
152 | ||
4005b342 MW |
153 | (defun percentp (pc) (< (random 100) pc)) |
154 | ||
155 | (defun bag (&rest things) | |
156 | (loop for i in things | |
157 | when i collect i)) | |
158 | ||
159 | (defun tagged-bag (tag &rest things) | |
160 | (let ((bag (apply #'bag things))) | |
161 | (and bag (cons tag bag)))) | |
162 | ||
163 | (defun choose (&rest things) | |
164 | (let ((n 0) | |
165 | (it nil)) | |
166 | (do ((things things (cddr things))) | |
167 | ((null things) it) | |
168 | (let ((k (car things))) | |
169 | (incf n k) | |
170 | (when (and (plusp n) (< (random n) k)) | |
171 | (setf it (cadr things))))))) | |
172 | ||
173 | (defun choose-uniformly (&rest things) | |
174 | (let ((n 0) (it nil)) | |
175 | (do ((things things (cdr things))) | |
176 | ((null things) it) | |
177 | (incf n) | |
178 | (when (< (random n) 1) | |
179 | (setf it (car things)))))) | |
180 | ||
ac6c07c4 | 181 | (defmacro pick (&body clauses) |
4005b342 MW |
182 | `(funcall (choose ,@(loop for (n . clause) in clauses |
183 | collect n | |
184 | collect `(lambda () ,@clause))))) | |
185 | ||
da704ab3 MW |
186 | (defmacro pick-matching ((form &key) &body clauses) |
187 | (let ((formtemp (gensym "FORM"))) | |
188 | `(let ((,formtemp ,form)) | |
189 | (pick ,@(loop for (prob assertion . code) in clauses | |
190 | collect `((if (assertion-match-p ,formtemp ',assertion) | |
191 | ,prob | |
192 | 0) | |
193 | ,@code)))))) | |
4005b342 MW |
194 | |
195 | (defconstant cleric-spells | |
196 | #((cure-light-wounds detect-evil detect-magic light protection-from-evil | |
197 | purify-food-and-water remove-fear resist-cold) | |
198 | (bless find-traps hold-person resist-fire silence-15-ft-radius | |
199 | slow-poison snake-charm speak-with-animal) | |
200 | (continual-light cure-blindness cure-disease growth-of-animals | |
201 | locate-object remove-curse speak-with-the-dead striking) | |
202 | (animate-dead create-water cure-serious-wounds dispel-magic | |
203 | neutralize-poison protection-from-evil-10-ft-radius speak-with-plants | |
204 | sticks-to-snakes) | |
205 | (commune create-food cure-critical-wounds dispel-evil insect-plague quest | |
206 | raise-dead truesight) | |
207 | (aerial-servant animate-objects barrier create-normal-animals cureall | |
208 | find-the-path speak-with-monsters word-of-recall) | |
209 | (earthquake holy-word raise-dead-fully restore survival travel wish | |
210 | wizardry))) | |
211 | ||
ac6c07c4 MW |
212 | (defconstant druid-only-spells |
213 | #((detect-danger faerie-fire locate predict-weather) | |
214 | (heat-metal obscure produce-fire warp-wood) | |
215 | (call-lightning hold-animal protection-from-poison water-breathing) | |
216 | (control-temperature-10-ft-radius plant-door protection-from-lightning | |
217 | summon-animals) | |
218 | (anti-plant-shell control-winds dissolve pass-plant) | |
219 | (anti-animal-shell summon-weather transport-through-plants turn-wood) | |
220 | (creeping-doom metal-to-wood summon-elemental weather-control))) | |
221 | ||
222 | (defconstant druid-spells | |
223 | (make-array 7 :initial-contents (loop for cs across cleric-spells | |
224 | for ds across druid-only-spells | |
225 | collect (append cs ds)))) | |
226 | ||
4005b342 MW |
227 | (defconstant magic-user-spells |
228 | #((analyse charm-person detect-magic floating-disc hold-portal light | |
229 | magic-missile protection-from-evil read-languages read-magic shield | |
230 | sleep ventriloquism) | |
231 | (continual-light detect-evil detect-invisible entangle esp invisibility | |
232 | knock levitate locate-object mirror-image phantasmal-force web | |
233 | wizard-lock) | |
234 | (clairvoyance create-air dispel-magic fire-ball fly haste hold-person | |
235 | infravision invisibility-10-ft-radius lightning-bolt | |
236 | protection-from-evil-10-ft-radius protection-from-normal-missiles | |
237 | water-breathing) | |
238 | (charm-monster clothform confusion dimension-door growth-of-plants | |
239 | hallucinatory-terrain ice-storm/wall massmorph polymorph-others | |
240 | polymorph-self remove-curse wall-of-fire wizard-eye) | |
241 | (animate-dead cloudkill conjure-elemental contact-outer-plane dissolve | |
242 | feeblemind hold-monster magic-jar pass-wall telekinesis teleport | |
243 | wall-of-stone woodform) | |
244 | (anti-magic-shell death-spell disintegrate geas invisible-stalker | |
245 | lower-water move-earth projected-image reincarnation stone-to-flesh | |
246 | stoneform wall-of-iron weather-control) | |
247 | (charm-plant create-normal-monsters delayed-blast-fire-ball ironform lore | |
248 | magic-door mass-invisibility power-word-stun reverse-gravity statue | |
249 | summon-object sword teleport-any-object) | |
250 | (clone create-magical-monsters dance explosive-cloud force-field | |
251 | mass-charm mind-barrier permanence polymorph-any-object power-word-blind | |
252 | steelform symbol travel) | |
253 | (contingency create-any-monster gate heal immunity maze meteor-swarm | |
254 | power-word-kill prismatic-wall shapechange survival timestop wish))) | |
255 | ||
ac6c07c4 MW |
256 | (defun spell-caster-type (&optional (form :any)) |
257 | (pick-matching (form) | |
258 | (5 (:user (:cleric :druid :paladin)) :cleric) | |
259 | (1 (:user :druid) :druid) | |
260 | (14 (:user (:magic-user :elf :thief)) :magic-user))) | |
4005b342 MW |
261 | |
262 | (defun random-spell (&optional (caster (spell-caster-type)) | |
263 | (level (ecase caster | |
264 | ((:magic-user) (choose 28 1 | |
265 | 21 2 | |
266 | 15 3 | |
267 | 11 4 | |
268 | 9 5 | |
269 | 7 6 | |
270 | 5 7 | |
271 | 3 8 | |
272 | 1 9)) | |
273 | ((:cleric :druid) (choose 34 1 | |
274 | 24 2 | |
275 | 18 3 | |
276 | 12 4 | |
277 | 7 5 | |
278 | 4 6 | |
279 | 1 7))))) | |
280 | (let ((list (aref (ecase caster | |
281 | ((:magic-user) magic-user-spells) | |
282 | ((:cleric) cleric-spells) | |
ac6c07c4 | 283 | ((:druid) druid-only-spells)) |
4005b342 MW |
284 | level))) |
285 | (values (elt list (random (length list))) | |
286 | caster | |
287 | level))) | |
288 | ||
ac6c07c4 MW |
289 | (let ((magic (list :magic))) |
290 | (defun assertion-match-p (form assertions) | |
291 | (cond ((eq form :any) t) | |
292 | ((eq form :none) nil) | |
293 | ((atom form) (if (atom assertions) | |
294 | (eql form assertions) | |
295 | (member form assertions))) | |
296 | (t (case (car form) | |
297 | ((and) (every (lambda (f) | |
298 | (assertion-match-p f assertions)) | |
299 | (cdr form))) | |
300 | ((or) (some (lambda (f) | |
301 | (assertion-match-p f assertions)) | |
302 | (cdr form))) | |
303 | ((not) (not (assertion-match-p (cadr form) assertions))) | |
304 | (t (let ((sub (getf assertions (car form) magic))) | |
305 | (if (eq sub magic) | |
306 | t | |
307 | (assertion-match-p (cadr form) sub))))))))) | |
4005b342 MW |
308 | |
309 | (defun choose-distinct-items (n seq) | |
310 | (let* ((copy (subseq (coerce seq 'vector) 0)) | |
311 | (len (length copy)) | |
312 | (list nil)) | |
313 | (dotimes (i n (sort list #'string<)) | |
314 | (let ((j (random len))) | |
315 | (push (aref copy j) list) | |
316 | (decf len) | |
317 | (setf (aref copy j) (aref copy len)))))) | |
318 | ||
319 | (defun magic-item (form) | |
ac6c07c4 MW |
320 | (labels ((cursedp (&optional (prob 10)) |
321 | (cond ((assertion-match-p form '(:cursed :unspecified)) | |
322 | (zerop (random prob))) | |
323 | ((assertion-match-p form '(:cursed nil)) | |
324 | nil) | |
325 | (t t))) | |
326 | (potion (&key recursivep) | |
327 | (pick-matching (form) | |
328 | (2 (:cursed nil) `(:potion agility)) | |
329 | (1 (:cursed nil) `(:potion animal-control)) | |
330 | (3 (:cursed nil) `(:potion antidote)) | |
331 | (2 (:cursed nil) `(:potion blending)) | |
332 | (2 (:cursed nil) `(:potion bug-repellent)) | |
333 | (2 (:cursed nil) `(:potion clairaudience)) | |
334 | (2 (:cursed nil) `(:potion clairvoyance)) | |
335 | (2 (:cursed nil) `(:potion climbing)) | |
336 | (2 (:cursed nil) `(:potion defence :bonus ,(choose 3 1 | |
337 | 2 2 | |
338 | 2 3 | |
339 | 2 4 | |
340 | 1 5))) | |
341 | ((if recursivep 0 4) (:cursed t) | |
342 | (setf form :any) | |
343 | `(:potion delusion | |
344 | :fakes ,@(cdr (potion :recursivep t)))) | |
345 | (2 (:cursed nil) `(:potion diminution)) | |
346 | (1 (:cursed nil) `(:potion ,(choose 35 'white-dragon-control | |
347 | 15 'crystal-dragon-control | |
348 | 35 'black-dragon-control | |
349 | 15 'onyx-dragon-control | |
350 | 28 'green-dragon-control | |
351 | 12 'jade-dragon-control | |
352 | 21 'blue-dragon-control | |
353 | 9 'sapphire-dragon-control | |
354 | 14 'red-dragon-control | |
355 | 6 'ruby-dragon-control | |
356 | 7 'gold-dragon-control | |
357 | 3 'amber-dragon-control))) | |
358 | (2 (:cursed nil) `(:potion dreamspeech)) | |
359 | (1 (:cursed nil) `(:potion elasicity)) | |
360 | (2 (:cursed nil) `(:potion ,(choose-uniformly 'air-form | |
361 | 'water-form | |
362 | 'earth-form | |
363 | 'fire-form))) | |
364 | (2 (:cursed nil) `(:potion esp)) | |
365 | (1 (:cursed nil) `(:potion ethereality)) | |
366 | (3 (:cursed nil) `(:potion fire-resistance)) | |
367 | (3 (:cursed nil) `(:potion flying)) | |
368 | (2 (:cursed nil) `(:potion fortitude)) | |
369 | (1 (:cursed nil) `(:potion freedom)) | |
370 | (3 (:cursed nil) `(:potion gaseous-form)) | |
371 | (1 (:cursed nil) `(:potion ,(choose 5 'hill-giant-control | |
372 | 5 'stone-giant-control | |
373 | 4 'frost-giant-control | |
374 | 2 'fire-giant-control | |
375 | 1 'mountain-giant-control | |
376 | 1 'sea-giant-control | |
377 | 1 'cloud-giant-control | |
378 | 1 'storm-giant-control))) | |
379 | (3 (:cursed nil) `(:potion giant-strength)) | |
380 | (2 (:cursed nil) `(:potion growth)) | |
381 | (6 (:cursed nil) `(:potion healing)) | |
382 | (3 (:cursed nil) `(:potion heroism)) | |
383 | (1 (:cursed nil) `(:potion human-control)) | |
384 | (3 (:cursed nil) `(:potion invisibility)) | |
385 | (2 (:cursed nil) `(:potion invulnerability)) | |
386 | (2 (:cursed nil) `(:potion levitation)) | |
387 | (2 (:cursed nil) `(:potion longevity)) | |
388 | (1 (:cursed nil) `(:potion luck)) | |
389 | (1 (:cursed nil) `(:potion merging)) | |
390 | (2 (:cursed nil) `(:potion plant-control)) | |
391 | (3 (:cursed t) `(:potion poison)) | |
392 | (3 (:cursed nil) `(:potion polymorph-self)) | |
393 | (2 (:cursed nil) `(:potion sight)) | |
394 | (2 (:cursed nil) `(:potion speech)) | |
395 | (4 (:cursed nil) `(:potion speed)) | |
396 | (2 (:cursed nil) `(:potion strength)) | |
397 | (3 (:cursed nil) `(:potion super-healing)) | |
398 | (3 (:cursed nil) `(:potion swimming)) | |
399 | (1 (:cursed nil) `(:potion treasure-finding)) | |
400 | (1 (:cursed nil) `(:potion undead-control)) | |
401 | (2 (:cursed nil) `(:potion water-breathing)))) | |
4005b342 | 402 | (scroll () |
ac6c07c4 MW |
403 | (pick-matching (form) |
404 | (3 (:cursed nil) `(:scroll communication)) | |
405 | (2 (:cursed nil) `(:scroll creation)) | |
406 | (8 (:cursed t) `(:scroll curse)) | |
407 | (1 (:user (:cleric :druid :magic-user :elf :thief :paladin) | |
408 | :cursed nil) | |
409 | (multiple-value-bind | |
410 | (spell caster level) | |
411 | (random-spell (spell-caster-type form)) | |
412 | (declare (ignore level)) | |
413 | `(:scroll delay :caster ,caster :spells (,spell)))) | |
414 | (3 (:cursed nil) | |
415 | `(:scroll equipment | |
416 | :items ,(choose-distinct-items 6 | |
417 | '(grappling-hook | |
418 | hammer | |
419 | iron-spikes | |
420 | lantern | |
421 | mirror | |
422 | wooden-pole | |
423 | rope | |
424 | saddle | |
425 | backpack | |
426 | saddle-bags | |
427 | stakes-and-mallet | |
428 | wolfsbane)))) | |
429 | (2 (:cursed nil) `(:scroll illumination)) | |
430 | (2 (:cursed nil :user (:magic-user :cleric :druid :elf)) | |
431 | `(:scroll mages)) | |
432 | (4 (:cursed nil) `(:map normal-treasure)) | |
433 | (3 (:cursed nil) `(:map magical-treasure)) | |
434 | (2 (:cursed nil) `(:map combined-treasure)) | |
435 | (1 (:cursed nil) `(:map special-treasure)) | |
436 | (3 (:cursed nil) `(:scroll mapping)) | |
437 | (2 (:cursed nil) `(:scroll portals)) | |
438 | (6 (:cursed nil) `(:scroll protection-from-elementals)) | |
439 | (8 (:cursed nil) `(:scroll protection-from-lycanthropes)) | |
440 | (4 (:cursed nil) `(:scroll protection-from-magic)) | |
441 | (7 (:cursed nil) `(:scroll protection-from-undead)) | |
442 | (2 (:cursed nil) `(:scroll questioning)) | |
443 | (1 (:cursed nil | |
444 | :user (:cleric :druid :magic-user :elf :thief :paladin)) | |
445 | (multiple-value-bind | |
446 | (spell caster level) | |
447 | (random-spell (spell-caster-type form)) | |
448 | `(:scroll repetition | |
449 | :caster ,caster | |
450 | :level ,level | |
451 | :spells (,spell)))) | |
452 | (2 (:cursed nil) `(:scroll seeing)) | |
453 | (2 (:cursed nil) `(:scroll shelter)) | |
454 | (3 (:cursed nil) | |
455 | `(:scroll spell-catching :max-level ,(choose 4 1 | |
456 | 3 2 | |
457 | 2 3 | |
458 | 1 8))) | |
459 | (25 (:cursed nil | |
460 | :user (:cleric :druid :magic-user :elf :thief :paladin)) | |
461 | (let ((caster (spell-caster-type form)) | |
462 | (spells (choose 50 1 33 2 17 3))) | |
463 | `(:scroll spell | |
464 | :caster ,caster | |
465 | :spells ,(loop repeat spells | |
466 | collect (random-spell caster))))) | |
467 | (2 (:cursed nil) `(:scroll trapping)) | |
468 | (2 (:cursed nil) `(:scroll truth)))) | |
4005b342 MW |
469 | (wand-charges () (d 10 3)) |
470 | (staff-charges () (d 20 2)) | |
471 | (wandlike () | |
ac6c07c4 MW |
472 | (pick-matching (form) |
473 | (5 (:user (:magic-user :elf)) | |
474 | `(:wand cold :charges ,(wand-charges))) | |
475 | (5 (:user (:magic-user :elf)) | |
476 | `(:wand enemy-detection :charges ,(wand-charges))) | |
477 | (4 (:user (:magic-user :elf)) | |
478 | `(:wand fear :charges ,(wand-charges))) | |
479 | (5 (:user (:magic-user :elf)) | |
480 | `(:wand fireballs :charges ,(wand-charges))) | |
481 | (4 (:user (:magic-user :elf)) | |
482 | `(:wand illusion :charges ,(wand-charges))) | |
483 | (5 (:user (:magic-user :elf)) | |
484 | `(:wand lightning-bolts :charges ,(wand-charges))) | |
485 | (5 (:user (:magic-user :elf)) | |
486 | `(:wand magic-detection :charges ,(wand-charges))) | |
487 | (5 (:user (:magic-user :elf)) | |
488 | `(:wand metal-detection :charges ,(wand-charges))) | |
489 | (4 (:user (:magic-user :elf)) | |
490 | `(:wand negation :charges ,(wand-charges))) | |
491 | (5 (:user (:magic-user :elf)) | |
492 | `(:wand paralysation :charges ,(wand-charges))) | |
493 | (5 (:user (:magic-user :elf)) | |
494 | `(:wand polymorphing :charges ,(wand-charges))) | |
495 | (4 (:user (:magic-user :elf)) | |
496 | `(:wand secret-door-detection :charges ,(wand-charges))) | |
497 | (4 (:user (:magic-user :elf)) | |
498 | `(:wand trap-detection :charges ,(wand-charges))) | |
499 | (1 (:user (:magic-user :elf :cleric :druid :palatin)) | |
500 | `(:staff commanding :charges nil)) | |
501 | (2 nil | |
502 | `(:staff dispelling :charges ,(staff-charges))) | |
503 | (3 (:user :druid) | |
504 | `(:staff druids :charges ,(staff-charges))) | |
505 | (3 (:user (:magic-user :elf)) | |
506 | `(:staff ,(choose 19 'air | |
507 | 19 'earth | |
508 | 19 'fire | |
509 | 19 'water | |
510 | 6 'air-and-water | |
511 | 6 'earth-and-fire | |
512 | 2 'elemental-power) | |
513 | :charges ,(staff-charges))) | |
514 | (2 (:user (:cleric :druid :paladin)) | |
515 | `(:staff harming :charges ,(staff-charges))) | |
516 | (7 (:user (:cleric :druid :paladin)) | |
517 | `(:staff healing :charges ,(staff-charges))) | |
518 | (1 (:user (:cleric :druid :magic-user :elf :paladin)) | |
519 | `(:staff power :charges ,(staff-charges))) | |
520 | (3 (:user (:cleric :druid :paladin)) | |
521 | `(:staff snake :charges ,(staff-charges))) | |
522 | (3 (:user (:cleric :druid :magic-user :elf :paladin)) | |
523 | `(:staff striking :charges ,(staff-charges))) | |
524 | (2 (:user (:cleric :druid :paladin)) | |
525 | `(:staff withering :charges ,(staff-charges))) | |
526 | (1 (:user (:magic-user :elf)) | |
527 | `(:staff wizardry :charges ,(staff-charges))) | |
528 | (2 nil `(:rod cancellation)) | |
529 | (1 nil `(:rod dominion)) | |
530 | (1 (:user (:cleric :druid :paladin)) `(:rod health)) | |
531 | (2 (:user (:dwarf :halfling :elf :fighter | |
532 | :paladin :thief :mystic)) | |
533 | `(:rod inertia)) | |
534 | (1 nil `(:rod parrying)) | |
535 | (1 nil `(:rod victory)) | |
536 | (3 (:user (:dwarf :halfling :elf :fighter | |
537 | :paladin :thief :mystic)) | |
538 | `(:rod weaponry)) | |
539 | (1 nil | |
540 | `(:rod wyrm :colour ,(choose 5 'gold | |
541 | 3 'blue | |
542 | 2 'black))))) | |
543 | (ring (&optional (recursivep nil)) | |
544 | (pick-matching (form) | |
545 | (2 (:cursed nil) `(:ring animal-control)) | |
546 | ((if recursivep 0 6) | |
547 | (:cursed t) | |
548 | (setf form :any) | |
549 | `(:ring delusion :fakes ,@(cdr (ring t)))) | |
550 | (1 (:cursed nil) `(:ring djinni-summoning)) | |
551 | (4 (:cursed nil) `(:ring ear)) | |
552 | (4 (:cursed nil) `(:ring ,(choose 19 'air-adaptation | |
553 | 19 'earth-adaptation | |
554 | 19 'fire-adaptation | |
555 | 19 'water-adaptation | |
556 | 6 'air-and-water-adaptation | |
557 | 6 'earth-and-fire-adaptation | |
558 | 2 'elemental-adaptation))) | |
559 | (6 (:cursed nil) `(:ring fire-resistance)) | |
560 | (3 (:cursed nil :user (:cleric :druid :paladin)) | |
561 | `(:ring holiness)) | |
562 | (1 (:cursed nil) `(:ring human-control)) | |
563 | (5 (:cursed nil) `(:ring invisibility)) | |
564 | (3 (:cursed nil) `(:ring life-protection :charges ,(d 6))) | |
565 | (3 (:cursed nil | |
566 | :user (:cleric :druid :magic-user :elf :paladin)) | |
567 | `(:ring memory)) | |
568 | (2 (:cursed nil) `(:ring plant-control)) | |
569 | (1 (:cursed nil) `(:ring protection :bonus 1 :radius 5)) | |
570 | (10 (:cursed nil) `(:ring protection :bonus ,(choose 4 1 | |
571 | 3 2 | |
572 | 2 3 | |
573 | 1 4))) | |
574 | (4 (:cursed nil) `(:ring quickness)) | |
575 | (1 (:cursed nil) `(:ring regeneration)) | |
576 | (3 (:cursed nil) `(:ring remedies)) | |
577 | (2 (:cursed nil) `(:ring safety :charges ,(d 4))) | |
578 | (3 (:cursed nil) `(:ring seeing)) | |
579 | (3 (:cursed t) `(:ring spell-eating)) | |
580 | (2 (:cursed nil) | |
581 | (let* ((caster (spell-caster-type)) | |
582 | (spells (loop repeat (d 6) | |
583 | collect (random-spell caster)))) | |
584 | `(:ring spell-storing | |
585 | :caster ,caster | |
586 | :spells ,(remove-duplicates (sort spells | |
587 | #'string<))))) | |
588 | (2 (:cursed nil) `(:ring spell-turning)) | |
589 | (4 (:cursed nil) `(:ring survival :charges ,(+ 100 (d 100)))) | |
590 | (2 (:cursed nil) `(:ring telekinesis)) | |
591 | (4 (:cursed nil) `(:ring truth)) | |
592 | (3 (:cursed t) `(:ring truthfulness)) | |
593 | (2 (:cursed t) `(:ring truthlessness)) | |
594 | (5 (:cursed nil) `(:ring water-walking)) | |
595 | (5 (:cursed t) `(:ring weakness)) | |
596 | (2 (:cursed nil) `(:ring wishes :charges ,(choose 4 1 | |
597 | 3 2 | |
598 | 2 3 | |
599 | 1 4))) | |
600 | (2 (:cursed nil) `(:ring x-ray-vision)))) | |
4005b342 | 601 | (misc-item () |
ac6c07c4 MW |
602 | (pick-matching (form) |
603 | (2 (:cursed nil) | |
604 | `(:amulet protection-from-crystal-balls-and-esp)) | |
605 | (2 (:cursed t) `(:bag devouring)) | |
606 | (5 (:cursed nil) `(:bag holding)) | |
607 | (3 (:cursed nil) `(:boat undersea)) | |
608 | (2 (:cursed nil) `(:boots levitation)) | |
609 | (3 (:cursed nil) `(:boots speed)) | |
610 | (2 (:cursed nil) `(:boots travelling-and-leaping)) | |
611 | (1 (:cursed nil) `(:bowl commanding-water-elementals)) | |
612 | (1 (:cursed nil) `(:brazier commanding-fire-elementals)) | |
613 | (2 (:cursed nil) `(:broom flying)) | |
614 | (1 (:cursed nil) `(:censer controlling-air-elementals)) | |
615 | (3 (:cursed nil) `(:chime time)) | |
616 | (2 (:cursed nil :user (:magic-user :elf)) | |
617 | `(:crystal-ball normal)) | |
618 | (1 (:cursed nil :user (:magic-user :elf)) | |
619 | `(:crystal-ball clairaudience)) | |
620 | (1 (:cursed nil :user (:magic-user :elf)) | |
621 | `(:crystal-ball esp)) | |
622 | (2 (:cursed nil) `(:cloak displacer)) | |
623 | (1 (:cursed nil) `(:drums panic)) | |
624 | (1 (:cursed nil) `(:bottle efreeti)) | |
625 | (3 (:cursed nil) `(:egg ,(choose-uniformly 'rock-baboon | |
626 | 'giant-bat | |
627 | 'black-bear | |
628 | 'grizzly-bear | |
629 | 'boar | |
630 | 'mountain-lion | |
631 | 'panther | |
632 | 'giant-ferret | |
633 | 'gecko | |
634 | 'draco | |
635 | 'racer-snake | |
636 | 'wolf))) | |
637 | (2 (:cursed nil) `(:boots elven)) | |
638 | (2 (:cursed nil) `(:cloak elven)) | |
639 | (1 (:cursed nil) `(:carpet flying)) | |
640 | (2 (:cursed nil) `(:gauntlets ogre-power)) | |
641 | (2 (:cursed nil) `(:girdle giant-strength)) | |
642 | (2 (:cursed t) | |
643 | `(:helm ,(choose-uniformly 'lawful-alignment | |
644 | 'neutral-alignment | |
645 | 'chaotic-alignment))) | |
646 | (2 (:cursed nil) `(:helm reading)) | |
647 | (1 (:cursed nil) `(:helm telepathy)) | |
648 | (1 (:cursed nil) `(:helm teleportation)) | |
649 | (1 (:cursed nil) `(:horn blasting)) | |
650 | (2 (:cursed t) `(:lamp hurricane)) | |
651 | (3 (:cursed nil) `(:lamp long-burning)) | |
652 | (2 (:cursed nil) `(:medallion esp-30-ft-range)) | |
653 | (1 (:cursed nil) `(:medallion esp-90-ft-range)) | |
654 | (1 (:cursed nil) `(:mirror life-trapping)) | |
655 | ; fixme include contents | |
656 | (3 (:cursed nil) `(:muzzle training)) | |
657 | (2 (:cursed nil) `(:nail finger)) | |
658 | (3 (:cursed nil) `(:nail pointing)) | |
659 | (5 nil `(:ointment ,(pick-matching (form) | |
660 | (1 (:cursed nil) 'blessing) | |
661 | (1 (:cursed nil) 'healing) | |
662 | (1 (:cursed t) 'poison) | |
663 | (1 (:cursed t) 'scarring) | |
664 | (1 (:cursed nil) 'soothing) | |
665 | (1 (:cursed t) 'tanning)))) | |
666 | (3 (:cursed nil) `(:pouch security)) | |
667 | (3 (:cursed nil :user (:cleric :druid :magic-user :elf)) | |
668 | `(:quill copying)) | |
669 | (4 (:cursed nil) `(:rope climbing)) | |
670 | (2 (:cursed nil) `(:scarab protection :charges ,(d 6 2))) | |
671 | (3 (:cursed nil :user (:cleric :druid :magic-user :elf)) | |
672 | `(:slate identification)) | |
673 | (1 (:cursed nil) `(:stone controlling-earth-elementals)) | |
674 | (2 (:cursed nil) | |
675 | `(:talisman ,(choose-uniformly 'air-travel | |
676 | 'earth-travel | |
677 | 'fire-travel | |
678 | 'water-travel | |
679 | 'elemental-travel))) | |
680 | (3 (:cursed nil) `(:wheel floating)) | |
681 | (1 (:cursed nil) `(:wheel fortune)) | |
682 | (2 (:cursed nil) `(:wheel square)))) | |
4005b342 MW |
683 | (weapon-bonus (class) |
684 | (loop for bonus from 1 | |
685 | for roll = (random 100) then (- roll item) | |
686 | for item in (ecase class | |
687 | ((a) '(40 27 17 10 6)) | |
688 | ((b) '(50 24 14 8 4)) | |
689 | ((c) '(60 21 11 6 2)) | |
690 | ((d) '(70 18 8 3 1))) | |
691 | when (< roll item) return bonus)) | |
692 | (armour-size () | |
ac6c07c4 MW |
693 | (pick-matching (form) |
694 | (68 (:user (:cleric :fighter :paladin :druid :thief)) 'human) | |
695 | (13 (:user :dwarf) 'dwarf) | |
696 | (10 (:user :elf) 'elf) | |
697 | (7 (:user :halfling) 'halfling) | |
698 | (2 (:user nil) 'giant))) | |
4005b342 MW |
699 | (armour-piece (class) |
700 | (let* ((bonus (weapon-bonus class)) | |
701 | (power (and (percentp (* 5 (1+ bonus))) | |
702 | (pick (7 `(absorption)) | |
703 | (10 `(charm)) | |
704 | (15 `(cure-wounds)) | |
705 | (10 `(electricity)) | |
706 | (5 `(energy-drain)) | |
707 | (3 `(ethereality)) | |
708 | (10 `(fly)) | |
709 | (6 `(gaseous-form)) | |
710 | (9 `(haste)) | |
711 | (10 `(invisibility)) | |
712 | (8 `(reflection)) | |
713 | (7 `(remove-curse :charges ,(d 3)))))) | |
714 | (cursedp (if (and power (eq (car power) 'remove-curse)) | |
715 | nil | |
ac6c07c4 | 716 | (cursedp 8)))) |
4005b342 MW |
717 | `(:bonus ,bonus |
718 | ,@(and power (cons :power power)) | |
719 | :size ,(armour-size) | |
720 | ,@(and cursedp `(:cursed t))))) | |
721 | (armour () | |
ac6c07c4 MW |
722 | (pick-matching (form) |
723 | (10 (:user (:cleric :fighter :paladin :druid :thief | |
724 | :dwarf :elf :halfling)) | |
725 | `((:armour leather ,@(armour-piece 'd)))) | |
726 | ( 7 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
727 | `((:armour scale-mail ,@(armour-piece 'd)))) | |
728 | (13 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
729 | `((:armour chain-mail ,@(armour-piece 'c)))) | |
730 | ( 9 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
731 | `((:armour banded-mail ,@(armour-piece 'd)))) | |
732 | (11 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
733 | `((:armour plate-mail ,@(armour-piece 'b)))) | |
734 | ( 5 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
735 | `((:armour suit ,@(armour-piece 'b)))) | |
736 | (20 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
737 | `((:shield ,@(armour-piece 'a)))) | |
738 | ( 2 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
739 | `((:armour scale-mail ,@(armour-piece 'd)) | |
740 | (:shield ,@(armour-piece 'a)))) | |
741 | ( 8 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
742 | `((:armour chain-mail ,@(armour-piece 'c)) | |
743 | (:shield ,@(armour-piece 'a)))) | |
744 | ( 5 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
745 | `((:armour banded-mail ,@(armour-piece 'd)) | |
746 | (:shield ,@(armour-piece 'a)))) | |
747 | (10 (:user (:cleric :fighter :paladin :dwarf :elf :halfling)) | |
748 | `((:armour plate-mail ,@(armour-piece 'b)) | |
749 | (:shield ,@(armour-piece 'a)))))) | |
4005b342 MW |
750 | (opponent () |
751 | (choose 6 'bugs | |
752 | 3 'constructs | |
753 | 6 'dragonkind | |
754 | 9 'enchanted-monsters | |
755 | 12 'giantkind | |
756 | 12 'lycanthropes | |
757 | 4 'planar-monsters | |
758 | 6 'regenerating-monsters | |
759 | 9 'reptiles-and-dinosaurs | |
760 | 3 'spell-immune-monsters | |
761 | 6 'spellcasters | |
762 | 12 'undead | |
763 | 6 'water-breathing-monsters | |
764 | 6 'weapon-using-monsters)) | |
765 | (weapon-talent (&key missilep) | |
766 | (pick (5 `(breathing)) | |
767 | (7 `(charming)) | |
768 | (4 `(deceiving)) | |
769 | ((if missilep 0 7) `(defending)) | |
770 | (2 `(deflecting)) | |
771 | (2 `(draining :charges ,(+ 4 (d 4)))) | |
772 | (5 `(extinguishing)) | |
773 | (6 `(finding)) | |
774 | (5 `(flaming)) | |
775 | (3 `(flying)) | |
776 | (8 `(healing)) | |
777 | (5 `(hiding)) | |
778 | (6 `(holding)) | |
779 | (8 `(lightning)) | |
780 | (6 `(silencing)) | |
781 | (2 `(slicing)) | |
782 | (4 `(slowing)) | |
783 | (4 `(speeding)) | |
784 | (5 `(translating)) | |
785 | (5 `(watching)) | |
786 | (1 `(wishing :charges ,(d 3))))) | |
787 | (weapon-modifier (bonus &rest keys &key &allow-other-keys) | |
788 | (and (percentp (aref #(40 30 20 15 10) (1- bonus))) | |
789 | (pick (33 `(:extra (,(+ bonus 1) :against ,(opponent)))) | |
790 | (24 `(:extra (,(+ bonus 2) :against ,(opponent)))) | |
791 | (16 `(:extra (,(+ bonus 3) :against ,(opponent)))) | |
792 | (9 `(:extra (,(+ bonus 4) :against ,(opponent)))) | |
793 | (3 `(:extra (,(+ bonus 5) :against ,(opponent)))) | |
794 | (15 `(:talent ,@(apply #'weapon-talent keys)))))) | |
795 | (sword-modifier (bonus &rest keys &key &allow-other-keys) | |
796 | (and (percentp (aref #(40 30 25 20 15) (1- bonus))) | |
797 | (pick (29 `(:extra (,(+ bonus 1) :against ,(opponent)))) | |
798 | (21 `(:extra (,(+ bonus 2) :against ,(opponent)))) | |
799 | (14 `(:extra (,(+ bonus 3) :against ,(opponent)))) | |
800 | (8 `(:extra (,(+ bonus 4) :against ,(opponent)))) | |
801 | (3 `(:extra (,(+ bonus 5) :against ,(opponent)))) | |
802 | (25 `(:talent ,@(apply #'weapon-talent keys)))))) | |
803 | (missile () | |
804 | (multiple-value-bind | |
805 | (item class) | |
ac6c07c4 MW |
806 | (pick-matching (form) |
807 | (37 (:user (:thief :fighter :paladin :mystic | |
808 | :dwarf :elf :halfling)) | |
809 | (values :arrow 'a)) | |
810 | (22 (:user (:thief :fighter :paladin :mystic | |
811 | :dwarf :elf :halfling)) | |
812 | (values :quarrel 'a)) | |
813 | (11 (:user (:cleric :druid :thief :fighter :paladin | |
814 | :mystic :dwarf :elf :halfling)) | |
815 | (values :sling-stone 'a)) | |
816 | (2 (:user (:thief :fighter :paladin :mystic | |
817 | :dwarf :elf :halfling)) | |
818 | (values :blowgun 'd)) | |
819 | (8 (:user (:thief :fighter :paladin :mystic | |
820 | :dwarf :elf :halfling)) | |
821 | (values :long-bow 'd)) | |
822 | (5 (:user (:thief :fighter :paladin :mystic | |
823 | :dwarf :elf :halfling)) | |
824 | (values :short-bow 'd)) | |
825 | (2 (:user (:thief :fighter :paladin :mystic | |
826 | :dwarf :elf :halfling)) | |
827 | (values :heavy-crossbow 'd)) | |
828 | (5 (:user (:thief :fighter :paladin :mystic | |
829 | :dwarf :elf :halfling)) | |
830 | (values :light-crossbow 'd)) | |
831 | (8 (:user (:cleric :druid :thief :fighter :paladin | |
832 | :mystic :dwarf :elf :halfling)) | |
833 | (values :sling 'd))) | |
4005b342 MW |
834 | (ecase class |
835 | ((a) (let* ((bonus (weapon-bonus 'a)) | |
836 | (cursedp (zerop (random 10))) | |
837 | (talent (and (percentp (* 5 (- 7 bonus))) | |
da704ab3 MW |
838 | (pick (4 'biting) |
839 | (5 'blinking) | |
840 | (5 'charming) | |
841 | (7 'climbing) | |
842 | (10 'curing) | |
843 | (3 'disarming) | |
844 | (4 'dispelling) | |
845 | (7 'flying) | |
846 | (7 'lightning) | |
847 | (5 'penetrating) | |
848 | (4 'refilling) | |
849 | (6 'screaming) | |
850 | (5 'seeking) | |
851 | (4 'sinking) | |
852 | (2 `(slaying | |
853 | :opponent ,(opponent))) | |
854 | (7 'speaking) | |
855 | (4 'stunning) | |
856 | (2 'teleporting) | |
857 | (5 'transporting) | |
858 | (4 'wounding)))) | |
4005b342 MW |
859 | (number (ecase bonus |
860 | ((1) (d 10 2)) | |
861 | ((2) (d 8 2)) | |
862 | ((3) (d 6 2)) | |
863 | ((4) (d 4 2)) | |
864 | ((5) (+ (d 4) 1))))) | |
865 | `(,item :bonus ,bonus | |
866 | ,@(and talent `(:talent ,talent)) | |
867 | :number ,number | |
868 | ,@(and cursedp `(:cursed t))))) | |
869 | ((d) (let* ((bonus (weapon-bonus 'd)) | |
ac6c07c4 | 870 | (cursedp (cursedp 10)) |
4005b342 MW |
871 | (modifier (weapon-modifier bonus :missilep t)) |
872 | (range (ecase (+ bonus (d 4)) | |
873 | ((2 3 4) nil) | |
874 | ((5 6 7) 1.5) | |
875 | ((8 9) 2)))) | |
876 | `(,item :bonus ,bonus ,@modifier | |
877 | ,@(and range `(:range ,range)) | |
878 | ,@(and cursedp `(:cursed t)))))))) | |
879 | (weapon-intelligence () | |
880 | (multiple-value-bind | |
881 | (int langs prim read-magic-p extra) | |
882 | (pick (79 (values nil 0 0 nil 0)) | |
883 | (6 (values 7 0 1 nil 0)) | |
884 | (5 (values 8 0 2 nil 0)) | |
885 | (4 (values 9 0 3 nil 0)) | |
886 | (3 (values 10 (d 3) 3 nil 0)) | |
887 | (2 (values 11 (d 6) 3 t 0)) | |
888 | (1 (values 12 (d 4 2) 3 t 1))) | |
889 | (and int | |
890 | (let ((powers nil) | |
891 | (healing nil) | |
892 | (damage nil) | |
893 | (checklist nil)) | |
894 | (macrolet ((power-check (&rest forms) | |
895 | `(pick ,@(loop for (tag n . form) in forms | |
896 | if tag | |
897 | collect | |
898 | `((if (member ',tag | |
899 | checklist) | |
900 | 0 | |
901 | ,n) | |
902 | (push ',tag checklist) | |
903 | ,@(or form | |
904 | `((push ',tag | |
905 | powers)))) | |
906 | else | |
907 | collect `(,n ,@form))))) | |
908 | (labels ((primary-power () | |
909 | (power-check | |
910 | (detect-evil 10) | |
911 | (detect-gems 5) | |
912 | (detect-magic 10) | |
913 | (detect-metal 10) | |
914 | (detect-shifting-walls-and-rooms 15) | |
915 | (detect-sloping-passages 15) | |
916 | (find-secret-doors 10) | |
917 | (find-traps 10) | |
918 | (see-invisible 10) | |
919 | (:one-extra 4 | |
920 | (extraordinary-power)) | |
921 | (:two-primary 1 | |
922 | (primary-power) | |
923 | (primary-power)))) | |
924 | (extraordinary-power () | |
925 | (power-check | |
926 | (clairaudience 10) | |
927 | (clairvoyance 10) | |
928 | (esp 10) | |
929 | (nil 5 | |
930 | (setf damage (if damage | |
931 | (1+ damage) | |
932 | 5))) | |
933 | (flying 5) | |
934 | (nil 5 | |
935 | (setf healing (+ (or healing 0) 6))) | |
936 | (illusion 9) | |
937 | (levitation 5) | |
938 | (telekinesis 10) | |
939 | (telepathy 10) | |
940 | (teleportation 9) | |
941 | (x-ray-vision 9) | |
942 | (:two-three-extra 2 | |
943 | (extraordinary-power) | |
944 | (extraordinary-power)) | |
945 | (:two-three-extra 1 | |
946 | (extraordinary-power) | |
947 | (extraordinary-power) | |
948 | (extraordinary-power))))) | |
949 | (dotimes (i prim) (primary-power)) | |
950 | (dotimes (i extra) (extraordinary-power)))) | |
951 | (when damage | |
952 | (push `(extra-damage ,damage) powers)) | |
953 | (when healing | |
954 | (push `(healing ,healing) powers)) | |
955 | `(:intelligence ,int | |
956 | :ego ,(d 12) | |
957 | :languages ,langs | |
958 | ,@(and read-magic-p `(:read-magic t)) | |
959 | :powers ,powers))))) | |
960 | (sword () | |
961 | (multiple-value-bind | |
962 | (type class) | |
ac6c07c4 MW |
963 | (pick-matching (form) |
964 | (65 nil (values :normal-sword 'c)) | |
965 | (19 nil (values :short-sword 'c)) | |
966 | (8 (:user (:fighter :paladin :dwarf :mystic :elf)) | |
967 | (values :two-handed-sword 'd)) | |
968 | (8 (:user (:fighter :paladin :dwarf | |
969 | :mystic :elf :halfling)) | |
970 | (values :bastard-sword 'd))) | |
4005b342 MW |
971 | (let* ((bonus (weapon-bonus class)) |
972 | (cursedp (zerop (random 10))) | |
973 | (modifier (sword-modifier bonus)) | |
974 | (intel (weapon-intelligence))) | |
975 | `(,type :bonus ,bonus | |
976 | ,@modifier | |
977 | ,@intel | |
978 | ,@(and cursedp `(:cursed t)))))) | |
979 | (weapon () | |
980 | (multiple-value-bind | |
ac6c07c4 MW |
981 | (type returnsp intelpc class) |
982 | (pick-matching (form) | |
983 | (7 (:user (:fighter :paladin :mystic :dwarf :elf)) | |
984 | (values :battle-axe nil 30 'd)) | |
985 | (8 (:user (:fighter :paladin :mystic :dwarf :thief | |
986 | :elf :halfling)) | |
987 | (values :hand-axe (choose 3 nil 1 t) nil 'b)) | |
988 | (3 (:user (:fighter :paladin :mystic :dwarf :cleric | |
989 | :elf :halfling)) | |
990 | (values :blackjack nil nil 'c)) | |
991 | (3 (:user (:fighter :paladin :mystic :dwarf :cleric | |
992 | :thief :elf :halfling)) | |
993 | (values :bola (choose 2 nil 1 t) nil 'b)) | |
994 | (5 (:user (:fighter :paladin :mystic :dwarf | |
995 | :thief :cleric :druid :elf :halfling)) | |
996 | (values :club nil nil 'c)) | |
997 | (14 (:user (:fighter :paladin :mystic :dwarf :magic-user | |
998 | :thief :elf :halfling)) | |
999 | (values :dagger (choose 11 nil 3 t) 50 'b)) | |
1000 | (4 (:user (:fighter :paladin :mystic :dwarf :cleric | |
1001 | :elf :halfling :thief)) | |
1002 | (values :one-handed-flail nil nil 'c)) | |
1003 | (2 (:user (:fighter :paladin :mystic :dwarf :cleric :elf)) | |
1004 | (values :two-handed-flail nil nil 'd)) | |
1005 | (3 (:user (:fighter :paladin :mystic :dwarf :elf)) | |
1006 | (values :halberd nil 20 'd)) | |
1007 | (8 (:user (:fighter :paladin :mystic :dwarf :cleric | |
1008 | :druid :elf :halfling :thief)) | |
1009 | (values :war-hammer nil 30 'c)) | |
1010 | (4 (:user (:fighter :paladin :mystic :dwarf :thief | |
1011 | :elf :halfling)) | |
1012 | (values :javelin (choose 3 nil 1 t) nil 'b)) | |
1013 | (4 (:user (:fighter :paladin :mystic :dwarf :elf)) | |
1014 | (values :lance nil nil 'd)) | |
1015 | (7 (:user (:fighter :paladin :mystic :dwarf :cleric :thief | |
1016 | :elf :halfling :druid)) | |
1017 | (values :mace nil 35 'c)) | |
1018 | (5 (:user (:fighter :paladin :mystic :dwarf :cleric :thief | |
1019 | :elf :halfling)) | |
1020 | (values :morning-star nil nil 'c)) | |
1021 | (3 (:user (:fighter :paladin :mystic :dwarf :cleric :thief | |
1022 | :druid :elf :halfling)) | |
1023 | (values :net (choose 2 nil 1 t) nil 'b)) | |
1024 | (3 (:user (:fighter :paladin :mystic :dwarf :elf)) | |
1025 | (values :pike nil 20 'd)) | |
1026 | (2 (:user (:fighter :paladin :mystic :dwarf :elf)) | |
1027 | (values :pole-axe nil 20 'd)) | |
1028 | (12 (:user (:fighter :paladin :mystic :dwarf :thief | |
1029 | :elf :halfling)) | |
1030 | (values :spear (choose 3 nil 1 t) nil 'b)) | |
1031 | (4 (:user (:fighter :paladin :mystic :dwarf :thief :cleric | |
1032 | :druid :elf :halfling :magic-user)) | |
1033 | (values :staff nil 20 'd)) | |
1034 | (3 (:user (:fighter :paladin :mystic :dwarf :thief :cleric | |
1035 | :druid :elf :halfling)) | |
1036 | (values :whip nil nil 'c))) | |
4005b342 | 1037 | (let* ((bonus (weapon-bonus class)) |
ac6c07c4 | 1038 | (cursedp (cursedp 10)) |
4005b342 | 1039 | (modifier (sword-modifier bonus)) |
ac6c07c4 MW |
1040 | (intel (and intelpc |
1041 | (percentp intelpc) | |
4005b342 MW |
1042 | (weapon-intelligence)))) |
1043 | `(,type | |
1044 | ,@(and returnsp `(:returning t)) | |
1045 | :bonus ,bonus | |
1046 | ,@modifier | |
1047 | ,@intel | |
1048 | ,@(and cursedp `(:cursed t))))))) | |
ac6c07c4 MW |
1049 | (pick-matching (form) |
1050 | (25 (:type :potion) (list (potion))) | |
1051 | (12 (:type :scroll) (list (scroll))) | |
1052 | (9 (:type :wandlike :cursed nil) (list (wandlike))) | |
1053 | (6 (:type :ring) (list (ring))) | |
1054 | (10 (:type :misc) (list (misc-item))) | |
1055 | (10 (:type :armour | |
1056 | :user (:cleric :druid :fighter :paladin | |
1057 | :thief :dwarf :elf :halfling)) | |
1058 | (armour)) | |
1059 | (11 (:type :missile) (list (missile))) | |
1060 | (9 (:type :sword | |
1061 | :user (:fighter :paladin :mystic :thief :dwarf :elf :halfling)) | |
1062 | (list (sword))) | |
1063 | (8 (:type :weapon) (list (weapon)))))) | |
4005b342 MW |
1064 | |
1065 | (defun treasure-type (type-code) | |
1066 | (labels ((common-fur-type () | |
1067 | (choose-uniformly 'beaver | |
1068 | 'fox | |
1069 | 'marten | |
1070 | 'seal)) | |
1071 | (rare-fur-type () | |
1072 | (choose-uniformly 'ermine | |
1073 | 'mink | |
1074 | 'sable)) | |
1075 | (special (n) | |
ac6c07c4 | 1076 | (cons |
4005b342 MW |
1077 | :special |
1078 | (loop repeat n | |
1079 | collect | |
1080 | (pick (10 `(:kind book | |
1081 | :value ,(* 10 (d 100)) | |
1082 | :encumbrance ,(d 100))) | |
1083 | (2 `(:kind pelt | |
1084 | :animal ,(common-fur-type) | |
1085 | :value ,(d 4) | |
1086 | :encumbrance ,(* 10 (d 6)))) | |
1087 | (5 `(:kind cape | |
1088 | :animal ,(common-fur-type) | |
1089 | :value ,(* 100 (d 6)) | |
1090 | :encumbrance ,(* 10 (+ 4 (d 8))))) | |
1091 | (3 `(:kind coat | |
1092 | :animal ,(common-fur-type) | |
1093 | :value ,(* 100 (d 4 3)) | |
1094 | :encumbrance ,(* 10 (+ 8 (d 6 2))))) | |
1095 | (2 `(:kind pelt | |
1096 | :animal ,(rare-fur-type) | |
1097 | :value ,(d 6 2) | |
1098 | :encumbrance ,(* 10 (d 6)))) | |
1099 | (5 `(:kind cape | |
1100 | :animal ,(rare-fur-type) | |
1101 | :value ,(* 100 (d 6 4)) | |
1102 | :encumbrance ,(* 10 (+ 4 (d 8))))) | |
1103 | (3 `(:kind coat | |
1104 | :animal ,(rare-fur-type) | |
1105 | :value ,(* 1000 (d 4)) | |
1106 | :encumbrance ,(* 10 (+ 8 (d 6 2))))) | |
1107 | (5 `(:kind incense | |
1108 | :value ,(d 6 5) | |
1109 | :encumbrance 1 | |
1110 | :quantity ,(d 4 2))) | |
1111 | (5 `(:kind perfume | |
1112 | :value ,(* 10 (+ 5 (d 10))) | |
1113 | :encumbrance 1 | |
1114 | :quantity ,(d 3 2))) | |
1115 | (5 (let ((w (d 6)) (h (d 2))) | |
1116 | `(:kind ,(choose-uniformly 'rug | |
1117 | 'tapestry) | |
1118 | :value ,(* w h (d 10 2)) | |
1119 | :encumbrance ,(* 100 w h (d 6)) | |
1120 | :size (* ,w ,h)))) | |
1121 | (10 (let ((w (d 8)) (h (d 2))) | |
1122 | `(:kind silk | |
1123 | :value ,(* w h (d 8)) | |
1124 | :encumbrance ,(* 10 w h (d 6)) | |
1125 | :size (* ,w ,h)))) | |
1126 | (10 `(:kind animal-skin | |
1127 | :value ,(d 10) | |
1128 | :encumbrance ,(* 10 (d 4 5)))) | |
1129 | (10 `(:kind monster-skin | |
1130 | :value ,(* 100 (d 10)) | |
1131 | :encumbrance ,(* 50 (d 100)))) | |
1132 | (5 (let ((enc (d 100))) | |
1133 | `(:kind spice | |
1134 | :value ,(* enc (d 4 4)) | |
1135 | :encumbrance ,enc))) | |
1136 | (5 `(:kind statuette | |
1137 | :value ,(* 100 (d 10)) | |
1138 | :encumbrance ,(d 100))) | |
1139 | (5 `(:wine | |
1140 | :value ,(d 6) | |
1141 | :encumbrance ,(* 10 (+ 3 (d 6))) | |
1142 | :bottles ,(d 12))))))) | |
1143 | (gem-type (&key (min-value 0) recursivep) | |
1144 | (pick ((if (<= min-value 10) 3 0) | |
1145 | (values 10 (choose-uniformly 'agate | |
1146 | 'quartz | |
1147 | 'turquoise))) | |
1148 | ((if (<= min-value 50) 7 0) | |
1149 | (values 50 (choose-uniformly 'crystal | |
1150 | 'jasper | |
1151 | 'onyx))) | |
1152 | ((if (<= min-value 100) 15 0) | |
1153 | (values 100 (choose-uniformly 'amber | |
1154 | 'amethyst | |
1155 | 'coral | |
1156 | 'garnet | |
1157 | 'jade))) | |
1158 | ((if (<= min-value 500) 21 0) | |
1159 | (values 500 (choose-uniformly 'aquamarine | |
1160 | 'pearl | |
1161 | 'topaz))) | |
1162 | ((if (<= min-value 1000) 25 0) | |
1163 | (values 1000 (choose-uniformly 'carbuncle | |
1164 | 'opal))) | |
1165 | ((if (<= min-value 5000) 19 0) | |
1166 | (values 5000 (choose-uniformly 'emerald | |
1167 | 'ruby | |
1168 | 'sapphire))) | |
1169 | ((if (<= min-value 10000) 7 0) | |
1170 | (values 10000 'diamond 'jacinth)) | |
1171 | ((if (<= min-value 1000) 1 0) | |
1172 | (values (* 1000 (d 100)) | |
1173 | 'tristal)) | |
1174 | ((if (and (not recursivep) | |
1175 | (<= min-value 2000)) 2 0) | |
1176 | (multiple-value-bind | |
1177 | (value kind) | |
1178 | (gem-type :min-value (max 1000 | |
1179 | (ceiling min-value 2)) | |
1180 | :recursivep t) | |
1181 | (values (* 2 value) | |
1182 | (intern (format nil "STAR-~A" | |
1183 | (string kind)))))))) | |
1184 | (gems (n) | |
ac6c07c4 | 1185 | (cons |
4005b342 MW |
1186 | :gems |
1187 | (loop while (plusp n) | |
1188 | for i = (min n (d 5)) | |
1189 | do (decf n i) | |
1190 | collect | |
1191 | (let ((mods (choose 4 :size 4 :qual 2 :both)) | |
1192 | (mod-list nil)) | |
1193 | (multiple-value-bind | |
1194 | (value kind) | |
1195 | (gem-type) | |
1196 | (when (or (eq mods :size) | |
1197 | (eq mods :both)) | |
1198 | (multiple-value-bind | |
1199 | (mod mult) | |
1200 | (pick (1 (values 'very-small 1/8)) | |
1201 | (2 (values 'small 1/4)) | |
1202 | (2 (values 'fairly-small 1/2)) | |
1203 | (2 (values 'fairly-large 2)) | |
1204 | (2 (values 'large 4)) | |
1205 | (1 (values 'very-small 8))) | |
1206 | (setf mod-list | |
1207 | (append `(:size ,mod) mod-list)) | |
1208 | (setf value (* value mult)))) | |
1209 | (when (or (eq mods :qual) | |
1210 | (eq mods :both)) | |
1211 | (multiple-value-bind | |
1212 | (mod mult) | |
1213 | (pick (1 (values 'very-poor 1/8)) | |
1214 | (2 (values 'poor 1/4)) | |
1215 | (2 (values 'fairly-poor 1/2)) | |
1216 | (2 (values 'fairly-good 2)) | |
1217 | (2 (values 'good 4)) | |
1218 | (1 (values 'very-good 8))) | |
1219 | (setf mod-list | |
ac6c07c4 | 1220 | (append `(:quality ,mod) mod-list)) |
4005b342 MW |
1221 | (setf value (* value mult)))) |
1222 | `(:kind ,kind | |
1223 | :value ,(max 1 (round value)) | |
1224 | ,@mod-list | |
1225 | ,@(and (> i 1) `(:quantity ,i)))))))) | |
1226 | (jewellery (n) | |
ac6c07c4 | 1227 | (cons |
4005b342 MW |
1228 | :jewellery |
1229 | (loop while (plusp n) | |
1230 | for i = (min n (d 5)) | |
1231 | do (decf n i) | |
1232 | collect | |
1233 | (multiple-value-bind | |
1234 | (value enc class) | |
1235 | (pick ( 1 (values 100 10 'a)) | |
1236 | ( 2 (values 500 10 'a)) | |
1237 | ( 3 (values 1000 10 'a)) | |
1238 | ( 4 (values 1500 10 'a)) | |
1239 | ( 5 (values 2000 10 'a)) | |
1240 | ( 8 (values 2500 10 'a)) | |
1241 | (10 (values 3000 25 'a)) | |
1242 | (11 (values 4000 25 'b)) | |
1243 | (13 (values 5000 25 'b)) | |
1244 | (11 (values 7500 25 'b)) | |
1245 | ( 9 (values 10000 25 'b)) | |
1246 | ( 7 (values 15000 25 'c)) | |
1247 | ( 5 (values 20000 50 'c)) | |
1248 | ( 4 (values 25000 50 'c)) | |
1249 | ( 3 (values 30000 50 'c)) | |
1250 | ( 2 (values 40000 50 'c)) | |
1251 | ( 1 (values 50000 50 'c))) | |
1252 | (let ((kind (ecase class | |
1253 | ((a) (choose-uniformly 'anklet | |
1254 | 'beads | |
1255 | 'bracelet | |
1256 | 'brooch | |
1257 | 'buckle | |
1258 | 'cameo | |
1259 | 'chain | |
1260 | 'clasp | |
1261 | 'locket | |
1262 | 'pin)) | |
1263 | ((b) (choose-uniformly 'armband | |
1264 | 'belt | |
1265 | 'collar | |
1266 | 'earring | |
1267 | 'four-leaf-clover | |
1268 | 'heart | |
1269 | 'leaf | |
1270 | 'necklace | |
1271 | 'pendant | |
1272 | 'rabbit-foot)) | |
1273 | ((c) (choose-uniformly 'amulet | |
1274 | 'crown | |
1275 | 'diadem | |
1276 | 'medallion | |
1277 | 'orb | |
1278 | 'ring | |
1279 | 'scarab | |
1280 | 'sceptre | |
1281 | 'talisman | |
1282 | 'tiara))))) | |
1283 | `(:kind ,kind | |
1284 | :value ,value | |
1285 | :encumbrance ,enc | |
1286 | ,@(and (> i 1) `(:quantity ,i)))))))) | |
1287 | (magic (&rest forms) | |
ac6c07c4 MW |
1288 | (cons :magic |
1289 | (loop with list = nil | |
1290 | for (form n) on forms by #'cddr do | |
1291 | (loop repeat n do | |
1292 | (dolist (item (magic-item (list :type form))) | |
1293 | (push item list))) | |
1294 | finally (return list))))) | |
4005b342 MW |
1295 | (ecase type-code |
1296 | ||
1297 | ;; treasure in lair | |
1298 | ((a) (bag (tagged-bag :coins | |
1299 | (and (percentp 25) `(:cp ,(* 1000 (d 6)))) | |
1300 | (and (percentp 30) `(:sp ,(* 1000 (d 6)))) | |
1301 | (and (percentp 20) `(:ep ,(* 1000 (d 4)))) | |
1302 | (and (percentp 35) `(:gp ,(* 1000 (d 6 2)))) | |
1303 | (and (percentp 25) `(:pp ,(* 1000 (d 2))))) | |
1304 | (and (percentp 50) (gems (d 6 6))) | |
1305 | (and (percentp 50) (jewellery (d 6 6))) | |
1306 | (and (percentp 10) (special (d 2))) | |
ac6c07c4 | 1307 | (and (percentp 30) (magic :any 3)))) |
4005b342 MW |
1308 | ((b) (bag (tagged-bag :coins |
1309 | (and (percentp 50) `(:cp ,(* 1000 (d 8)))) | |
1310 | (and (percentp 25) `(:sp ,(* 1000 (d 6)))) | |
1311 | (and (percentp 25) `(:ep ,(* 1000 (d 4)))) | |
1312 | (and (percentp 35) `(:gp ,(* 1000 (d 3))))) | |
1313 | (and (percentp 25) (gems (d 6))) | |
1314 | (and (percentp 25) (jewellery (d 6))) | |
1315 | (and (percentp 10) | |
1316 | (magic '(or :armour :missile :sword :weapon) 1)))) | |
1317 | ((c) (bag (tagged-bag :coins | |
1318 | (and (percentp 20) `(:cp ,(* 1000 (d 12)))) | |
1319 | (and (percentp 30) `(:sp ,(* 1000 (d 4)))) | |
1320 | (and (percentp 10) `(:ep ,(* 1000 (d 4))))) | |
1321 | (and (percentp 50) (gems (d 6 6))) | |
1322 | (and (percentp 50) (jewellery (d 6 6))) | |
1323 | (and (percentp 5) (special (d 2))) | |
ac6c07c4 | 1324 | (and (percentp 10) (magic :any 2)))) |
4005b342 MW |
1325 | ((d) (bag (tagged-bag :coins |
1326 | (and (percentp 10) `(:cp ,(* 1000 (d 8)))) | |
1327 | (and (percentp 15) `(:sp ,(* 1000 (d 12)))) | |
1328 | (and (percentp 60) `(:gp ,(* 1000 (d 6))))) | |
1329 | (and (percentp 30) (gems (d 8))) | |
1330 | (and (percentp 30) (jewellery (d 8))) | |
1331 | (and (percentp 10) (special (d 2))) | |
ac6c07c4 | 1332 | (and (percentp 10) (magic :any 1 :potion 1)))) |
4005b342 MW |
1333 | ((e) (bag (tagged-bag :coins |
1334 | (and (percentp 5) `(:cp ,(* 1000 (d 10)))) | |
1335 | (and (percentp 30) `(:sp ,(* 1000 (d 12)))) | |
1336 | (and (percentp 25) `(:ep ,(* 1000 (d 4)))) | |
1337 | (and (percentp 25) `(:gp ,(* 1000 (d 8))))) | |
1338 | (and (percentp 10) (gems (d 10))) | |
1339 | (and (percentp 10) (jewellery (d 10))) | |
1340 | (and (percentp 15) (special (d 2))) | |
ac6c07c4 | 1341 | (and (percentp 25) (magic :any 3 :scroll 1)))) |
4005b342 MW |
1342 | ((f) (bag (tagged-bag :coins |
1343 | (and (percentp 30) `(:sp ,(* 1000 (d 10 2)))) | |
1344 | (and (percentp 20) `(:ep ,(* 1000 (d 8)))) | |
1345 | (and (percentp 45) `(:gp ,(* 1000 (d 12)))) | |
1346 | (and (percentp 30) `(:pp ,(* 1000 (d 3))))) | |
1347 | (and (percentp 20) (gems (d 12 2))) | |
1348 | (and (percentp 10) (jewellery (d 12))) | |
1349 | (and (percentp 20) (special (d 3))) | |
1350 | (and (percentp 30) (magic :potion 1 :scroll 1 | |
1351 | '(not :armour :missile | |
1352 | :sword :weapon) 3)))) | |
1353 | ((g) (bag (tagged-bag :coins | |
1354 | (and (percentp 50) `(:gp ,(* 10000 (d 4)))) | |
1355 | (and (percentp 50) `(:pp ,(* 1000 (d 6))))) | |
1356 | (and (percentp 25) (gems (d 6 3))) | |
1357 | (and (percentp 25) (jewellery (d 10))) | |
1358 | (and (percentp 30) (special (d 3))) | |
ac6c07c4 | 1359 | (and (percentp 35) (magic :any 4 :scroll 1)))) |
4005b342 MW |
1360 | ((h) (bag (tagged-bag :coins |
1361 | (and (percentp 25) `(:cp ,(* 1000 (d 8 3)))) | |
1362 | (and (percentp 50) `(:sp ,(* 1000 (d 100)))) | |
1363 | (and (percentp 50) `(:ep ,(* 10000 (d 4)))) | |
1364 | (and (percentp 50) `(:gp ,(* 10000 (d 6)))) | |
1365 | (and (percentp 25) `(:pp ,(* 1000 (d 4 5))))) | |
1366 | (and (percentp 50) (gems (d 100))) | |
1367 | (and (percentp 50) (jewellery (* 10 (d 4)))) | |
1368 | (and (percentp 10) (special (d 2))) | |
ac6c07c4 | 1369 | (and (percentp 15) (magic :any 4 :potion 1 :scroll 1)))) |
4005b342 MW |
1370 | ((i) (bag (tagged-bag :coins |
1371 | (and (percentp 30) `(:pp ,(* 1000 (d 8))))) | |
1372 | (and (percentp 50) (gems (d 6 2))) | |
1373 | (and (percentp 50) (jewellery (d 6 2))) | |
1374 | (and (percentp 5) (special (d 2))) | |
ac6c07c4 | 1375 | (and (percentp 15) (magic :any 1)))) |
4005b342 MW |
1376 | ((j) (bag (tagged-bag :coins |
1377 | (and (percentp 25) `(:cp ,(* 1000 (d 4)))) | |
1378 | (and (percentp 10) `(:sp ,(* 1000 (d 3))))))) | |
1379 | ((k) (bag (tagged-bag :coins | |
1380 | (and (percentp 30) `(:sp ,(* 1000 (d 6)))) | |
1381 | (and (percentp 10) `(:ep ,(* 1000 (d 2))))))) | |
1382 | ((l) (bag (and (percentp 50) (gems (d 4))))) | |
1383 | ((m) (bag (and (percentp 55) (gems (d 4))) | |
1384 | (and (percentp 45) (jewellery (d 6 2))))) | |
1385 | ((n) (bag (and (percentp 10) (special (d 2))) | |
1386 | (and (percentp 40) (magic :potion (d 4 2))))) | |
1387 | ((o) (bag (and (percentp 10) (special (d 3))) | |
1388 | (and (percentp 50) (magic :scroll (d 4))))) | |
1389 | ||
1390 | ;; treasure carried | |
1391 | ((p) (bag (tagged-bag :coins `(:cp ,(d 8 3))))) | |
1392 | ((q) (bag (tagged-bag :coins `(:sp ,(d 6 3))))) | |
1393 | ((r) (bag (tagged-bag :coins `(:ep ,(d 6 2))))) | |
1394 | ((s) (bag (tagged-bag :coins `(:gp ,(d 4 2))) | |
1395 | (and (percentp 5) (gems 1)))) | |
1396 | ((t) (bag (tagged-bag :coins `(:pp ,(d 6 1))) | |
1397 | (and (percentp 5) (gems 1)))) | |
1398 | ((u) (bag (tagged-bag :coins | |
1399 | (and (percentp 10) `(:cp ,(d 100))) | |
1400 | (and (percentp 10) `(:sp ,(d 100))) | |
1401 | (and (percentp 5) `(:gp ,(d 100)))) | |
1402 | (and (percentp 5) (gems (d 2))) | |
1403 | (and (percentp 5) (gems (d 4))) | |
1404 | (and (percentp 2) (special 1)) | |
ac6c07c4 | 1405 | (and (percentp 2) (magic :any 1)))) |
4005b342 MW |
1406 | ((v) (bag (tagged-bag :coins |
1407 | (and (percentp 10) `(:sp ,(d 100))) | |
1408 | (and (percentp 5) `(:ep ,(d 100))) | |
1409 | (and (percentp 5) `(:gp ,(d 100))) | |
1410 | (and (percentp 5) `(:pp ,(d 100)))) | |
1411 | (and (percentp 10) (gems (d 2))) | |
1412 | (and (percentp 10) (gems (d 4))) | |
1413 | (and (percentp 5) (special 1)) | |
ac6c07c4 | 1414 | (and (percentp 5) (magic :any 1)))) |
4005b342 MW |
1415 | |
1416 | ;; unguarded treasures | |
1417 | ((unguarded-1) | |
1418 | (bag (tagged-bag :coins | |
1419 | `(:sp ,(* 100 (d 6))) | |
1420 | (and (percentp 50) `(:gp ,(* 10 (d 6))))) | |
1421 | (and (percentp 5) (gems (d 6))) | |
1422 | (and (percentp 2) (jewellery (d 6))) | |
ac6c07c4 | 1423 | (and (percentp 2) (magic :any 1)))) |
4005b342 MW |
1424 | ((unguarded-2 unguarded-3) |
1425 | (bag (tagged-bag :coins | |
1426 | `(:sp ,(* 100 (d 12))) | |
1427 | (and (percentp 50) `(:gp ,(* 100 (d 6))))) | |
1428 | (and (percentp 10) (gems (d 6))) | |
1429 | (and (percentp 5) (jewellery (d 6))) | |
ac6c07c4 | 1430 | (and (percentp 8) (magic :any 1)))) |
4005b342 MW |
1431 | ((unguarded-4 unguarded-5) |
1432 | (bag (tagged-bag :coins | |
1433 | `(:sp ,(* 1000 (d 6))) | |
1434 | `(:gp ,(* 200 (d 6)))) | |
1435 | (and (percentp 20) (gems (d 8))) | |
1436 | (and (percentp 10) (jewellery (d 8))) | |
ac6c07c4 | 1437 | (and (percentp 10) (magic :any 1)))) |
4005b342 MW |
1438 | ((unguarded-6 unguarded-7) |
1439 | (bag (tagged-bag :coins | |
1440 | `(:sp ,(* 2000 (d 6))) | |
1441 | `(:gp ,(* 500 (d 6)))) | |
1442 | (and (percentp 30) (gems (d 10))) | |
1443 | (and (percentp 15) (jewellery (d 10))) | |
ac6c07c4 | 1444 | (and (percentp 15) (magic :any 1)))) |
4005b342 MW |
1445 | ((unguarded-8 unguarded-9) |
1446 | (bag (tagged-bag :coins | |
1447 | `(:sp ,(* 5000 (d 6))) | |
1448 | `(:gp ,(* 1000 (d 6)))) | |
1449 | (and (percentp 40) (gems (d 12))) | |
1450 | (and (percentp 20) (jewellery (d 12))) | |
ac6c07c4 MW |
1451 | (and (percentp 20) (magic :any 1))))))) |
1452 | ||
1453 | (defconstant combine-treasures | |
1454 | '((:coins (t . +)) | |
1455 | (t . append))) | |
1456 | ||
1457 | (defun combine2 (spec a b) | |
1458 | (labels ((comb (tag x y) | |
1459 | (dolist (pair spec) | |
1460 | (let ((label (car pair))) | |
1461 | (when (or (eq label t) | |
1462 | (eq label tag)) | |
1463 | (return-from comb | |
1464 | (let ((method (cdr pair))) | |
1465 | (etypecase method | |
1466 | (list (combine2 method x y)) | |
1467 | ((member +) (list (+ (car x) (car y)))) | |
1468 | ((or symbol function) | |
1469 | (funcall method x y)))))))) | |
1470 | (error "No combiner found for ~S." tag))) | |
1471 | (let ((list nil)) | |
1472 | (dolist (pair a) | |
1473 | (let* ((tag (car pair)) | |
1474 | (match (assoc tag b))) | |
1475 | (push (if (null match) | |
1476 | pair | |
1477 | (cons tag | |
1478 | (comb tag (cdr pair) (cdr match)))) | |
1479 | list))) | |
1480 | (dolist (pair b) | |
1481 | (let* ((tag (car pair)) | |
1482 | (match (assoc tag a))) | |
1483 | (unless match | |
1484 | (push pair list)))) | |
1485 | (nreverse list)))) | |
1486 | ||
1487 | (defun combine (spec &rest lists) | |
1488 | (reduce (lambda (x y) (combine2 spec x y)) lists)) | |
1489 | ||
1490 | (defun treasure (types) | |
1491 | (apply #'combine | |
1492 | combine-treasures | |
1493 | (loop for type in types | |
1494 | collect (treasure-type type)))) | |
1495 | ||
1496 | (defun select-spells (table spells) | |
1497 | (loop for n in spells | |
1498 | for list across table | |
1499 | collect (sort (loop repeat n collect (apply #'choose-uniformly list)) | |
1500 | #'string<))) |