(t (run tag key)))
finally (return *dnd-alist*))))
+(defun percentp (pc) (< (random 100) pc))
+
+(defun bag (&rest things)
+ (loop for i in things
+ when i collect i))
+
+(defun tagged-bag (tag &rest things)
+ (let ((bag (apply #'bag things)))
+ (and bag (cons tag bag))))
+
+(defun choose (&rest things)
+ (let ((n 0)
+ (it nil))
+ (do ((things things (cddr things)))
+ ((null things) it)
+ (let ((k (car things)))
+ (incf n k)
+ (when (and (plusp n) (< (random n) k))
+ (setf it (cadr things)))))))
+
+(defun choose-uniformly (&rest things)
+ (let ((n 0) (it nil))
+ (do ((things things (cdr things)))
+ ((null things) it)
+ (incf n)
+ (when (< (random n) 1)
+ (setf it (car things))))))
+
+(defmacro pick (&body clauses)
+ `(funcall (choose ,@(loop for (n . clause) in clauses
+ collect n
+ collect `(lambda () ,@clause)))))
+
+(defmacro pick-matching ((form &key) &body clauses)
+ (let ((formtemp (gensym "FORM")))
+ `(let ((,formtemp ,form))
+ (pick ,@(loop for (prob assertion . code) in clauses
+ collect `((if (assertion-match-p ,formtemp ',assertion)
+ ,prob
+ 0)
+ ,@code))))))
+
+(defconstant cleric-spells
+ #((cure-light-wounds detect-evil detect-magic light protection-from-evil
+ purify-food-and-water remove-fear resist-cold)
+ (bless find-traps hold-person resist-fire silence-15-ft-radius
+ slow-poison snake-charm speak-with-animal)
+ (continual-light cure-blindness cure-disease growth-of-animals
+ locate-object remove-curse speak-with-the-dead striking)
+ (animate-dead create-water cure-serious-wounds dispel-magic
+ neutralize-poison protection-from-evil-10-ft-radius speak-with-plants
+ sticks-to-snakes)
+ (commune create-food cure-critical-wounds dispel-evil insect-plague quest
+ raise-dead truesight)
+ (aerial-servant animate-objects barrier create-normal-animals cureall
+ find-the-path speak-with-monsters word-of-recall)
+ (earthquake holy-word raise-dead-fully restore survival travel wish
+ wizardry)))
+
+(defconstant druid-only-spells
+ #((detect-danger faerie-fire locate predict-weather)
+ (heat-metal obscure produce-fire warp-wood)
+ (call-lightning hold-animal protection-from-poison water-breathing)
+ (control-temperature-10-ft-radius plant-door protection-from-lightning
+ summon-animals)
+ (anti-plant-shell control-winds dissolve pass-plant)
+ (anti-animal-shell summon-weather transport-through-plants turn-wood)
+ (creeping-doom metal-to-wood summon-elemental weather-control)))
+
+(defconstant druid-spells
+ (make-array 7 :initial-contents (loop for cs across cleric-spells
+ for ds across druid-only-spells
+ collect (append cs ds))))
+
+(defconstant magic-user-spells
+ #((analyse charm-person detect-magic floating-disc hold-portal light
+ magic-missile protection-from-evil read-languages read-magic shield
+ sleep ventriloquism)
+ (continual-light detect-evil detect-invisible entangle esp invisibility
+ knock levitate locate-object mirror-image phantasmal-force web
+ wizard-lock)
+ (clairvoyance create-air dispel-magic fire-ball fly haste hold-person
+ infravision invisibility-10-ft-radius lightning-bolt
+ protection-from-evil-10-ft-radius protection-from-normal-missiles
+ water-breathing)
+ (charm-monster clothform confusion dimension-door growth-of-plants
+ hallucinatory-terrain ice-storm/wall massmorph polymorph-others
+ polymorph-self remove-curse wall-of-fire wizard-eye)
+ (animate-dead cloudkill conjure-elemental contact-outer-plane dissolve
+ feeblemind hold-monster magic-jar pass-wall telekinesis teleport
+ wall-of-stone woodform)
+ (anti-magic-shell death-spell disintegrate geas invisible-stalker
+ lower-water move-earth projected-image reincarnation stone-to-flesh
+ stoneform wall-of-iron weather-control)
+ (charm-plant create-normal-monsters delayed-blast-fire-ball ironform lore
+ magic-door mass-invisibility power-word-stun reverse-gravity statue
+ summon-object sword teleport-any-object)
+ (clone create-magical-monsters dance explosive-cloud force-field
+ mass-charm mind-barrier permanence polymorph-any-object power-word-blind
+ steelform symbol travel)
+ (contingency create-any-monster gate heal immunity maze meteor-swarm
+ power-word-kill prismatic-wall shapechange survival timestop wish)))
+
+(defun spell-caster-type (&optional (form :any))
+ (pick-matching (form)
+ (5 (:user (:cleric :druid :paladin)) :cleric)
+ (1 (:user :druid) :druid)
+ (14 (:user (:magic-user :elf :thief)) :magic-user)))
+
+(defun random-spell (&optional (caster (spell-caster-type))
+ (level (ecase caster
+ ((:magic-user) (choose 28 1
+ 21 2
+ 15 3
+ 11 4
+ 9 5
+ 7 6
+ 5 7
+ 3 8
+ 1 9))
+ ((:cleric :druid) (choose 34 1
+ 24 2
+ 18 3
+ 12 4
+ 7 5
+ 4 6
+ 1 7)))))
+ (let ((list (aref (ecase caster
+ ((:magic-user) magic-user-spells)
+ ((:cleric) cleric-spells)
+ ((:druid) druid-only-spells))
+ level)))
+ (values (elt list (random (length list)))
+ caster
+ level)))
+
+(let ((magic (list :magic)))
+ (defun assertion-match-p (form assertions)
+ (cond ((eq form :any) t)
+ ((eq form :none) nil)
+ ((atom form) (if (atom assertions)
+ (eql form assertions)
+ (member form assertions)))
+ (t (case (car form)
+ ((and) (every (lambda (f)
+ (assertion-match-p f assertions))
+ (cdr form)))
+ ((or) (some (lambda (f)
+ (assertion-match-p f assertions))
+ (cdr form)))
+ ((not) (not (assertion-match-p (cadr form) assertions)))
+ (t (let ((sub (getf assertions (car form) magic)))
+ (if (eq sub magic)
+ t
+ (assertion-match-p (cadr form) sub)))))))))
+
+(defun choose-distinct-items (n seq)
+ (let* ((copy (subseq (coerce seq 'vector) 0))
+ (len (length copy))
+ (list nil))
+ (dotimes (i n (sort list #'string<))
+ (let ((j (random len)))
+ (push (aref copy j) list)
+ (decf len)
+ (setf (aref copy j) (aref copy len))))))
+
+(defun magic-item (form)
+ (labels ((cursedp (&optional (prob 10))
+ (cond ((assertion-match-p form '(:cursed :unspecified))
+ (zerop (random prob)))
+ ((assertion-match-p form '(:cursed nil))
+ nil)
+ (t t)))
+ (potion (&key recursivep)
+ (pick-matching (form)
+ (2 (:cursed nil) `(:potion agility))
+ (1 (:cursed nil) `(:potion animal-control))
+ (3 (:cursed nil) `(:potion antidote))
+ (2 (:cursed nil) `(:potion blending))
+ (2 (:cursed nil) `(:potion bug-repellent))
+ (2 (:cursed nil) `(:potion clairaudience))
+ (2 (:cursed nil) `(:potion clairvoyance))
+ (2 (:cursed nil) `(:potion climbing))
+ (2 (:cursed nil) `(:potion defence :bonus ,(choose 3 1
+ 2 2
+ 2 3
+ 2 4
+ 1 5)))
+ ((if recursivep 0 4) (:cursed t)
+ (setf form :any)
+ `(:potion delusion
+ :fakes ,@(cdr (potion :recursivep t))))
+ (2 (:cursed nil) `(:potion diminution))
+ (1 (:cursed nil) `(:potion ,(choose 35 'white-dragon-control
+ 15 'crystal-dragon-control
+ 35 'black-dragon-control
+ 15 'onyx-dragon-control
+ 28 'green-dragon-control
+ 12 'jade-dragon-control
+ 21 'blue-dragon-control
+ 9 'sapphire-dragon-control
+ 14 'red-dragon-control
+ 6 'ruby-dragon-control
+ 7 'gold-dragon-control
+ 3 'amber-dragon-control)))
+ (2 (:cursed nil) `(:potion dreamspeech))
+ (1 (:cursed nil) `(:potion elasicity))
+ (2 (:cursed nil) `(:potion ,(choose-uniformly 'air-form
+ 'water-form
+ 'earth-form
+ 'fire-form)))
+ (2 (:cursed nil) `(:potion esp))
+ (1 (:cursed nil) `(:potion ethereality))
+ (3 (:cursed nil) `(:potion fire-resistance))
+ (3 (:cursed nil) `(:potion flying))
+ (2 (:cursed nil) `(:potion fortitude))
+ (1 (:cursed nil) `(:potion freedom))
+ (3 (:cursed nil) `(:potion gaseous-form))
+ (1 (:cursed nil) `(:potion ,(choose 5 'hill-giant-control
+ 5 'stone-giant-control
+ 4 'frost-giant-control
+ 2 'fire-giant-control
+ 1 'mountain-giant-control
+ 1 'sea-giant-control
+ 1 'cloud-giant-control
+ 1 'storm-giant-control)))
+ (3 (:cursed nil) `(:potion giant-strength))
+ (2 (:cursed nil) `(:potion growth))
+ (6 (:cursed nil) `(:potion healing))
+ (3 (:cursed nil) `(:potion heroism))
+ (1 (:cursed nil) `(:potion human-control))
+ (3 (:cursed nil) `(:potion invisibility))
+ (2 (:cursed nil) `(:potion invulnerability))
+ (2 (:cursed nil) `(:potion levitation))
+ (2 (:cursed nil) `(:potion longevity))
+ (1 (:cursed nil) `(:potion luck))
+ (1 (:cursed nil) `(:potion merging))
+ (2 (:cursed nil) `(:potion plant-control))
+ (3 (:cursed t) `(:potion poison))
+ (3 (:cursed nil) `(:potion polymorph-self))
+ (2 (:cursed nil) `(:potion sight))
+ (2 (:cursed nil) `(:potion speech))
+ (4 (:cursed nil) `(:potion speed))
+ (2 (:cursed nil) `(:potion strength))
+ (3 (:cursed nil) `(:potion super-healing))
+ (3 (:cursed nil) `(:potion swimming))
+ (1 (:cursed nil) `(:potion treasure-finding))
+ (1 (:cursed nil) `(:potion undead-control))
+ (2 (:cursed nil) `(:potion water-breathing))))
+ (scroll ()
+ (pick-matching (form)
+ (3 (:cursed nil) `(:scroll communication))
+ (2 (:cursed nil) `(:scroll creation))
+ (8 (:cursed t) `(:scroll curse))
+ (1 (:user (:cleric :druid :magic-user :elf :thief :paladin)
+ :cursed nil)
+ (multiple-value-bind
+ (spell caster level)
+ (random-spell (spell-caster-type form))
+ (declare (ignore level))
+ `(:scroll delay :caster ,caster :spells (,spell))))
+ (3 (:cursed nil)
+ `(:scroll equipment
+ :items ,(choose-distinct-items 6
+ '(grappling-hook
+ hammer
+ iron-spikes
+ lantern
+ mirror
+ wooden-pole
+ rope
+ saddle
+ backpack
+ saddle-bags
+ stakes-and-mallet
+ wolfsbane))))
+ (2 (:cursed nil) `(:scroll illumination))
+ (2 (:cursed nil :user (:magic-user :cleric :druid :elf))
+ `(:scroll mages))
+ (4 (:cursed nil) `(:map normal-treasure))
+ (3 (:cursed nil) `(:map magical-treasure))
+ (2 (:cursed nil) `(:map combined-treasure))
+ (1 (:cursed nil) `(:map special-treasure))
+ (3 (:cursed nil) `(:scroll mapping))
+ (2 (:cursed nil) `(:scroll portals))
+ (6 (:cursed nil) `(:scroll protection-from-elementals))
+ (8 (:cursed nil) `(:scroll protection-from-lycanthropes))
+ (4 (:cursed nil) `(:scroll protection-from-magic))
+ (7 (:cursed nil) `(:scroll protection-from-undead))
+ (2 (:cursed nil) `(:scroll questioning))
+ (1 (:cursed nil
+ :user (:cleric :druid :magic-user :elf :thief :paladin))
+ (multiple-value-bind
+ (spell caster level)
+ (random-spell (spell-caster-type form))
+ `(:scroll repetition
+ :caster ,caster
+ :level ,level
+ :spells (,spell))))
+ (2 (:cursed nil) `(:scroll seeing))
+ (2 (:cursed nil) `(:scroll shelter))
+ (3 (:cursed nil)
+ `(:scroll spell-catching :max-level ,(choose 4 1
+ 3 2
+ 2 3
+ 1 8)))
+ (25 (:cursed nil
+ :user (:cleric :druid :magic-user :elf :thief :paladin))
+ (let ((caster (spell-caster-type form))
+ (spells (choose 50 1 33 2 17 3)))
+ `(:scroll spell
+ :caster ,caster
+ :spells ,(loop repeat spells
+ collect (random-spell caster)))))
+ (2 (:cursed nil) `(:scroll trapping))
+ (2 (:cursed nil) `(:scroll truth))))
+ (wand-charges () (d 10 3))
+ (staff-charges () (d 20 2))
+ (wandlike ()
+ (pick-matching (form)
+ (5 (:user (:magic-user :elf))
+ `(:wand cold :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand enemy-detection :charges ,(wand-charges)))
+ (4 (:user (:magic-user :elf))
+ `(:wand fear :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand fireballs :charges ,(wand-charges)))
+ (4 (:user (:magic-user :elf))
+ `(:wand illusion :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand lightning-bolts :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand magic-detection :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand metal-detection :charges ,(wand-charges)))
+ (4 (:user (:magic-user :elf))
+ `(:wand negation :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand paralysation :charges ,(wand-charges)))
+ (5 (:user (:magic-user :elf))
+ `(:wand polymorphing :charges ,(wand-charges)))
+ (4 (:user (:magic-user :elf))
+ `(:wand secret-door-detection :charges ,(wand-charges)))
+ (4 (:user (:magic-user :elf))
+ `(:wand trap-detection :charges ,(wand-charges)))
+ (1 (:user (:magic-user :elf :cleric :druid :palatin))
+ `(:staff commanding :charges nil))
+ (2 nil
+ `(:staff dispelling :charges ,(staff-charges)))
+ (3 (:user :druid)
+ `(:staff druids :charges ,(staff-charges)))
+ (3 (:user (:magic-user :elf))
+ `(:staff ,(choose 19 'air
+ 19 'earth
+ 19 'fire
+ 19 'water
+ 6 'air-and-water
+ 6 'earth-and-fire
+ 2 'elemental-power)
+ :charges ,(staff-charges)))
+ (2 (:user (:cleric :druid :paladin))
+ `(:staff harming :charges ,(staff-charges)))
+ (7 (:user (:cleric :druid :paladin))
+ `(:staff healing :charges ,(staff-charges)))
+ (1 (:user (:cleric :druid :magic-user :elf :paladin))
+ `(:staff power :charges ,(staff-charges)))
+ (3 (:user (:cleric :druid :paladin))
+ `(:staff snake :charges ,(staff-charges)))
+ (3 (:user (:cleric :druid :magic-user :elf :paladin))
+ `(:staff striking :charges ,(staff-charges)))
+ (2 (:user (:cleric :druid :paladin))
+ `(:staff withering :charges ,(staff-charges)))
+ (1 (:user (:magic-user :elf))
+ `(:staff wizardry :charges ,(staff-charges)))
+ (2 nil `(:rod cancellation))
+ (1 nil `(:rod dominion))
+ (1 (:user (:cleric :druid :paladin)) `(:rod health))
+ (2 (:user (:dwarf :halfling :elf :fighter
+ :paladin :thief :mystic))
+ `(:rod inertia))
+ (1 nil `(:rod parrying))
+ (1 nil `(:rod victory))
+ (3 (:user (:dwarf :halfling :elf :fighter
+ :paladin :thief :mystic))
+ `(:rod weaponry))
+ (1 nil
+ `(:rod wyrm :colour ,(choose 5 'gold
+ 3 'blue
+ 2 'black)))))
+ (ring (&optional (recursivep nil))
+ (pick-matching (form)
+ (2 (:cursed nil) `(:ring animal-control))
+ ((if recursivep 0 6)
+ (:cursed t)
+ (setf form :any)
+ `(:ring delusion :fakes ,@(cdr (ring t))))
+ (1 (:cursed nil) `(:ring djinni-summoning))
+ (4 (:cursed nil) `(:ring ear))
+ (4 (:cursed nil) `(:ring ,(choose 19 'air-adaptation
+ 19 'earth-adaptation
+ 19 'fire-adaptation
+ 19 'water-adaptation
+ 6 'air-and-water-adaptation
+ 6 'earth-and-fire-adaptation
+ 2 'elemental-adaptation)))
+ (6 (:cursed nil) `(:ring fire-resistance))
+ (3 (:cursed nil :user (:cleric :druid :paladin))
+ `(:ring holiness))
+ (1 (:cursed nil) `(:ring human-control))
+ (5 (:cursed nil) `(:ring invisibility))
+ (3 (:cursed nil) `(:ring life-protection :charges ,(d 6)))
+ (3 (:cursed nil
+ :user (:cleric :druid :magic-user :elf :paladin))
+ `(:ring memory))
+ (2 (:cursed nil) `(:ring plant-control))
+ (1 (:cursed nil) `(:ring protection :bonus 1 :radius 5))
+ (10 (:cursed nil) `(:ring protection :bonus ,(choose 4 1
+ 3 2
+ 2 3
+ 1 4)))
+ (4 (:cursed nil) `(:ring quickness))
+ (1 (:cursed nil) `(:ring regeneration))
+ (3 (:cursed nil) `(:ring remedies))
+ (2 (:cursed nil) `(:ring safety :charges ,(d 4)))
+ (3 (:cursed nil) `(:ring seeing))
+ (3 (:cursed t) `(:ring spell-eating))
+ (2 (:cursed nil)
+ (let* ((caster (spell-caster-type))
+ (spells (loop repeat (d 6)
+ collect (random-spell caster))))
+ `(:ring spell-storing
+ :caster ,caster
+ :spells ,(remove-duplicates (sort spells
+ #'string<)))))
+ (2 (:cursed nil) `(:ring spell-turning))
+ (4 (:cursed nil) `(:ring survival :charges ,(+ 100 (d 100))))
+ (2 (:cursed nil) `(:ring telekinesis))
+ (4 (:cursed nil) `(:ring truth))
+ (3 (:cursed t) `(:ring truthfulness))
+ (2 (:cursed t) `(:ring truthlessness))
+ (5 (:cursed nil) `(:ring water-walking))
+ (5 (:cursed t) `(:ring weakness))
+ (2 (:cursed nil) `(:ring wishes :charges ,(choose 4 1
+ 3 2
+ 2 3
+ 1 4)))
+ (2 (:cursed nil) `(:ring x-ray-vision))))
+ (misc-item ()
+ (pick-matching (form)
+ (2 (:cursed nil)
+ `(:amulet protection-from-crystal-balls-and-esp))
+ (2 (:cursed t) `(:bag devouring))
+ (5 (:cursed nil) `(:bag holding))
+ (3 (:cursed nil) `(:boat undersea))
+ (2 (:cursed nil) `(:boots levitation))
+ (3 (:cursed nil) `(:boots speed))
+ (2 (:cursed nil) `(:boots travelling-and-leaping))
+ (1 (:cursed nil) `(:bowl commanding-water-elementals))
+ (1 (:cursed nil) `(:brazier commanding-fire-elementals))
+ (2 (:cursed nil) `(:broom flying))
+ (1 (:cursed nil) `(:censer controlling-air-elementals))
+ (3 (:cursed nil) `(:chime time))
+ (2 (:cursed nil :user (:magic-user :elf))
+ `(:crystal-ball normal))
+ (1 (:cursed nil :user (:magic-user :elf))
+ `(:crystal-ball clairaudience))
+ (1 (:cursed nil :user (:magic-user :elf))
+ `(:crystal-ball esp))
+ (2 (:cursed nil) `(:cloak displacer))
+ (1 (:cursed nil) `(:drums panic))
+ (1 (:cursed nil) `(:bottle efreeti))
+ (3 (:cursed nil) `(:egg ,(choose-uniformly 'rock-baboon
+ 'giant-bat
+ 'black-bear
+ 'grizzly-bear
+ 'boar
+ 'mountain-lion
+ 'panther
+ 'giant-ferret
+ 'gecko
+ 'draco
+ 'racer-snake
+ 'wolf)))
+ (2 (:cursed nil) `(:boots elven))
+ (2 (:cursed nil) `(:cloak elven))
+ (1 (:cursed nil) `(:carpet flying))
+ (2 (:cursed nil) `(:gauntlets ogre-power))
+ (2 (:cursed nil) `(:girdle giant-strength))
+ (2 (:cursed t)
+ `(:helm ,(choose-uniformly 'lawful-alignment
+ 'neutral-alignment
+ 'chaotic-alignment)))
+ (2 (:cursed nil) `(:helm reading))
+ (1 (:cursed nil) `(:helm telepathy))
+ (1 (:cursed nil) `(:helm teleportation))
+ (1 (:cursed nil) `(:horn blasting))
+ (2 (:cursed t) `(:lamp hurricane))
+ (3 (:cursed nil) `(:lamp long-burning))
+ (2 (:cursed nil) `(:medallion esp-30-ft-range))
+ (1 (:cursed nil) `(:medallion esp-90-ft-range))
+ (1 (:cursed nil) `(:mirror life-trapping))
+ ; fixme include contents
+ (3 (:cursed nil) `(:muzzle training))
+ (2 (:cursed nil) `(:nail finger))
+ (3 (:cursed nil) `(:nail pointing))
+ (5 nil `(:ointment ,(pick-matching (form)
+ (1 (:cursed nil) 'blessing)
+ (1 (:cursed nil) 'healing)
+ (1 (:cursed t) 'poison)
+ (1 (:cursed t) 'scarring)
+ (1 (:cursed nil) 'soothing)
+ (1 (:cursed t) 'tanning))))
+ (3 (:cursed nil) `(:pouch security))
+ (3 (:cursed nil :user (:cleric :druid :magic-user :elf))
+ `(:quill copying))
+ (4 (:cursed nil) `(:rope climbing))
+ (2 (:cursed nil) `(:scarab protection :charges ,(d 6 2)))
+ (3 (:cursed nil :user (:cleric :druid :magic-user :elf))
+ `(:slate identification))
+ (1 (:cursed nil) `(:stone controlling-earth-elementals))
+ (2 (:cursed nil)
+ `(:talisman ,(choose-uniformly 'air-travel
+ 'earth-travel
+ 'fire-travel
+ 'water-travel
+ 'elemental-travel)))
+ (3 (:cursed nil) `(:wheel floating))
+ (1 (:cursed nil) `(:wheel fortune))
+ (2 (:cursed nil) `(:wheel square))))
+ (weapon-bonus (class)
+ (loop for bonus from 1
+ for roll = (random 100) then (- roll item)
+ for item in (ecase class
+ ((a) '(40 27 17 10 6))
+ ((b) '(50 24 14 8 4))
+ ((c) '(60 21 11 6 2))
+ ((d) '(70 18 8 3 1)))
+ when (< roll item) return bonus))
+ (armour-size ()
+ (pick-matching (form)
+ (68 (:user (:cleric :fighter :paladin :druid :thief)) 'human)
+ (13 (:user :dwarf) 'dwarf)
+ (10 (:user :elf) 'elf)
+ (7 (:user :halfling) 'halfling)
+ (2 (:user nil) 'giant)))
+ (armour-piece (class)
+ (let* ((bonus (weapon-bonus class))
+ (power (and (percentp (* 5 (1+ bonus)))
+ (pick (7 `(absorption))
+ (10 `(charm))
+ (15 `(cure-wounds))
+ (10 `(electricity))
+ (5 `(energy-drain))
+ (3 `(ethereality))
+ (10 `(fly))
+ (6 `(gaseous-form))
+ (9 `(haste))
+ (10 `(invisibility))
+ (8 `(reflection))
+ (7 `(remove-curse :charges ,(d 3))))))
+ (cursedp (if (and power (eq (car power) 'remove-curse))
+ nil
+ (cursedp 8))))
+ `(:bonus ,bonus
+ ,@(and power (cons :power power))
+ :size ,(armour-size)
+ ,@(and cursedp `(:cursed t)))))
+ (armour ()
+ (pick-matching (form)
+ (10 (:user (:cleric :fighter :paladin :druid :thief
+ :dwarf :elf :halfling))
+ `((:armour leather ,@(armour-piece 'd))))
+ ( 7 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour scale-mail ,@(armour-piece 'd))))
+ (13 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour chain-mail ,@(armour-piece 'c))))
+ ( 9 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour banded-mail ,@(armour-piece 'd))))
+ (11 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour plate-mail ,@(armour-piece 'b))))
+ ( 5 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour suit ,@(armour-piece 'b))))
+ (20 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:shield ,@(armour-piece 'a))))
+ ( 2 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour scale-mail ,@(armour-piece 'd))
+ (:shield ,@(armour-piece 'a))))
+ ( 8 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour chain-mail ,@(armour-piece 'c))
+ (:shield ,@(armour-piece 'a))))
+ ( 5 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour banded-mail ,@(armour-piece 'd))
+ (:shield ,@(armour-piece 'a))))
+ (10 (:user (:cleric :fighter :paladin :dwarf :elf :halfling))
+ `((:armour plate-mail ,@(armour-piece 'b))
+ (:shield ,@(armour-piece 'a))))))
+ (opponent ()
+ (choose 6 'bugs
+ 3 'constructs
+ 6 'dragonkind
+ 9 'enchanted-monsters
+ 12 'giantkind
+ 12 'lycanthropes
+ 4 'planar-monsters
+ 6 'regenerating-monsters
+ 9 'reptiles-and-dinosaurs
+ 3 'spell-immune-monsters
+ 6 'spellcasters
+ 12 'undead
+ 6 'water-breathing-monsters
+ 6 'weapon-using-monsters))
+ (weapon-talent (&key missilep)
+ (pick (5 `(breathing))
+ (7 `(charming))
+ (4 `(deceiving))
+ ((if missilep 0 7) `(defending))
+ (2 `(deflecting))
+ (2 `(draining :charges ,(+ 4 (d 4))))
+ (5 `(extinguishing))
+ (6 `(finding))
+ (5 `(flaming))
+ (3 `(flying))
+ (8 `(healing))
+ (5 `(hiding))
+ (6 `(holding))
+ (8 `(lightning))
+ (6 `(silencing))
+ (2 `(slicing))
+ (4 `(slowing))
+ (4 `(speeding))
+ (5 `(translating))
+ (5 `(watching))
+ (1 `(wishing :charges ,(d 3)))))
+ (weapon-modifier (bonus &rest keys &key &allow-other-keys)
+ (and (percentp (aref #(40 30 20 15 10) (1- bonus)))
+ (pick (33 `(:extra (,(+ bonus 1) :against ,(opponent))))
+ (24 `(:extra (,(+ bonus 2) :against ,(opponent))))
+ (16 `(:extra (,(+ bonus 3) :against ,(opponent))))
+ (9 `(:extra (,(+ bonus 4) :against ,(opponent))))
+ (3 `(:extra (,(+ bonus 5) :against ,(opponent))))
+ (15 `(:talent ,@(apply #'weapon-talent keys))))))
+ (sword-modifier (bonus &rest keys &key &allow-other-keys)
+ (and (percentp (aref #(40 30 25 20 15) (1- bonus)))
+ (pick (29 `(:extra (,(+ bonus 1) :against ,(opponent))))
+ (21 `(:extra (,(+ bonus 2) :against ,(opponent))))
+ (14 `(:extra (,(+ bonus 3) :against ,(opponent))))
+ (8 `(:extra (,(+ bonus 4) :against ,(opponent))))
+ (3 `(:extra (,(+ bonus 5) :against ,(opponent))))
+ (25 `(:talent ,@(apply #'weapon-talent keys))))))
+ (missile ()
+ (multiple-value-bind
+ (item class)
+ (pick-matching (form)
+ (37 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :arrow 'a))
+ (22 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :quarrel 'a))
+ (11 (:user (:cleric :druid :thief :fighter :paladin
+ :mystic :dwarf :elf :halfling))
+ (values :sling-stone 'a))
+ (2 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :blowgun 'd))
+ (8 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :long-bow 'd))
+ (5 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :short-bow 'd))
+ (2 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :heavy-crossbow 'd))
+ (5 (:user (:thief :fighter :paladin :mystic
+ :dwarf :elf :halfling))
+ (values :light-crossbow 'd))
+ (8 (:user (:cleric :druid :thief :fighter :paladin
+ :mystic :dwarf :elf :halfling))
+ (values :sling 'd)))
+ (ecase class
+ ((a) (let* ((bonus (weapon-bonus 'a))
+ (cursedp (zerop (random 10)))
+ (talent (and (percentp (* 5 (- 7 bonus)))
+ (pick (4 'biting)
+ (5 'blinking)
+ (5 'charming)
+ (7 'climbing)
+ (10 'curing)
+ (3 'disarming)
+ (4 'dispelling)
+ (7 'flying)
+ (7 'lightning)
+ (5 'penetrating)
+ (4 'refilling)
+ (6 'screaming)
+ (5 'seeking)
+ (4 'sinking)
+ (2 `(slaying
+ :opponent ,(opponent)))
+ (7 'speaking)
+ (4 'stunning)
+ (2 'teleporting)
+ (5 'transporting)
+ (4 'wounding))))
+ (number (ecase bonus
+ ((1) (d 10 2))
+ ((2) (d 8 2))
+ ((3) (d 6 2))
+ ((4) (d 4 2))
+ ((5) (+ (d 4) 1)))))
+ `(,item :bonus ,bonus
+ ,@(and talent `(:talent ,talent))
+ :number ,number
+ ,@(and cursedp `(:cursed t)))))
+ ((d) (let* ((bonus (weapon-bonus 'd))
+ (cursedp (cursedp 10))
+ (modifier (weapon-modifier bonus :missilep t))
+ (range (ecase (+ bonus (d 4))
+ ((2 3 4) nil)
+ ((5 6 7) 1.5)
+ ((8 9) 2))))
+ `(,item :bonus ,bonus ,@modifier
+ ,@(and range `(:range ,range))
+ ,@(and cursedp `(:cursed t))))))))
+ (weapon-intelligence ()
+ (multiple-value-bind
+ (int langs prim read-magic-p extra)
+ (pick (79 (values nil 0 0 nil 0))
+ (6 (values 7 0 1 nil 0))
+ (5 (values 8 0 2 nil 0))
+ (4 (values 9 0 3 nil 0))
+ (3 (values 10 (d 3) 3 nil 0))
+ (2 (values 11 (d 6) 3 t 0))
+ (1 (values 12 (d 4 2) 3 t 1)))
+ (and int
+ (let ((powers nil)
+ (healing nil)
+ (damage nil)
+ (checklist nil))
+ (macrolet ((power-check (&rest forms)
+ `(pick ,@(loop for (tag n . form) in forms
+ if tag
+ collect
+ `((if (member ',tag
+ checklist)
+ 0
+ ,n)
+ (push ',tag checklist)
+ ,@(or form
+ `((push ',tag
+ powers))))
+ else
+ collect `(,n ,@form)))))
+ (labels ((primary-power ()
+ (power-check
+ (detect-evil 10)
+ (detect-gems 5)
+ (detect-magic 10)
+ (detect-metal 10)
+ (detect-shifting-walls-and-rooms 15)
+ (detect-sloping-passages 15)
+ (find-secret-doors 10)
+ (find-traps 10)
+ (see-invisible 10)
+ (:one-extra 4
+ (extraordinary-power))
+ (:two-primary 1
+ (primary-power)
+ (primary-power))))
+ (extraordinary-power ()
+ (power-check
+ (clairaudience 10)
+ (clairvoyance 10)
+ (esp 10)
+ (nil 5
+ (setf damage (if damage
+ (1+ damage)
+ 5)))
+ (flying 5)
+ (nil 5
+ (setf healing (+ (or healing 0) 6)))
+ (illusion 9)
+ (levitation 5)
+ (telekinesis 10)
+ (telepathy 10)
+ (teleportation 9)
+ (x-ray-vision 9)
+ (:two-three-extra 2
+ (extraordinary-power)
+ (extraordinary-power))
+ (:two-three-extra 1
+ (extraordinary-power)
+ (extraordinary-power)
+ (extraordinary-power)))))
+ (dotimes (i prim) (primary-power))
+ (dotimes (i extra) (extraordinary-power))))
+ (when damage
+ (push `(extra-damage ,damage) powers))
+ (when healing
+ (push `(healing ,healing) powers))
+ `(:intelligence ,int
+ :ego ,(d 12)
+ :languages ,langs
+ ,@(and read-magic-p `(:read-magic t))
+ :powers ,powers)))))
+ (sword ()
+ (multiple-value-bind
+ (type class)
+ (pick-matching (form)
+ (65 nil (values :normal-sword 'c))
+ (19 nil (values :short-sword 'c))
+ (8 (:user (:fighter :paladin :dwarf :mystic :elf))
+ (values :two-handed-sword 'd))
+ (8 (:user (:fighter :paladin :dwarf
+ :mystic :elf :halfling))
+ (values :bastard-sword 'd)))
+ (let* ((bonus (weapon-bonus class))
+ (cursedp (zerop (random 10)))
+ (modifier (sword-modifier bonus))
+ (intel (weapon-intelligence)))
+ `(,type :bonus ,bonus
+ ,@modifier
+ ,@intel
+ ,@(and cursedp `(:cursed t))))))
+ (weapon ()
+ (multiple-value-bind
+ (type returnsp intelpc class)
+ (pick-matching (form)
+ (7 (:user (:fighter :paladin :mystic :dwarf :elf))
+ (values :battle-axe nil 30 'd))
+ (8 (:user (:fighter :paladin :mystic :dwarf :thief
+ :elf :halfling))
+ (values :hand-axe (choose 3 nil 1 t) nil 'b))
+ (3 (:user (:fighter :paladin :mystic :dwarf :cleric
+ :elf :halfling))
+ (values :blackjack nil nil 'c))
+ (3 (:user (:fighter :paladin :mystic :dwarf :cleric
+ :thief :elf :halfling))
+ (values :bola (choose 2 nil 1 t) nil 'b))
+ (5 (:user (:fighter :paladin :mystic :dwarf
+ :thief :cleric :druid :elf :halfling))
+ (values :club nil nil 'c))
+ (14 (:user (:fighter :paladin :mystic :dwarf :magic-user
+ :thief :elf :halfling))
+ (values :dagger (choose 11 nil 3 t) 50 'b))
+ (4 (:user (:fighter :paladin :mystic :dwarf :cleric
+ :elf :halfling :thief))
+ (values :one-handed-flail nil nil 'c))
+ (2 (:user (:fighter :paladin :mystic :dwarf :cleric :elf))
+ (values :two-handed-flail nil nil 'd))
+ (3 (:user (:fighter :paladin :mystic :dwarf :elf))
+ (values :halberd nil 20 'd))
+ (8 (:user (:fighter :paladin :mystic :dwarf :cleric
+ :druid :elf :halfling :thief))
+ (values :war-hammer nil 30 'c))
+ (4 (:user (:fighter :paladin :mystic :dwarf :thief
+ :elf :halfling))
+ (values :javelin (choose 3 nil 1 t) nil 'b))
+ (4 (:user (:fighter :paladin :mystic :dwarf :elf))
+ (values :lance nil nil 'd))
+ (7 (:user (:fighter :paladin :mystic :dwarf :cleric :thief
+ :elf :halfling :druid))
+ (values :mace nil 35 'c))
+ (5 (:user (:fighter :paladin :mystic :dwarf :cleric :thief
+ :elf :halfling))
+ (values :morning-star nil nil 'c))
+ (3 (:user (:fighter :paladin :mystic :dwarf :cleric :thief
+ :druid :elf :halfling))
+ (values :net (choose 2 nil 1 t) nil 'b))
+ (3 (:user (:fighter :paladin :mystic :dwarf :elf))
+ (values :pike nil 20 'd))
+ (2 (:user (:fighter :paladin :mystic :dwarf :elf))
+ (values :pole-axe nil 20 'd))
+ (12 (:user (:fighter :paladin :mystic :dwarf :thief
+ :elf :halfling))
+ (values :spear (choose 3 nil 1 t) nil 'b))
+ (4 (:user (:fighter :paladin :mystic :dwarf :thief :cleric
+ :druid :elf :halfling :magic-user))
+ (values :staff nil 20 'd))
+ (3 (:user (:fighter :paladin :mystic :dwarf :thief :cleric
+ :druid :elf :halfling))
+ (values :whip nil nil 'c)))
+ (let* ((bonus (weapon-bonus class))
+ (cursedp (cursedp 10))
+ (modifier (sword-modifier bonus))
+ (intel (and intelpc
+ (percentp intelpc)
+ (weapon-intelligence))))
+ `(,type
+ ,@(and returnsp `(:returning t))
+ :bonus ,bonus
+ ,@modifier
+ ,@intel
+ ,@(and cursedp `(:cursed t)))))))
+ (pick-matching (form)
+ (25 (:type :potion) (list (potion)))
+ (12 (:type :scroll) (list (scroll)))
+ (9 (:type :wandlike :cursed nil) (list (wandlike)))
+ (6 (:type :ring) (list (ring)))
+ (10 (:type :misc) (list (misc-item)))
+ (10 (:type :armour
+ :user (:cleric :druid :fighter :paladin
+ :thief :dwarf :elf :halfling))
+ (armour))
+ (11 (:type :missile) (list (missile)))
+ (9 (:type :sword
+ :user (:fighter :paladin :mystic :thief :dwarf :elf :halfling))
+ (list (sword)))
+ (8 (:type :weapon) (list (weapon))))))
+
+(defun treasure-type (type-code)
+ (labels ((common-fur-type ()
+ (choose-uniformly 'beaver
+ 'fox
+ 'marten
+ 'seal))
+ (rare-fur-type ()
+ (choose-uniformly 'ermine
+ 'mink
+ 'sable))
+ (special (n)
+ (cons
+ :special
+ (loop repeat n
+ collect
+ (pick (10 `(:kind book
+ :value ,(* 10 (d 100))
+ :encumbrance ,(d 100)))
+ (2 `(:kind pelt
+ :animal ,(common-fur-type)
+ :value ,(d 4)
+ :encumbrance ,(* 10 (d 6))))
+ (5 `(:kind cape
+ :animal ,(common-fur-type)
+ :value ,(* 100 (d 6))
+ :encumbrance ,(* 10 (+ 4 (d 8)))))
+ (3 `(:kind coat
+ :animal ,(common-fur-type)
+ :value ,(* 100 (d 4 3))
+ :encumbrance ,(* 10 (+ 8 (d 6 2)))))
+ (2 `(:kind pelt
+ :animal ,(rare-fur-type)
+ :value ,(d 6 2)
+ :encumbrance ,(* 10 (d 6))))
+ (5 `(:kind cape
+ :animal ,(rare-fur-type)
+ :value ,(* 100 (d 6 4))
+ :encumbrance ,(* 10 (+ 4 (d 8)))))
+ (3 `(:kind coat
+ :animal ,(rare-fur-type)
+ :value ,(* 1000 (d 4))
+ :encumbrance ,(* 10 (+ 8 (d 6 2)))))
+ (5 `(:kind incense
+ :value ,(d 6 5)
+ :encumbrance 1
+ :quantity ,(d 4 2)))
+ (5 `(:kind perfume
+ :value ,(* 10 (+ 5 (d 10)))
+ :encumbrance 1
+ :quantity ,(d 3 2)))
+ (5 (let ((w (d 6)) (h (d 2)))
+ `(:kind ,(choose-uniformly 'rug
+ 'tapestry)
+ :value ,(* w h (d 10 2))
+ :encumbrance ,(* 100 w h (d 6))
+ :size (* ,w ,h))))
+ (10 (let ((w (d 8)) (h (d 2)))
+ `(:kind silk
+ :value ,(* w h (d 8))
+ :encumbrance ,(* 10 w h (d 6))
+ :size (* ,w ,h))))
+ (10 `(:kind animal-skin
+ :value ,(d 10)
+ :encumbrance ,(* 10 (d 4 5))))
+ (10 `(:kind monster-skin
+ :value ,(* 100 (d 10))
+ :encumbrance ,(* 50 (d 100))))
+ (5 (let ((enc (d 100)))
+ `(:kind spice
+ :value ,(* enc (d 4 4))
+ :encumbrance ,enc)))
+ (5 `(:kind statuette
+ :value ,(* 100 (d 10))
+ :encumbrance ,(d 100)))
+ (5 `(:wine
+ :value ,(d 6)
+ :encumbrance ,(* 10 (+ 3 (d 6)))
+ :bottles ,(d 12)))))))
+ (gem-type (&key (min-value 0) recursivep)
+ (pick ((if (<= min-value 10) 3 0)
+ (values 10 (choose-uniformly 'agate
+ 'quartz
+ 'turquoise)))
+ ((if (<= min-value 50) 7 0)
+ (values 50 (choose-uniformly 'crystal
+ 'jasper
+ 'onyx)))
+ ((if (<= min-value 100) 15 0)
+ (values 100 (choose-uniformly 'amber
+ 'amethyst
+ 'coral
+ 'garnet
+ 'jade)))
+ ((if (<= min-value 500) 21 0)
+ (values 500 (choose-uniformly 'aquamarine
+ 'pearl
+ 'topaz)))
+ ((if (<= min-value 1000) 25 0)
+ (values 1000 (choose-uniformly 'carbuncle
+ 'opal)))
+ ((if (<= min-value 5000) 19 0)
+ (values 5000 (choose-uniformly 'emerald
+ 'ruby
+ 'sapphire)))
+ ((if (<= min-value 10000) 7 0)
+ (values 10000 'diamond 'jacinth))
+ ((if (<= min-value 1000) 1 0)
+ (values (* 1000 (d 100))
+ 'tristal))
+ ((if (and (not recursivep)
+ (<= min-value 2000)) 2 0)
+ (multiple-value-bind
+ (value kind)
+ (gem-type :min-value (max 1000
+ (ceiling min-value 2))
+ :recursivep t)
+ (values (* 2 value)
+ (intern (format nil "STAR-~A"
+ (string kind))))))))
+ (gems (n)
+ (cons
+ :gems
+ (loop while (plusp n)
+ for i = (min n (d 5))
+ do (decf n i)
+ collect
+ (let ((mods (choose 4 :size 4 :qual 2 :both))
+ (mod-list nil))
+ (multiple-value-bind
+ (value kind)
+ (gem-type)
+ (when (or (eq mods :size)
+ (eq mods :both))
+ (multiple-value-bind
+ (mod mult)
+ (pick (1 (values 'very-small 1/8))
+ (2 (values 'small 1/4))
+ (2 (values 'fairly-small 1/2))
+ (2 (values 'fairly-large 2))
+ (2 (values 'large 4))
+ (1 (values 'very-small 8)))
+ (setf mod-list
+ (append `(:size ,mod) mod-list))
+ (setf value (* value mult))))
+ (when (or (eq mods :qual)
+ (eq mods :both))
+ (multiple-value-bind
+ (mod mult)
+ (pick (1 (values 'very-poor 1/8))
+ (2 (values 'poor 1/4))
+ (2 (values 'fairly-poor 1/2))
+ (2 (values 'fairly-good 2))
+ (2 (values 'good 4))
+ (1 (values 'very-good 8)))
+ (setf mod-list
+ (append `(:quality ,mod) mod-list))
+ (setf value (* value mult))))
+ `(:kind ,kind
+ :value ,(max 1 (round value))
+ ,@mod-list
+ ,@(and (> i 1) `(:quantity ,i))))))))
+ (jewellery (n)
+ (cons
+ :jewellery
+ (loop while (plusp n)
+ for i = (min n (d 5))
+ do (decf n i)
+ collect
+ (multiple-value-bind
+ (value enc class)
+ (pick ( 1 (values 100 10 'a))
+ ( 2 (values 500 10 'a))
+ ( 3 (values 1000 10 'a))
+ ( 4 (values 1500 10 'a))
+ ( 5 (values 2000 10 'a))
+ ( 8 (values 2500 10 'a))
+ (10 (values 3000 25 'a))
+ (11 (values 4000 25 'b))
+ (13 (values 5000 25 'b))
+ (11 (values 7500 25 'b))
+ ( 9 (values 10000 25 'b))
+ ( 7 (values 15000 25 'c))
+ ( 5 (values 20000 50 'c))
+ ( 4 (values 25000 50 'c))
+ ( 3 (values 30000 50 'c))
+ ( 2 (values 40000 50 'c))
+ ( 1 (values 50000 50 'c)))
+ (let ((kind (ecase class
+ ((a) (choose-uniformly 'anklet
+ 'beads
+ 'bracelet
+ 'brooch
+ 'buckle
+ 'cameo
+ 'chain
+ 'clasp
+ 'locket
+ 'pin))
+ ((b) (choose-uniformly 'armband
+ 'belt
+ 'collar
+ 'earring
+ 'four-leaf-clover
+ 'heart
+ 'leaf
+ 'necklace
+ 'pendant
+ 'rabbit-foot))
+ ((c) (choose-uniformly 'amulet
+ 'crown
+ 'diadem
+ 'medallion
+ 'orb
+ 'ring
+ 'scarab
+ 'sceptre
+ 'talisman
+ 'tiara)))))
+ `(:kind ,kind
+ :value ,value
+ :encumbrance ,enc
+ ,@(and (> i 1) `(:quantity ,i))))))))
+ (magic (&rest forms)
+ (cons :magic
+ (loop with list = nil
+ for (form n) on forms by #'cddr do
+ (loop repeat n do
+ (dolist (item (magic-item (list :type form)))
+ (push item list)))
+ finally (return list)))))
+ (ecase type-code
+
+ ;; treasure in lair
+ ((a) (bag (tagged-bag :coins
+ (and (percentp 25) `(:cp ,(* 1000 (d 6))))
+ (and (percentp 30) `(:sp ,(* 1000 (d 6))))
+ (and (percentp 20) `(:ep ,(* 1000 (d 4))))
+ (and (percentp 35) `(:gp ,(* 1000 (d 6 2))))
+ (and (percentp 25) `(:pp ,(* 1000 (d 2)))))
+ (and (percentp 50) (gems (d 6 6)))
+ (and (percentp 50) (jewellery (d 6 6)))
+ (and (percentp 10) (special (d 2)))
+ (and (percentp 30) (magic :any 3))))
+ ((b) (bag (tagged-bag :coins
+ (and (percentp 50) `(:cp ,(* 1000 (d 8))))
+ (and (percentp 25) `(:sp ,(* 1000 (d 6))))
+ (and (percentp 25) `(:ep ,(* 1000 (d 4))))
+ (and (percentp 35) `(:gp ,(* 1000 (d 3)))))
+ (and (percentp 25) (gems (d 6)))
+ (and (percentp 25) (jewellery (d 6)))
+ (and (percentp 10)
+ (magic '(or :armour :missile :sword :weapon) 1))))
+ ((c) (bag (tagged-bag :coins
+ (and (percentp 20) `(:cp ,(* 1000 (d 12))))
+ (and (percentp 30) `(:sp ,(* 1000 (d 4))))
+ (and (percentp 10) `(:ep ,(* 1000 (d 4)))))
+ (and (percentp 50) (gems (d 6 6)))
+ (and (percentp 50) (jewellery (d 6 6)))
+ (and (percentp 5) (special (d 2)))
+ (and (percentp 10) (magic :any 2))))
+ ((d) (bag (tagged-bag :coins
+ (and (percentp 10) `(:cp ,(* 1000 (d 8))))
+ (and (percentp 15) `(:sp ,(* 1000 (d 12))))
+ (and (percentp 60) `(:gp ,(* 1000 (d 6)))))
+ (and (percentp 30) (gems (d 8)))
+ (and (percentp 30) (jewellery (d 8)))
+ (and (percentp 10) (special (d 2)))
+ (and (percentp 10) (magic :any 1 :potion 1))))
+ ((e) (bag (tagged-bag :coins
+ (and (percentp 5) `(:cp ,(* 1000 (d 10))))
+ (and (percentp 30) `(:sp ,(* 1000 (d 12))))
+ (and (percentp 25) `(:ep ,(* 1000 (d 4))))
+ (and (percentp 25) `(:gp ,(* 1000 (d 8)))))
+ (and (percentp 10) (gems (d 10)))
+ (and (percentp 10) (jewellery (d 10)))
+ (and (percentp 15) (special (d 2)))
+ (and (percentp 25) (magic :any 3 :scroll 1))))
+ ((f) (bag (tagged-bag :coins
+ (and (percentp 30) `(:sp ,(* 1000 (d 10 2))))
+ (and (percentp 20) `(:ep ,(* 1000 (d 8))))
+ (and (percentp 45) `(:gp ,(* 1000 (d 12))))
+ (and (percentp 30) `(:pp ,(* 1000 (d 3)))))
+ (and (percentp 20) (gems (d 12 2)))
+ (and (percentp 10) (jewellery (d 12)))
+ (and (percentp 20) (special (d 3)))
+ (and (percentp 30) (magic :potion 1 :scroll 1
+ '(not :armour :missile
+ :sword :weapon) 3))))
+ ((g) (bag (tagged-bag :coins
+ (and (percentp 50) `(:gp ,(* 10000 (d 4))))
+ (and (percentp 50) `(:pp ,(* 1000 (d 6)))))
+ (and (percentp 25) (gems (d 6 3)))
+ (and (percentp 25) (jewellery (d 10)))
+ (and (percentp 30) (special (d 3)))
+ (and (percentp 35) (magic :any 4 :scroll 1))))
+ ((h) (bag (tagged-bag :coins
+ (and (percentp 25) `(:cp ,(* 1000 (d 8 3))))
+ (and (percentp 50) `(:sp ,(* 1000 (d 100))))
+ (and (percentp 50) `(:ep ,(* 10000 (d 4))))
+ (and (percentp 50) `(:gp ,(* 10000 (d 6))))
+ (and (percentp 25) `(:pp ,(* 1000 (d 4 5)))))
+ (and (percentp 50) (gems (d 100)))
+ (and (percentp 50) (jewellery (* 10 (d 4))))
+ (and (percentp 10) (special (d 2)))
+ (and (percentp 15) (magic :any 4 :potion 1 :scroll 1))))
+ ((i) (bag (tagged-bag :coins
+ (and (percentp 30) `(:pp ,(* 1000 (d 8)))))
+ (and (percentp 50) (gems (d 6 2)))
+ (and (percentp 50) (jewellery (d 6 2)))
+ (and (percentp 5) (special (d 2)))
+ (and (percentp 15) (magic :any 1))))
+ ((j) (bag (tagged-bag :coins
+ (and (percentp 25) `(:cp ,(* 1000 (d 4))))
+ (and (percentp 10) `(:sp ,(* 1000 (d 3)))))))
+ ((k) (bag (tagged-bag :coins
+ (and (percentp 30) `(:sp ,(* 1000 (d 6))))
+ (and (percentp 10) `(:ep ,(* 1000 (d 2)))))))
+ ((l) (bag (and (percentp 50) (gems (d 4)))))
+ ((m) (bag (and (percentp 55) (gems (d 4)))
+ (and (percentp 45) (jewellery (d 6 2)))))
+ ((n) (bag (and (percentp 10) (special (d 2)))
+ (and (percentp 40) (magic :potion (d 4 2)))))
+ ((o) (bag (and (percentp 10) (special (d 3)))
+ (and (percentp 50) (magic :scroll (d 4)))))
+
+ ;; treasure carried
+ ((p) (bag (tagged-bag :coins `(:cp ,(d 8 3)))))
+ ((q) (bag (tagged-bag :coins `(:sp ,(d 6 3)))))
+ ((r) (bag (tagged-bag :coins `(:ep ,(d 6 2)))))
+ ((s) (bag (tagged-bag :coins `(:gp ,(d 4 2)))
+ (and (percentp 5) (gems 1))))
+ ((t) (bag (tagged-bag :coins `(:pp ,(d 6 1)))
+ (and (percentp 5) (gems 1))))
+ ((u) (bag (tagged-bag :coins
+ (and (percentp 10) `(:cp ,(d 100)))
+ (and (percentp 10) `(:sp ,(d 100)))
+ (and (percentp 5) `(:gp ,(d 100))))
+ (and (percentp 5) (gems (d 2)))
+ (and (percentp 5) (gems (d 4)))
+ (and (percentp 2) (special 1))
+ (and (percentp 2) (magic :any 1))))
+ ((v) (bag (tagged-bag :coins
+ (and (percentp 10) `(:sp ,(d 100)))
+ (and (percentp 5) `(:ep ,(d 100)))
+ (and (percentp 5) `(:gp ,(d 100)))
+ (and (percentp 5) `(:pp ,(d 100))))
+ (and (percentp 10) (gems (d 2)))
+ (and (percentp 10) (gems (d 4)))
+ (and (percentp 5) (special 1))
+ (and (percentp 5) (magic :any 1))))
+
+ ;; unguarded treasures
+ ((unguarded-1)
+ (bag (tagged-bag :coins
+ `(:sp ,(* 100 (d 6)))
+ (and (percentp 50) `(:gp ,(* 10 (d 6)))))
+ (and (percentp 5) (gems (d 6)))
+ (and (percentp 2) (jewellery (d 6)))
+ (and (percentp 2) (magic :any 1))))
+ ((unguarded-2 unguarded-3)
+ (bag (tagged-bag :coins
+ `(:sp ,(* 100 (d 12)))
+ (and (percentp 50) `(:gp ,(* 100 (d 6)))))
+ (and (percentp 10) (gems (d 6)))
+ (and (percentp 5) (jewellery (d 6)))
+ (and (percentp 8) (magic :any 1))))
+ ((unguarded-4 unguarded-5)
+ (bag (tagged-bag :coins
+ `(:sp ,(* 1000 (d 6)))
+ `(:gp ,(* 200 (d 6))))
+ (and (percentp 20) (gems (d 8)))
+ (and (percentp 10) (jewellery (d 8)))
+ (and (percentp 10) (magic :any 1))))
+ ((unguarded-6 unguarded-7)
+ (bag (tagged-bag :coins
+ `(:sp ,(* 2000 (d 6)))
+ `(:gp ,(* 500 (d 6))))
+ (and (percentp 30) (gems (d 10)))
+ (and (percentp 15) (jewellery (d 10)))
+ (and (percentp 15) (magic :any 1))))
+ ((unguarded-8 unguarded-9)
+ (bag (tagged-bag :coins
+ `(:sp ,(* 5000 (d 6)))
+ `(:gp ,(* 1000 (d 6))))
+ (and (percentp 40) (gems (d 12)))
+ (and (percentp 20) (jewellery (d 12)))
+ (and (percentp 20) (magic :any 1)))))))
+
+(defconstant combine-treasures
+ '((:coins (t . +))
+ (t . append)))
+
+(defun combine2 (spec a b)
+ (labels ((comb (tag x y)
+ (dolist (pair spec)
+ (let ((label (car pair)))
+ (when (or (eq label t)
+ (eq label tag))
+ (return-from comb
+ (let ((method (cdr pair)))
+ (etypecase method
+ (list (combine2 method x y))
+ ((member +) (list (+ (car x) (car y))))
+ ((or symbol function)
+ (funcall method x y))))))))
+ (error "No combiner found for ~S." tag)))
+ (let ((list nil))
+ (dolist (pair a)
+ (let* ((tag (car pair))
+ (match (assoc tag b)))
+ (push (if (null match)
+ pair
+ (cons tag
+ (comb tag (cdr pair) (cdr match))))
+ list)))
+ (dolist (pair b)
+ (let* ((tag (car pair))
+ (match (assoc tag a)))
+ (unless match
+ (push pair list))))
+ (nreverse list))))
+
+(defun combine (spec &rest lists)
+ (reduce (lambda (x y) (combine2 spec x y)) lists))
+
+(defun treasure (types)
+ (apply #'combine
+ combine-treasures
+ (loop for type in types
+ collect (treasure-type type))))
+
+(defun select-spells (table spells)
+ (loop for n in spells
+ for list across table
+ collect (sort (loop repeat n collect (apply #'choose-uniformly list))
+ #'string<)))
~mdw / dnd / blobdiff