~mdw / dnd / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
hack
[dnd] / dice.lisp
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
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
181 (defmacro pick (&rest clauses)
182 `(funcall (choose ,@(loop for (n . clause) in clauses
183 collect n
184 collect `(lambda () ,@clause)))))
185
186 (defconstant druid-spells
187 #((detect-danger faerie-fire locate predict-weather)
188 (heat-metal obscure produce-fire warp-wood)
189 (call-lightning hold-animal protection-from-poison water-breathing)
190 (control-temperature-10-ft-radius plant-door protection-from-lightning
191 summon-animals)
192 (anti-plant-shell control-winds dissolve pass-plant)
193 (anti-animal-shell summon-weather transport-through-plants turn-wood)
194 (creeping-doom metal-to-wood summon-elemental weather-control)))
195
196 (defconstant cleric-spells
197 #((cure-light-wounds detect-evil detect-magic light protection-from-evil
198 purify-food-and-water remove-fear resist-cold)
199 (bless find-traps hold-person resist-fire silence-15-ft-radius
200 slow-poison snake-charm speak-with-animal)
201 (continual-light cure-blindness cure-disease growth-of-animals
202 locate-object remove-curse speak-with-the-dead striking)
203 (animate-dead create-water cure-serious-wounds dispel-magic
204 neutralize-poison protection-from-evil-10-ft-radius speak-with-plants
205 sticks-to-snakes)
206 (commune create-food cure-critical-wounds dispel-evil insect-plague quest
207 raise-dead truesight)
208 (aerial-servant animate-objects barrier create-normal-animals cureall
209 find-the-path speak-with-monsters word-of-recall)
210 (earthquake holy-word raise-dead-fully restore survival travel wish
211 wizardry)))
212
213 (defconstant magic-user-spells
214 #((analyse charm-person detect-magic floating-disc hold-portal light
215 magic-missile protection-from-evil read-languages read-magic shield
216 sleep ventriloquism)
217 (continual-light detect-evil detect-invisible entangle esp invisibility
218 knock levitate locate-object mirror-image phantasmal-force web
219 wizard-lock)
220 (clairvoyance create-air dispel-magic fire-ball fly haste hold-person
221 infravision invisibility-10-ft-radius lightning-bolt
222 protection-from-evil-10-ft-radius protection-from-normal-missiles
223 water-breathing)
224 (charm-monster clothform confusion dimension-door growth-of-plants
225 hallucinatory-terrain ice-storm/wall massmorph polymorph-others
226 polymorph-self remove-curse wall-of-fire wizard-eye)
227 (animate-dead cloudkill conjure-elemental contact-outer-plane dissolve
228 feeblemind hold-monster magic-jar pass-wall telekinesis teleport
229 wall-of-stone woodform)
230 (anti-magic-shell death-spell disintegrate geas invisible-stalker
231 lower-water move-earth projected-image reincarnation stone-to-flesh
232 stoneform wall-of-iron weather-control)
233 (charm-plant create-normal-monsters delayed-blast-fire-ball ironform lore
234 magic-door mass-invisibility power-word-stun reverse-gravity statue
235 summon-object sword teleport-any-object)
236 (clone create-magical-monsters dance explosive-cloud force-field
237 mass-charm mind-barrier permanence polymorph-any-object power-word-blind
238 steelform symbol travel)
239 (contingency create-any-monster gate heal immunity maze meteor-swarm
240 power-word-kill prismatic-wall shapechange survival timestop wish)))
241
242 (defun spell-caster-type ()
243 (choose 25 :cleric 5 :druid 70 :magic-user))
244
245 (defun random-spell (&optional (caster (spell-caster-type))
246 (level (ecase caster
247 ((:magic-user) (choose 28 1
248 21 2
249 15 3
250 11 4
251 9 5
252 7 6
253 5 7
254 3 8
255 1 9))
256 ((:cleric :druid) (choose 34 1
257 24 2
258 18 3
259 12 4
260 7 5
261 4 6
262 1 7)))))
263 (let ((list (aref (ecase caster
264 ((:magic-user) magic-user-spells)
265 ((:cleric) cleric-spells)
266 ((:druid) druid-spells))
267 level)))
268 (values (elt list (random (length list)))
269 caster
270 level)))
271
272 (defun symbol-match-p (form sym)
273 (cond ((eq form t) t)
274 ((eq form nil) nil)
275 ((eq form sym) t)
276 ((atom form) nil)
277 (t (ecase (car form)
278 ((and) (every (lambda (f) (symbol-match-p f sym)) (cdr form)))
279 ((or) (some (lambda (f) (symbol-match-p f sym)) (cdr form)))
280 ((not) (not (symbol-match-p (cadr form) sym)))))))
281
282 (defun choose-distinct-items (n seq)
283 (let* ((copy (subseq (coerce seq 'vector) 0))
284 (len (length copy))
285 (list nil))
286 (dotimes (i n (sort list #'string<))
287 (let ((j (random len)))
288 (push (aref copy j) list)
289 (decf len)
290 (setf (aref copy j) (aref copy len))))))
291
292 (defun magic-item (form)
293 (labels ((potion (&key recursivep)
294 (pick (2 `(:potion agility))
295 (1 `(:potion animal-control))
296 (3 `(:potion antidote))
297 (2 `(:potion blending))
298 (2 `(:potion bug-repellent))
299 (2 `(:potion clairaudience))
300 (2 `(:potion clairvoyance))
301 (2 `(:potion climbing))
302 (2 `(:potion defence :bonus ,(choose 3 1
303 2 2
304 2 3
305 2 4
306 1 5)))
307 ((if recursivep 0 4)
308 `(:potion delusion
309 :fakes ,@(cdr (potion :recursivep t))))
310 (2 `(:potion diminution))
311 (1 `(:potion ,(choose 35 'white-dragon-control
312 15 'crystal-dragon-control
313 35 'black-dragon-control
314 15 'onyx-dragon-control
315 28 'green-dragon-control
316 12 'jade-dragon-control
317 21 'blue-dragon-control
318 9 'sapphire-dragon-control
319 14 'red-dragon-control
320 6 'ruby-dragon-control
321 7 'gold-dragon-control
322 3 'amber-dragon-control)))
323 (2 `(:potion dreamspeech))
324 (1 `(:potion elasicity))
325 (2 `(:potion ,(choose-uniformly 'air-form
326 'water-form
327 'earth-form
328 'fire-form)))
329 (2 `(:potion esp))
330 (1 `(:potion ethereality))
331 (3 `(:potion fire-resistance))
332 (3 `(:potion flying))
333 (2 `(:potion fortitude))
334 (1 `(:potion freedom))
335 (3 `(:potion gaseous-form))
336 (1 `(:potion ,(choose 5 'hill-giant-control
337 5 'stone-giant-control
338 4 'frost-giant-control
339 2 'fire-giant-control
340 1 'mountain-giant-control
341 1 'sea-giant-control
342 1 'cloud-giant-control
343 1 'storm-giant-control)))
344 (3 `(:potion giant-strength))
345 (2 `(:potion growth))
346 (6 `(:potion healing))
347 (3 `(:potion heroism))
348 (1 `(:potion human-control))
349 (3 `(:potion invisibility))
350 (2 `(:potion invulnerability))
351 (2 `(:potion levitation))
352 (2 `(:potion longevity))
353 (1 `(:potion luck))
354 (1 `(:potion merging))
355 (2 `(:potion plant-control))
356 (3 `(:potion poison))
357 (3 `(:potion polymorph-self))
358 (2 `(:potion sight))
359 (2 `(:potion speech))
360 (4 `(:potion speed))
361 (2 `(:potion strength))
362 (3 `(:potion super-healing))
363 (3 `(:potion swimming))
364 (1 `(:potion treasure-finding))
365 (1 `(:potion undead-control))
366 (2 `(:potion water-breathing))))
367 (scroll ()
368 (pick (3 `(:scroll communication))
369 (2 `(:scroll creation))
370 (8 `(:scroll curse))
371 (1 (multiple-value-bind
372 (spell caster level)
373 (random-spell)
374 (declare (ignore level))
375 `(:scroll delay :caster ,caster :spells (,spell))))
376 (3 `(:scroll equipment
377 :items ,(choose-distinct-items 6
378 '(grappling-hook
379 hammer
380 iron-spikes
381 lantern
382 mirror
383 wooden-pole
384 rope
385 saddle
386 backpack
387 saddle-bags
388 stakes-and-mallet
389 wolfsbane))))
390 (2 `(:scroll illumination))
391 (2 `(:scroll mages))
392 (4 `(:map normal-treasure))
393 (3 `(:map magical-treasure))
394 (2 `(:map combined-treasure))
395 (1 `(:map special-treasure))
396 (3 `(:scroll mapping))
397 (2 `(:scroll portals))
398 (6 `(:scroll protection-from-elementals))
399 (8 `(:scroll protection-from-lycanthropes))
400 (4 `(:scroll protection-from-magic))
401 (7 `(:scroll protection-from-undead))
402 (2 `(:scroll questioning))
403 (1 (multiple-value-bind
404 (spell caster level)
405 (random-spell)
406 `(:scroll repetition
407 :caster ,caster
408 :level ,level
409 :spells (,spell))))
410 (2 `(:scroll seeing))
411 (2 `(:scroll shelter))
412 (3 `(:scroll spell-catching :max-level ,(choose 4 1
413 3 2
414 2 3
415 1 8)))
416 (25 (let ((caster (spell-caster-type))
417 (spells (choose 50 1 33 2 17 3)))
418 `(:scroll spell
419 :caster ,caster
420 :spells ,(loop repeat spells
421 collect (random-spell caster)))))
422 (2 `(:scroll trapping))
423 (2 `(:scroll truth))))
424 (wand-charges () (d 10 3))
425 (staff-charges () (d 20 2))
426 (wandlike ()
427 (pick (5 `(:wand cold :charges ,(wand-charges)))
428 (5 `(:wand enemy-detection :charges ,(wand-charges)))
429 (4 `(:wand fear :charges ,(wand-charges)))
430 (5 `(:wand fireballs :charges ,(wand-charges)))
431 (4 `(:wand illusion :charges ,(wand-charges)))
432 (5 `(:wand lightning-bolts :charges ,(wand-charges)))
433 (5 `(:wand magic-detection :charges ,(wand-charges)))
434 (5 `(:wand metal-detection :charges ,(wand-charges)))
435 (4 `(:wand negation :charges ,(wand-charges)))
436 (5 `(:wand paralysation :charges ,(wand-charges)))
437 (5 `(:wand polymorphing :charges ,(wand-charges)))
438 (4 `(:wand secret-door-detection
439 :charges ,(wand-charges)))
440 (4 `(:wand trap-detection :charges ,(wand-charges)))
441 (1 `(:staff commanding :charges nil))
442 (2 `(:staff dispelling :charges ,(staff-charges)))
443 (3 `(:staff druids :charges ,(staff-charges)))
444 (3 `(:staff ,(choose 19 'air
445 19 'earth
446 19 'fire
447 19 'water
448 6 'air-and-water
449 6 'earth-and-fire
450 2 'elemental-power)
451 :charges ,(staff-charges)))
452 (2 `(:staff harming :charges ,(staff-charges)))
453 (7 `(:staff healing :charges ,(staff-charges)))
454 (1 `(:staff power :charges ,(staff-charges)))
455 (3 `(:staff snake :charges ,(staff-charges)))
456 (3 `(:staff striking :charges ,(staff-charges)))
457 (2 `(:staff withering :charges ,(staff-charges)))
458 (1 `(:staff wizardry :charges ,(staff-charges)))
459 (2 `(:rod cancellation))
460 (1 `(:rod dominion))
461 (1 `(:rod health))
462 (2 `(:rod inertia))
463 (1 `(:rod parrying))
464 (1 `(:rod victory))
465 (3 `(:rod weaponry))
466 (1 `(:rod wyrm :colour ,(choose 5 'gold
467 3 'blue
468 2 'black)))))
469 (ring ()
470 (pick (2 `(:ring animal-control))
471 (6 `(:ring delusion))
472 (1 `(:ring djinni-summoning))
473 (4 `(:ring ear))
474 (4 `(:ring ,(choose 19 'air-adaptation
475 19 'earth-adaptation
476 19 'fire-adaptation
477 19 'water-adaptation
478 6 'air-and-water-adaptation
479 6 'earth-and-fire-adaptation
480 2 'elemental-adaptation)))
481 (6 `(:ring fire-resistance))
482 (3 `(:ring holiness))
483 (1 `(:ring human-control))
484 (5 `(:ring invisibility))
485 (3 `(:ring life-protection :charges ,(d 6)))
486 (3 `(:ring memory))
487 (2 `(:ring plant-control))
488 (1 `(:ring protection :bonus 1 :radius 5))
489 (10 `(:ring protection :bonus ,(choose 4 1
490 3 2
491 2 3
492 1 4)))
493 (4 `(:ring quickness))
494 (1 `(:ring regeneration))
495 (3 `(:ring remedies))
496 (2 `(:ring safety :charges ,(d 4)))
497 (3 `(:ring seeing))
498 (3 `(:ring spell-eating))
499 (2 (let* ((caster (spell-caster-type))
500 (spells (loop repeat (d 6)
501 collect (random-spell caster))))
502 `(:ring spell-storing
503 :caster ,caster
504 :spells ,(remove-duplicates (sort spells
505 #'string<)))))
506 (2 `(:ring spell-turning))
507 (4 `(:ring survival :charges ,(+ 100 (d 100))))
508 (2 `(:ring telekinesis))
509 (4 `(:ring truth))
510 (3 `(:ring truthfulness))
511 (2 `(:ring truthlessness))
512 (5 `(:ring water-walking))
513 (5 `(:ring weakness))
514 (2 `(:ring wishes :charges ,(choose 4 1
515 3 2
516 2 3
517 1 4)))
518 (2 `(:ring x-ray-vision))))
519 (misc-item ()
520 (pick (2 `(:amulet protection-from-crystal-balls-and-esp))
521 (2 `(:bag devouring))
522 (5 `(:bag holding))
523 (3 `(:boat undersea))
524 (2 `(:boots levitation))
525 (3 `(:boots speed))
526 (2 `(:boots travelling-and-leaping))
527 (1 `(:bowl commanding-water-elementals))
528 (1 `(:brazier commanding-fire-elementals))
529 (2 `(:broom flying))
530 (1 `(:censer controlling-air-elementals))
531 (3 `(:chime time))
532 (2 `(:crystal-ball normal))
533 (1 `(:crystal-ball clairaudience))
534 (1 `(:crystal-ball esp))
535 (2 `(:cloak displacer))
536 (1 `(:drums panic))
537 (1 `(:bottle efreeti))
538 (3 `(:egg ,(choose-uniformly 'rock-baboon
539 'giant-bat
540 'black-bear
541 'grizzly-bear
542 'boar
543 'mountain-lion
544 'panther
545 'giant-ferret
546 'gecko
547 'draco
548 'racer-snake
549 'wolf)))
550 (2 `(:boots elven))
551 (2 `(:cloak elven))
552 (1 `(:carpet flying))
553 (2 `(:gauntlets ogre-power))
554 (2 `(:girdle giant-strength))
555 (2 `(:helm ,(choose-uniformly 'lawful-alignment
556 'neutral-alignment
557 'chaotic-alignment)))
558 (2 `(:helm reading))
559 (1 `(:helm telepathy))
560 (1 `(:helm teleportation))
561 (1 `(:horn blasting))
562 (2 `(:lamp hurricane))
563 (3 `(:lamp long-burning))
564 (2 `(:medallion esp-30-ft-range))
565 (1 `(:medallion esp-90-ft-range))
566 (1 `(:mirror life-trapping)) ;;; fixme include contents
567 (3 `(:muzzle training))
568 (2 `(:nail finger))
569 (3 `(:nail pointing))
570 (5 `(:ointment ,(choose-uniformly 'blessing
571 'healing
572 'poison
573 'scarring
574 'soothing
575 'tanning)))
576 (3 `(:pouch security))
577 (3 `(:quill copying))
578 (4 `(:rope climbing))
579 (2 `(:scarab protection :charges ,(d 6 2)))
580 (3 `(:slate identification))
581 (1 `(:stone controlling-earth-elementals))
582 (2 `(:talisman ,(choose-uniformly 'air-travel
583 'earth-travel
584 'fire-travel
585 'water-travel
586 'elemental-travel)))
587 (3 `(:wheel floating))
588 (1 `(:wheel fortune))
589 (2 `(:wheel square))))
590 (weapon-bonus (class)
591 (loop for bonus from 1
592 for roll = (random 100) then (- roll item)
593 for item in (ecase class
594 ((a) '(40 27 17 10 6))
595 ((b) '(50 24 14 8 4))
596 ((c) '(60 21 11 6 2))
597 ((d) '(70 18 8 3 1)))
598 when (< roll item) return bonus))
599 (armour-size ()
600 (choose 68 'human
601 13 'dwarf
602 10 'elf
603 7 'halfling
604 2 'giant))
605 (armour-piece (class)
606 (let* ((bonus (weapon-bonus class))
607 (power (and (percentp (* 5 (1+ bonus)))
608 (pick (7 `(absorption))
609 (10 `(charm))
610 (15 `(cure-wounds))
611 (10 `(electricity))
612 (5 `(energy-drain))
613 (3 `(ethereality))
614 (10 `(fly))
615 (6 `(gaseous-form))
616 (9 `(haste))
617 (10 `(invisibility))
618 (8 `(reflection))
619 (7 `(remove-curse :charges ,(d 3))))))
620 (cursedp (if (and power (eq (car power) 'remove-curse))
621 nil
622 (zerop (random 8)))))
623 `(:bonus ,bonus
624 ,@(and power (cons :power power))
625 :size ,(armour-size)
626 ,@(and cursedp `(:cursed t)))))
627 (armour ()
628 (pick (10 `((:leather ,@(armour-piece 'd))))
629 ( 7 `((:scale-mail ,@(armour-piece 'd))))
630 (13 `((:chain-mail ,@(armour-piece 'c))))
631 ( 9 `((:banded-mail ,@(armour-piece 'd))))
632 (11 `((:plate-mail ,@(armour-piece 'b))))
633 ( 5 `((:suit-armour ,@(armour-piece 'b))))
634 (20 `((:shield ,@(armour-piece 'a))))
635 ( 2 `((:scale-mail ,@(armour-piece 'd))
636 (:shield ,@(armour-piece 'a))))
637 ( 8 `((:chain-mail ,@(armour-piece 'c))
638 (:shield ,@(armour-piece 'a))))
639 ( 5 `((:banded-mail ,@(armour-piece 'd))
640 (:shield ,@(armour-piece 'a))))
641 (10 `((:plate-mail ,@(armour-piece 'b))
642 (:shield ,@(armour-piece 'a))))))
643 (opponent ()
644 (choose 6 'bugs
645 3 'constructs
646 6 'dragonkind
647 9 'enchanted-monsters
648 12 'giantkind
649 12 'lycanthropes
650 4 'planar-monsters
651 6 'regenerating-monsters
652 9 'reptiles-and-dinosaurs
653 3 'spell-immune-monsters
654 6 'spellcasters
655 12 'undead
656 6 'water-breathing-monsters
657 6 'weapon-using-monsters))
658 (weapon-talent (&key missilep)
659 (pick (5 `(breathing))
660 (7 `(charming))
661 (4 `(deceiving))
662 ((if missilep 0 7) `(defending))
663 (2 `(deflecting))
664 (2 `(draining :charges ,(+ 4 (d 4))))
665 (5 `(extinguishing))
666 (6 `(finding))
667 (5 `(flaming))
668 (3 `(flying))
669 (8 `(healing))
670 (5 `(hiding))
671 (6 `(holding))
672 (8 `(lightning))
673 (6 `(silencing))
674 (2 `(slicing))
675 (4 `(slowing))
676 (4 `(speeding))
677 (5 `(translating))
678 (5 `(watching))
679 (1 `(wishing :charges ,(d 3)))))
680 (weapon-modifier (bonus &rest keys &key &allow-other-keys)
681 (and (percentp (aref #(40 30 20 15 10) (1- bonus)))
682 (pick (33 `(:extra (,(+ bonus 1) :against ,(opponent))))
683 (24 `(:extra (,(+ bonus 2) :against ,(opponent))))
684 (16 `(:extra (,(+ bonus 3) :against ,(opponent))))
685 (9 `(:extra (,(+ bonus 4) :against ,(opponent))))
686 (3 `(:extra (,(+ bonus 5) :against ,(opponent))))
687 (15 `(:talent ,@(apply #'weapon-talent keys))))))
688 (sword-modifier (bonus &rest keys &key &allow-other-keys)
689 (and (percentp (aref #(40 30 25 20 15) (1- bonus)))
690 (pick (29 `(:extra (,(+ bonus 1) :against ,(opponent))))
691 (21 `(:extra (,(+ bonus 2) :against ,(opponent))))
692 (14 `(:extra (,(+ bonus 3) :against ,(opponent))))
693 (8 `(:extra (,(+ bonus 4) :against ,(opponent))))
694 (3 `(:extra (,(+ bonus 5) :against ,(opponent))))
695 (25 `(:talent ,@(apply #'weapon-talent keys))))))
696 (missile ()
697 (multiple-value-bind
698 (item class)
699 (pick (37 (values :arrow 'a))
700 (22 (values :quarrel 'a))
701 (11 (values :sling-stone 'a))
702 (2 (values :blowgun 'd))
703 (8 (values :long-bow 'd))
704 (5 (values :short-bow 'd))
705 (2 (values :heavy-crossbow 'd))
706 (5 (values :light-crossbow 'd))
707 (8 (values :sling 'd)))
708 (ecase class
709 ((a) (let* ((bonus (weapon-bonus 'a))
710 (cursedp (zerop (random 10)))
711 (talent (and (percentp (* 5 (- 7 bonus)))
712 (choose 4 'biting
713 5 'blinking
714 5 'charming
715 7 'climbing
716 10 'curing
717 3 'disarming
718 4 'dispelling
719 7 'flying
720 7 'lightning
721 5 'penetrating
722 4 'refilling
723 6 'screaming
724 5 'seeking
725 4 'sinking
726 2 'slaying
727 7 'speaking
728 4 'stunning
729 2 'teleporting
730 5 'transporting
731 4 'wounding)))
732 (number (ecase bonus
733 ((1) (d 10 2))
734 ((2) (d 8 2))
735 ((3) (d 6 2))
736 ((4) (d 4 2))
737 ((5) (+ (d 4) 1)))))
738 `(,item :bonus ,bonus
739 ,@(and talent `(:talent ,talent))
740 :number ,number
741 ,@(and cursedp `(:cursed t)))))
742 ((d) (let* ((bonus (weapon-bonus 'd))
743 (cursedp (zerop (random 10)))
744 (modifier (weapon-modifier bonus :missilep t))
745 (range (ecase (+ bonus (d 4))
746 ((2 3 4) nil)
747 ((5 6 7) 1.5)
748 ((8 9) 2))))
749 `(,item :bonus ,bonus ,@modifier
750 ,@(and range `(:range ,range))
751 ,@(and cursedp `(:cursed t))))))))
752 (weapon-intelligence ()
753 (multiple-value-bind
754 (int langs prim read-magic-p extra)
755 (pick (79 (values nil 0 0 nil 0))
756 (6 (values 7 0 1 nil 0))
757 (5 (values 8 0 2 nil 0))
758 (4 (values 9 0 3 nil 0))
759 (3 (values 10 (d 3) 3 nil 0))
760 (2 (values 11 (d 6) 3 t 0))
761 (1 (values 12 (d 4 2) 3 t 1)))
762 (and int
763 (let ((powers nil)
764 (healing nil)
765 (damage nil)
766 (checklist nil))
767 (macrolet ((power-check (&rest forms)
768 `(pick ,@(loop for (tag n . form) in forms
769 if tag
770 collect
771 `((if (member ',tag
772 checklist)
773 0
774 ,n)
775 (push ',tag checklist)
776 ,@(or form
777 `((push ',tag
778 powers))))
779 else
780 collect `(,n ,@form)))))
781 (labels ((primary-power ()
782 (power-check
783 (detect-evil 10)
784 (detect-gems 5)
785 (detect-magic 10)
786 (detect-metal 10)
787 (detect-shifting-walls-and-rooms 15)
788 (detect-sloping-passages 15)
789 (find-secret-doors 10)
790 (find-traps 10)
791 (see-invisible 10)
792 (:one-extra 4
793 (extraordinary-power))
794 (:two-primary 1
795 (primary-power)
796 (primary-power))))
797 (extraordinary-power ()
798 (power-check
799 (clairaudience 10)
800 (clairvoyance 10)
801 (esp 10)
802 (nil 5
803 (setf damage (if damage
804 (1+ damage)
805 5)))
806 (flying 5)
807 (nil 5
808 (setf healing (+ (or healing 0) 6)))
809 (illusion 9)
810 (levitation 5)
811 (telekinesis 10)
812 (telepathy 10)
813 (teleportation 9)
814 (x-ray-vision 9)
815 (:two-three-extra 2
816 (extraordinary-power)
817 (extraordinary-power))
818 (:two-three-extra 1
819 (extraordinary-power)
820 (extraordinary-power)
821 (extraordinary-power)))))
822 (dotimes (i prim) (primary-power))
823 (dotimes (i extra) (extraordinary-power))))
824 (when damage
825 (push `(extra-damage ,damage) powers))
826 (when healing
827 (push `(healing ,healing) powers))
828 `(:intelligence ,int
829 :ego ,(d 12)
830 :languages ,langs
831 ,@(and read-magic-p `(:read-magic t))
832 :powers ,powers)))))
833 (sword ()
834 (multiple-value-bind
835 (type class)
836 (pick (65 (values :normal-sword 'c))
837 (19 (values :short-sword 'c))
838 (8 (values :two-handed-sword 'd))
839 (8 (values :bastard-sword 'd)))
840 (let* ((bonus (weapon-bonus class))
841 (cursedp (zerop (random 10)))
842 (modifier (sword-modifier bonus))
843 (intel (weapon-intelligence)))
844 `(,type :bonus ,bonus
845 ,@modifier
846 ,@intel
847 ,@(and cursedp `(:cursed t))))))
848 (weapon ()
849 (multiple-value-bind
850 (type returnsp class)
851 (pick (7 (values :battle-axe nil 'd))
852 (8 (values :hand-axe (choose 3 nil 1 t) 'b))
853 (3 (values :blackjack nil 'c))
854 (3 (values :bola (choose 2 nil 1 t) 'b))
855 (5 (values :club nil 'c))
856 (14 (values :dagger (choose 11 nil 3 t) 'b))
857 (4 (values :one-handed-flail nil 'c))
858 (2 (values :two-handed-flail nil 'd))
859 (3 (values :halberd nil 'd))
860 (8 (values :war-hammer nil 'c))
861 (4 (values :javelin (choose 3 nil 1 t) 'b))
862 (4 (values :lance nil 'd))
863 (7 (values :mace nil 'c))
864 (5 (values :morning-star nil 'c))
865 (3 (values :net (choose 2 nil 1 t) 'b))
866 (3 (values :pike nil 'd))
867 (2 (values :pole-axe nil 'd))
868 (12 (values :spear (choose 3 nil 1 t) 'b))
869 (3 (values :whip nil 'c)))
870 (let* ((bonus (weapon-bonus class))
871 (cursedp (zerop (random 10)))
872 (modifier (sword-modifier bonus))
873 (intel (and (percentp 40)
874 (weapon-intelligence))))
875 `(,type
876 ,@(and returnsp `(:returning t))
877 :bonus ,bonus
878 ,@modifier
879 ,@intel
880 ,@(and cursedp `(:cursed t)))))))
881 (pick ((if (symbol-match-p form :potion) 25 0) (list (potion)))
882 ((if (symbol-match-p form :scroll) 12 0) (list (scroll)))
883 ((if (symbol-match-p form :wandlike) 9 0) (list (wandlike)))
884 ((if (symbol-match-p form :ring) 6 0) (list (ring)))
885 ((if (symbol-match-p form :misc) 10 0) (list (misc-item)))
886 ((if (symbol-match-p form :armour) 10 0) (armour))
887 ((if (symbol-match-p form :missile) 11 0) (list (missile)))
888 ((if (symbol-match-p form :sword) 9 0) (list (sword)))
889 ((if (symbol-match-p form :weapon) 8 0) (list (weapon))))))
890
891 (defun treasure-type (type-code)
892 (labels ((common-fur-type ()
893 (choose-uniformly 'beaver
894 'fox
895 'marten
896 'seal))
897 (rare-fur-type ()
898 (choose-uniformly 'ermine
899 'mink
900 'sable))
901 (special (n)
902 (tagged-bag
903 :special
904 (loop repeat n
905 collect
906 (pick (10 `(:kind book
907 :value ,(* 10 (d 100))
908 :encumbrance ,(d 100)))
909 (2 `(:kind pelt
910 :animal ,(common-fur-type)
911 :value ,(d 4)
912 :encumbrance ,(* 10 (d 6))))
913 (5 `(:kind cape
914 :animal ,(common-fur-type)
915 :value ,(* 100 (d 6))
916 :encumbrance ,(* 10 (+ 4 (d 8)))))
917 (3 `(:kind coat
918 :animal ,(common-fur-type)
919 :value ,(* 100 (d 4 3))
920 :encumbrance ,(* 10 (+ 8 (d 6 2)))))
921 (2 `(:kind pelt
922 :animal ,(rare-fur-type)
923 :value ,(d 6 2)
924 :encumbrance ,(* 10 (d 6))))
925 (5 `(:kind cape
926 :animal ,(rare-fur-type)
927 :value ,(* 100 (d 6 4))
928 :encumbrance ,(* 10 (+ 4 (d 8)))))
929 (3 `(:kind coat
930 :animal ,(rare-fur-type)
931 :value ,(* 1000 (d 4))
932 :encumbrance ,(* 10 (+ 8 (d 6 2)))))
933 (5 `(:kind incense
934 :value ,(d 6 5)
935 :encumbrance 1
936 :quantity ,(d 4 2)))
937 (5 `(:kind perfume
938 :value ,(* 10 (+ 5 (d 10)))
939 :encumbrance 1
940 :quantity ,(d 3 2)))
941 (5 (let ((w (d 6)) (h (d 2)))
942 `(:kind ,(choose-uniformly 'rug
943 'tapestry)
944 :value ,(* w h (d 10 2))
945 :encumbrance ,(* 100 w h (d 6))
946 :size (* ,w ,h))))
947 (10 (let ((w (d 8)) (h (d 2)))
948 `(:kind silk
949 :value ,(* w h (d 8))
950 :encumbrance ,(* 10 w h (d 6))
951 :size (* ,w ,h))))
952 (10 `(:kind animal-skin
953 :value ,(d 10)
954 :encumbrance ,(* 10 (d 4 5))))
955 (10 `(:kind monster-skin
956 :value ,(* 100 (d 10))
957 :encumbrance ,(* 50 (d 100))))
958 (5 (let ((enc (d 100)))
959 `(:kind spice
960 :value ,(* enc (d 4 4))
961 :encumbrance ,enc)))
962 (5 `(:kind statuette
963 :value ,(* 100 (d 10))
964 :encumbrance ,(d 100)))
965 (5 `(:wine
966 :value ,(d 6)
967 :encumbrance ,(* 10 (+ 3 (d 6)))
968 :bottles ,(d 12)))))))
969 (gem-type (&key (min-value 0) recursivep)
970 (pick ((if (<= min-value 10) 3 0)
971 (values 10 (choose-uniformly 'agate
972 'quartz
973 'turquoise)))
974 ((if (<= min-value 50) 7 0)
975 (values 50 (choose-uniformly 'crystal
976 'jasper
977 'onyx)))
978 ((if (<= min-value 100) 15 0)
979 (values 100 (choose-uniformly 'amber
980 'amethyst
981 'coral
982 'garnet
983 'jade)))
984 ((if (<= min-value 500) 21 0)
985 (values 500 (choose-uniformly 'aquamarine
986 'pearl
987 'topaz)))
988 ((if (<= min-value 1000) 25 0)
989 (values 1000 (choose-uniformly 'carbuncle
990 'opal)))
991 ((if (<= min-value 5000) 19 0)
992 (values 5000 (choose-uniformly 'emerald
993 'ruby
994 'sapphire)))
995 ((if (<= min-value 10000) 7 0)
996 (values 10000 'diamond 'jacinth))
997 ((if (<= min-value 1000) 1 0)
998 (values (* 1000 (d 100))
999 'tristal))
1000 ((if (and (not recursivep)
1001 (<= min-value 2000)) 2 0)
1002 (multiple-value-bind
1003 (value kind)
1004 (gem-type :min-value (max 1000
1005 (ceiling min-value 2))
1006 :recursivep t)
1007 (values (* 2 value)
1008 (intern (format nil "STAR-~A"
1009 (string kind))))))))
1010 (gems (n)
1011 (tagged-bag
1012 :gems
1013 (loop while (plusp n)
1014 for i = (min n (d 5))
1015 do (decf n i)
1016 collect
1017 (let ((mods (choose 4 :size 4 :qual 2 :both))
1018 (mod-list nil))
1019 (multiple-value-bind
1020 (value kind)
1021 (gem-type)
1022 (when (or (eq mods :size)
1023 (eq mods :both))
1024 (multiple-value-bind
1025 (mod mult)
1026 (pick (1 (values 'very-small 1/8))
1027 (2 (values 'small 1/4))
1028 (2 (values 'fairly-small 1/2))
1029 (2 (values 'fairly-large 2))
1030 (2 (values 'large 4))
1031 (1 (values 'very-small 8)))
1032 (setf mod-list
1033 (append `(:size ,mod) mod-list))
1034 (setf value (* value mult))))
1035 (when (or (eq mods :qual)
1036 (eq mods :both))
1037 (multiple-value-bind
1038 (mod mult)
1039 (pick (1 (values 'very-poor 1/8))
1040 (2 (values 'poor 1/4))
1041 (2 (values 'fairly-poor 1/2))
1042 (2 (values 'fairly-good 2))
1043 (2 (values 'good 4))
1044 (1 (values 'very-good 8)))
1045 (setf mod-list
1046 (append `(:size ,mod) mod-list))
1047 (setf value (* value mult))))
1048 `(:kind ,kind
1049 :value ,(max 1 (round value))
1050 ,@mod-list
1051 ,@(and (> i 1) `(:quantity ,i))))))))
1052 (jewellery (n)
1053 (tagged-bag
1054 :jewellery
1055 (loop while (plusp n)
1056 for i = (min n (d 5))
1057 do (decf n i)
1058 collect
1059 (multiple-value-bind
1060 (value enc class)
1061 (pick ( 1 (values 100 10 'a))
1062 ( 2 (values 500 10 'a))
1063 ( 3 (values 1000 10 'a))
1064 ( 4 (values 1500 10 'a))
1065 ( 5 (values 2000 10 'a))
1066 ( 8 (values 2500 10 'a))
1067 (10 (values 3000 25 'a))
1068 (11 (values 4000 25 'b))
1069 (13 (values 5000 25 'b))
1070 (11 (values 7500 25 'b))
1071 ( 9 (values 10000 25 'b))
1072 ( 7 (values 15000 25 'c))
1073 ( 5 (values 20000 50 'c))
1074 ( 4 (values 25000 50 'c))
1075 ( 3 (values 30000 50 'c))
1076 ( 2 (values 40000 50 'c))
1077 ( 1 (values 50000 50 'c)))
1078 (let ((kind (ecase class
1079 ((a) (choose-uniformly 'anklet
1080 'beads
1081 'bracelet
1082 'brooch
1083 'buckle
1084 'cameo
1085 'chain
1086 'clasp
1087 'locket
1088 'pin))
1089 ((b) (choose-uniformly 'armband
1090 'belt
1091 'collar
1092 'earring
1093 'four-leaf-clover
1094 'heart
1095 'leaf
1096 'necklace
1097 'pendant
1098 'rabbit-foot))
1099 ((c) (choose-uniformly 'amulet
1100 'crown
1101 'diadem
1102 'medallion
1103 'orb
1104 'ring
1105 'scarab
1106 'sceptre
1107 'talisman
1108 'tiara)))))
1109 `(:kind ,kind
1110 :value ,value
1111 :encumbrance ,enc
1112 ,@(and (> i 1) `(:quantity ,i))))))))
1113 (magic (&rest forms)
1114 (tagged-bag :magic
1115 (loop with list = nil
1116 for (form n) on forms by #'cddr do
1117 (loop repeat n do
1118 (dolist (item (magic-item form))
1119 (push item list)))
1120 finally (return list)))))
1121 (ecase type-code
1122
1123 ;; treasure in lair
1124 ((a) (bag (tagged-bag :coins
1125 (and (percentp 25) `(:cp ,(* 1000 (d 6))))
1126 (and (percentp 30) `(:sp ,(* 1000 (d 6))))
1127 (and (percentp 20) `(:ep ,(* 1000 (d 4))))
1128 (and (percentp 35) `(:gp ,(* 1000 (d 6 2))))
1129 (and (percentp 25) `(:pp ,(* 1000 (d 2)))))
1130 (and (percentp 50) (gems (d 6 6)))
1131 (and (percentp 50) (jewellery (d 6 6)))
1132 (and (percentp 10) (special (d 2)))
1133 (and (percentp 30) (magic t 3))))
1134 ((b) (bag (tagged-bag :coins
1135 (and (percentp 50) `(:cp ,(* 1000 (d 8))))
1136 (and (percentp 25) `(:sp ,(* 1000 (d 6))))
1137 (and (percentp 25) `(:ep ,(* 1000 (d 4))))
1138 (and (percentp 35) `(:gp ,(* 1000 (d 3)))))
1139 (and (percentp 25) (gems (d 6)))
1140 (and (percentp 25) (jewellery (d 6)))
1141 (and (percentp 10)
1142 (magic '(or :armour :missile :sword :weapon) 1))))
1143 ((c) (bag (tagged-bag :coins
1144 (and (percentp 20) `(:cp ,(* 1000 (d 12))))
1145 (and (percentp 30) `(:sp ,(* 1000 (d 4))))
1146 (and (percentp 10) `(:ep ,(* 1000 (d 4)))))
1147 (and (percentp 50) (gems (d 6 6)))
1148 (and (percentp 50) (jewellery (d 6 6)))
1149 (and (percentp 5) (special (d 2)))
1150 (and (percentp 10) (magic t 2))))
1151 ((d) (bag (tagged-bag :coins
1152 (and (percentp 10) `(:cp ,(* 1000 (d 8))))
1153 (and (percentp 15) `(:sp ,(* 1000 (d 12))))
1154 (and (percentp 60) `(:gp ,(* 1000 (d 6)))))
1155 (and (percentp 30) (gems (d 8)))
1156 (and (percentp 30) (jewellery (d 8)))
1157 (and (percentp 10) (special (d 2)))
1158 (and (percentp 10) (magic t 1 :potion 1))))
1159 ((e) (bag (tagged-bag :coins
1160 (and (percentp 5) `(:cp ,(* 1000 (d 10))))
1161 (and (percentp 30) `(:sp ,(* 1000 (d 12))))
1162 (and (percentp 25) `(:ep ,(* 1000 (d 4))))
1163 (and (percentp 25) `(:gp ,(* 1000 (d 8)))))
1164 (and (percentp 10) (gems (d 10)))
1165 (and (percentp 10) (jewellery (d 10)))
1166 (and (percentp 15) (special (d 2)))
1167 (and (percentp 25) (magic t 3 :scroll 1))))
1168 ((f) (bag (tagged-bag :coins
1169 (and (percentp 30) `(:sp ,(* 1000 (d 10 2))))
1170 (and (percentp 20) `(:ep ,(* 1000 (d 8))))
1171 (and (percentp 45) `(:gp ,(* 1000 (d 12))))
1172 (and (percentp 30) `(:pp ,(* 1000 (d 3)))))
1173 (and (percentp 20) (gems (d 12 2)))
1174 (and (percentp 10) (jewellery (d 12)))
1175 (and (percentp 20) (special (d 3)))
1176 (and (percentp 30) (magic :potion 1 :scroll 1
1177 '(not :armour :missile
1178 :sword :weapon) 3))))
1179 ((g) (bag (tagged-bag :coins
1180 (and (percentp 50) `(:gp ,(* 10000 (d 4))))
1181 (and (percentp 50) `(:pp ,(* 1000 (d 6)))))
1182 (and (percentp 25) (gems (d 6 3)))
1183 (and (percentp 25) (jewellery (d 10)))
1184 (and (percentp 30) (special (d 3)))
1185 (and (percentp 35) (magic t 4 :scroll 1))))
1186 ((h) (bag (tagged-bag :coins
1187 (and (percentp 25) `(:cp ,(* 1000 (d 8 3))))
1188 (and (percentp 50) `(:sp ,(* 1000 (d 100))))
1189 (and (percentp 50) `(:ep ,(* 10000 (d 4))))
1190 (and (percentp 50) `(:gp ,(* 10000 (d 6))))
1191 (and (percentp 25) `(:pp ,(* 1000 (d 4 5)))))
1192 (and (percentp 50) (gems (d 100)))
1193 (and (percentp 50) (jewellery (* 10 (d 4))))
1194 (and (percentp 10) (special (d 2)))
1195 (and (percentp 15) (magic t 4 :potion 1 :scroll 1))))
1196 ((i) (bag (tagged-bag :coins
1197 (and (percentp 30) `(:pp ,(* 1000 (d 8)))))
1198 (and (percentp 50) (gems (d 6 2)))
1199 (and (percentp 50) (jewellery (d 6 2)))
1200 (and (percentp 5) (special (d 2)))
1201 (and (percentp 15) (magic t 1))))
1202 ((j) (bag (tagged-bag :coins
1203 (and (percentp 25) `(:cp ,(* 1000 (d 4))))
1204 (and (percentp 10) `(:sp ,(* 1000 (d 3)))))))
1205 ((k) (bag (tagged-bag :coins
1206 (and (percentp 30) `(:sp ,(* 1000 (d 6))))
1207 (and (percentp 10) `(:ep ,(* 1000 (d 2)))))))
1208 ((l) (bag (and (percentp 50) (gems (d 4)))))
1209 ((m) (bag (and (percentp 55) (gems (d 4)))
1210 (and (percentp 45) (jewellery (d 6 2)))))
1211 ((n) (bag (and (percentp 10) (special (d 2)))
1212 (and (percentp 40) (magic :potion (d 4 2)))))
1213 ((o) (bag (and (percentp 10) (special (d 3)))
1214 (and (percentp 50) (magic :scroll (d 4)))))
1215
1216 ;; treasure carried
1217 ((p) (bag (tagged-bag :coins `(:cp ,(d 8 3)))))
1218 ((q) (bag (tagged-bag :coins `(:sp ,(d 6 3)))))
1219 ((r) (bag (tagged-bag :coins `(:ep ,(d 6 2)))))
1220 ((s) (bag (tagged-bag :coins `(:gp ,(d 4 2)))
1221 (and (percentp 5) (gems 1))))
1222 ((t) (bag (tagged-bag :coins `(:pp ,(d 6 1)))
1223 (and (percentp 5) (gems 1))))
1224 ((u) (bag (tagged-bag :coins
1225 (and (percentp 10) `(:cp ,(d 100)))
1226 (and (percentp 10) `(:sp ,(d 100)))
1227 (and (percentp 5) `(:gp ,(d 100))))
1228 (and (percentp 5) (gems (d 2)))
1229 (and (percentp 5) (gems (d 4)))
1230 (and (percentp 2) (special 1))
1231 (and (percentp 2) (magic t 1))))
1232 ((v) (bag (tagged-bag :coins
1233 (and (percentp 10) `(:sp ,(d 100)))
1234 (and (percentp 5) `(:ep ,(d 100)))
1235 (and (percentp 5) `(:gp ,(d 100)))
1236 (and (percentp 5) `(:pp ,(d 100))))
1237 (and (percentp 10) (gems (d 2)))
1238 (and (percentp 10) (gems (d 4)))
1239 (and (percentp 5) (special 1))
1240 (and (percentp 5) (magic t 1))))
1241
1242 ;; unguarded treasures
1243 ((unguarded-1)
1244 (bag (tagged-bag :coins
1245 `(:sp ,(* 100 (d 6)))
1246 (and (percentp 50) `(:gp ,(* 10 (d 6)))))
1247 (and (percentp 5) (gems (d 6)))
1248 (and (percentp 2) (jewellery (d 6)))
1249 (and (percentp 2) (magic t 1))))
1250 ((unguarded-2 unguarded-3)
1251 (bag (tagged-bag :coins
1252 `(:sp ,(* 100 (d 12)))
1253 (and (percentp 50) `(:gp ,(* 100 (d 6)))))
1254 (and (percentp 10) (gems (d 6)))
1255 (and (percentp 5) (jewellery (d 6)))
1256 (and (percentp 8) (magic t 1))))
1257 ((unguarded-4 unguarded-5)
1258 (bag (tagged-bag :coins
1259 `(:sp ,(* 1000 (d 6)))
1260 `(:gp ,(* 200 (d 6))))
1261 (and (percentp 20) (gems (d 8)))
1262 (and (percentp 10) (jewellery (d 8)))
1263 (and (percentp 10) (magic t 1))))
1264 ((unguarded-6 unguarded-7)
1265 (bag (tagged-bag :coins
1266 `(:sp ,(* 2000 (d 6)))
1267 `(:gp ,(* 500 (d 6))))
1268 (and (percentp 30) (gems (d 10)))
1269 (and (percentp 15) (jewellery (d 10)))
1270 (and (percentp 15) (magic t 1))))
1271 ((unguarded-8 unguarded-9)
1272 (bag (tagged-bag :coins
1273 `(:sp ,(* 5000 (d 6)))
1274 `(:gp ,(* 1000 (d 6))))
1275 (and (percentp 40) (gems (d 12)))
1276 (and (percentp 20) (jewellery (d 12)))
1277 (and (percentp 20) (magic t 1)))))))
Basic Dungeons & Dragons summary tables and charts.