X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/dnd/blobdiff_plain/46d528a43a45b39de9c77565338274943dbff51c..ac6c07c4feeaea33c25b4696bbcb6b27e594624c:/dice.lisp

diff --git a/dice.lisp b/dice.lisp
index 547ecd2..3f17c62 100644
--- a/dice.lisp
+++ b/dice.lisp
@@ -150,3 +150,1350 @@ (defun apply-template (def tpl)
 	    (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)))))
+
+(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))))))
+
+(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))))))
+
+(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)))
+					  (choose 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
+						  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<)))