;;;

(defun d (n &optional (k 1) &key (bias 0) best worst)
  (let ((rolls (sort (loop repeat k
			   collect (1+ (max 0 (min (1- n)
						   (+ (random n) bias)))))
		     #'<)))
    (reduce #'+ (cond (best (subseq rolls (- k best)))
		      (worst (subseq rolls 0 worst))
		      (t rolls)))))

(defvar *dnd-alist* nil)

(defun do-lookup (name default defaultp)
  (let ((item (assoc name *dnd-alist*)))
    (cond (item (cdr item))
	  (defaultp default)
	  (t (error "Missing required item ~S." name)))))

(defun lookup-list (name &optional (default nil defaultp))
  (do-lookup name default defaultp))

(defun lookup (name &optional (default nil defaultp))
  (car (do-lookup name (list default) defaultp)))

(defun hp-from-hd (&optional (hd (lookup-list :hit-dice)))
  (destructuring-bind (dice &key (plus 0) (stars 0)) hd
    (declare (ignore stars))
    (+ (cond ((zerop dice) 0)
	     ((= dice 1/8) 1)
	     ((= dice 1/4) (d 2))
	     ((= dice 1/2) (d 4))
	     ((and (integerp dice) (plusp dice)) (d 8 dice))
	     (t (error "Bad hit dice ~S." hd)))
       plus)))

(defun hd-table-lookup (hd table)
  (flet ((hd<= (a b)
	   (let ((aa (if (consp a) (car a) a))
		 (bb (if (consp b) (car b) b)))
	     (or (< aa bb)
		 (and (= aa bb)
		      (or (consp a)
			  (not (consp b))))))))
    (loop for ((lo . hi) . rest) in table
	  when (and (hd<= lo hd)
		    (hd<= hd hi))
	  return rest
	  finally (return nil))))

(let ((xp-table '(((  0    . (0 +))    5     1)
		  ((  1    .  1)      10     3)
		  ((( 1 +) . (1 +))   15     4)
		  ((  2    .  2)      20     5)
		  ((( 2 +) . (2 +))   25    10)
		  ((  3    .  3)      30    15)
		  ((( 3 +) . (3 +))   50    25)
		  ((  4    .  4)      75    50)
		  ((( 4 +) . (4 +))  125    75)
		  ((  5    .  5)     175   125)
		  ((( 5 +) . (5 +))  225   175)
		  ((  6    .  6)     275   225)
		  ((( 6 +) . (6 +))  350   300)
		  ((  7    .  7)     450   400)
		  ((( 7 +) . (7 +))  550   475)
		  ((  8    .  8)     650   550)
		  ((( 8 +) . (8 +))  775   625)
		  ((  9    .  9)     900   700)
		  ((( 9 +) . 10)    1000   750)
		  (((10 +) . 11)    1100   800)
		  (((11 +) . 12)    1250   875)
		  (((12 +) . 13)    1350   950)
		  (((13 +) . 14)    1500  1000)
		  (((14 +) . 15)    1650  1050)
		  (((15 +) . 16)    1850  1100)
		  (((16 +) . 17)    2000  1150)
		  (((17 +) . 18)    2125  1350)
		  (((18 +) . 19)    2250  1550)
		  (((19 +) . 20)    2375  1800)
		  (((20 +) . 21)    2500  2000))))
  (defun xp-from-hd (&optional (hd (lookup-list :hit-dice)))
    (destructuring-bind (dice &key (plus 0) (stars 0)) hd
      (multiple-value-bind (hd-base hd-plus)
	  (cond ((zerop plus) (values dice 0))
		((plusp plus) (values dice 1))
		((minusp plus) (values (1- dice) 1)))
	(let ((result (hd-table-lookup (if (zerop hd-plus)
					   hd-base
					   (list hd-base '+))
				     xp-table)))
	  (if result
	      (destructuring-bind (base bonus) result
		(+ base (* stars bonus)))
	      (let ((steps (+ hd-base -21 hd-plus)))
		(+ 2500
		   (* 250 steps)
		   (* (+ 2000 (* 250 steps)) stars)))))))))

(let ((thac0-table '(((  0      .   1) . 19)
		     ((( 1 . +) .   2) . 18)
		     ((( 2 . +) .   3) . 17)
		     ((( 3 . +) .   4) . 16)
		     ((( 4 . +) .   5) . 15)
		     ((( 5 . +) .   6) . 14)
		     ((( 6 . +) .   7) . 13)
		     ((( 7 . +) .   8) . 12)
		     ((( 8 . +) .   9) . 11)
		     ((( 9 . +) .  11) . 10)
		     (((11 . +) .  13) .  9)
		     (((13 . +) .  15) .  8)
		     (((15 . +) .  17) .  7)
		     (((17 . +) .  19) .  6)
		     (((19 . +) .  21) .  5)
		     (((21 . +) .  23) .  4)
		     (((23 . +) .  25) .  3)
		     (((25 . +) .  27) .  2)
		     (((27 . +) .  29) .  1)
		     (((29 . +) .  31) .  0)
		     (((31 . +) .  33) . -1)
		     (((33 . +) .  35) . -2))))
  (defun thac0-from-hd (&optional (hd (lookup-list :hit-dice)))
    (destructuring-bind (dice &key (plus 0) (stars 0)) hd
      (declare (ignore stars))
      (multiple-value-bind (hd-base hd-plus)
	  (cond ((zerop plus) (values dice 0))
		((plusp plus) (values dice 1))
		((minusp plus) (values (1- dice) 1)))
	(or (hd-table-lookup (if (zerop hd-plus)
				 hd-base
				 (list hd-base '+))
			     thac0-table)
	    -3)))))

(defparameter monster-template
  `((:hit-dice :required)
    (:thac0 :list ,#'thac0-from-hd)
    (:hit-points :list ,#'hp-from-hd)
    (:experience-points :list ,#'xp-from-hd)))

(defun apply-template (def tpl)
  (flet ((run (tag func)
	   (unless (assoc tag *dnd-alist*)
	     (push (cons tag (funcall func)) *dnd-alist*))))
    (loop with *dnd-alist* = def
	  for (tag key . tail) in tpl do
	  (case key
	    (:required (lookup-list tag))
	    (:eval (run tag (car tail)))
	    (:list (run tag (lambda () (list (funcall (car tail))))))
	    (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 (&rest clauses)
  `(funcall (choose ,@(loop for (n . clause) in clauses
			   collect n
			   collect `(lambda () ,@clause)))))

(defconstant druid-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 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 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 ()
  (choose 25 :cleric 5 :druid 70 :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-spells))
		    level)))
    (values (elt list (random (length list)))
	    caster
	    level)))

(defun symbol-match-p (form sym)
  (cond ((eq form t) t)
	((eq form nil) nil)
	((eq form sym) t)
	((atom form) nil)
	(t (ecase (car form)
	     ((and) (every (lambda (f) (symbol-match-p f sym)) (cdr form)))
	     ((or) (some (lambda (f) (symbol-match-p f sym)) (cdr form)))
	     ((not) (not (symbol-match-p (cadr form) sym)))))))

(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 ((potion (&key recursivep)
	     (pick (2 `(:potion agility))
		   (1 `(:potion animal-control))
		   (3 `(:potion antidote))
		   (2 `(:potion blending))
		   (2 `(:potion bug-repellent))
		   (2 `(:potion clairaudience))
		   (2 `(:potion clairvoyance))
		   (2 `(:potion climbing))
		   (2 `(:potion defence :bonus ,(choose 3 1
							 2 2
							 2 3
							 2 4
							 1 5)))
		   ((if recursivep 0 4)
		    `(:potion delusion
		      :fakes ,@(cdr (potion :recursivep t))))
		   (2 `(:potion diminution))
		   (1 `(: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 `(:potion dreamspeech))
		   (1 `(:potion elasicity))
		   (2 `(:potion ,(choose-uniformly 'air-form
						   'water-form
						   'earth-form
						   'fire-form)))
		   (2 `(:potion esp))
		   (1 `(:potion ethereality))
		   (3 `(:potion fire-resistance))
		   (3 `(:potion flying))
		   (2 `(:potion fortitude))
		   (1 `(:potion freedom))
		   (3 `(:potion gaseous-form))
		   (1 `(: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 `(:potion giant-strength))
		   (2 `(:potion growth))
		   (6 `(:potion healing))
		   (3 `(:potion heroism))
		   (1 `(:potion human-control))
		   (3 `(:potion invisibility))
		   (2 `(:potion invulnerability))
		   (2 `(:potion levitation))
		   (2 `(:potion longevity))
		   (1 `(:potion luck))
		   (1 `(:potion merging))
		   (2 `(:potion plant-control))
		   (3 `(:potion poison))
		   (3 `(:potion polymorph-self))
		   (2 `(:potion sight))
		   (2 `(:potion speech))
		   (4 `(:potion speed))
		   (2 `(:potion strength))
		   (3 `(:potion super-healing))
		   (3 `(:potion swimming))
		   (1 `(:potion treasure-finding))
		   (1 `(:potion undead-control))
		   (2 `(:potion water-breathing))))
	   (scroll ()
	     (pick (3 `(:scroll communication))
		   (2 `(:scroll creation))
		   (8 `(:scroll curse))
		   (1 (multiple-value-bind
			  (spell caster level)
			  (random-spell)
			(declare (ignore level))
			`(:scroll delay :caster ,caster :spells (,spell))))
		   (3 `(: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 `(:scroll illumination))
		   (2 `(:scroll mages))
		   (4 `(:map normal-treasure))
		   (3 `(:map magical-treasure))
		   (2 `(:map combined-treasure))
		   (1 `(:map special-treasure))
		   (3 `(:scroll mapping))
		   (2 `(:scroll portals))
		   (6 `(:scroll protection-from-elementals))
		   (8 `(:scroll protection-from-lycanthropes))
		   (4 `(:scroll protection-from-magic))
		   (7 `(:scroll protection-from-undead))
		   (2 `(:scroll questioning))
		   (1 (multiple-value-bind
			  (spell caster level)
			  (random-spell)
			`(:scroll repetition
			  :caster ,caster
			  :level ,level
			  :spells (,spell))))
		   (2 `(:scroll seeing))
		   (2 `(:scroll shelter))
		   (3 `(:scroll spell-catching :max-level ,(choose 4 1
								   3 2
								   2 3
								   1 8)))
		   (25 (let ((caster (spell-caster-type))
			     (spells (choose 50 1  33 2  17 3)))
			 `(:scroll spell
			   :caster ,caster
			   :spells ,(loop repeat spells
					  collect (random-spell caster)))))
		   (2 `(:scroll trapping))
		   (2 `(:scroll truth))))
	   (wand-charges () (d 10 3))
	   (staff-charges () (d 20 2))
	   (wandlike ()
	     (pick (5 `(:wand cold :charges ,(wand-charges)))
		   (5 `(:wand enemy-detection :charges ,(wand-charges)))
		   (4 `(:wand fear :charges ,(wand-charges)))
		   (5 `(:wand fireballs :charges ,(wand-charges)))
		   (4 `(:wand illusion :charges ,(wand-charges)))
		   (5 `(:wand lightning-bolts :charges ,(wand-charges)))
		   (5 `(:wand magic-detection :charges ,(wand-charges)))
		   (5 `(:wand metal-detection :charges ,(wand-charges)))
		   (4 `(:wand negation :charges ,(wand-charges)))
		   (5 `(:wand paralysation :charges ,(wand-charges)))
		   (5 `(:wand polymorphing :charges ,(wand-charges)))
		   (4 `(:wand secret-door-detection
			:charges ,(wand-charges)))
		   (4 `(:wand trap-detection :charges ,(wand-charges)))
		   (1 `(:staff commanding :charges nil))
		   (2 `(:staff dispelling :charges ,(staff-charges)))
		   (3 `(:staff druids :charges ,(staff-charges)))
		   (3 `(: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 `(:staff harming :charges ,(staff-charges)))
		   (7 `(:staff healing :charges ,(staff-charges)))
		   (1 `(:staff power :charges ,(staff-charges)))
		   (3 `(:staff snake :charges ,(staff-charges)))
		   (3 `(:staff striking :charges ,(staff-charges)))
		   (2 `(:staff withering :charges ,(staff-charges)))
		   (1 `(:staff wizardry :charges ,(staff-charges)))
		   (2 `(:rod cancellation))
		   (1 `(:rod dominion))
		   (1 `(:rod health))
		   (2 `(:rod inertia))
		   (1 `(:rod parrying))
		   (1 `(:rod victory))
		   (3 `(:rod weaponry))
		   (1 `(:rod wyrm :colour ,(choose 5 'gold
						   3 'blue
						   2 'black)))))
	   (ring ()
	     (pick (2 `(:ring animal-control))
		   (6 `(:ring delusion))
		   (1 `(:ring djinni-summoning))
		   (4 `(:ring ear))
		   (4 `(: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 `(:ring fire-resistance))
		   (3 `(:ring holiness))
		   (1 `(:ring human-control))
		   (5 `(:ring invisibility))
		   (3 `(:ring life-protection :charges ,(d 6)))
		   (3 `(:ring memory))
		   (2 `(:ring plant-control))
		   (1 `(:ring protection :bonus 1 :radius 5))
		   (10 `(:ring protection :bonus ,(choose 4 1
							  3 2
							  2 3
							  1 4)))
		   (4 `(:ring quickness))
		   (1 `(:ring regeneration))
		   (3 `(:ring remedies))
		   (2 `(:ring safety :charges ,(d 4)))
		   (3 `(:ring seeing))
		   (3 `(:ring spell-eating))
		   (2 (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 `(:ring spell-turning))
		   (4 `(:ring survival :charges ,(+ 100 (d 100))))
		   (2 `(:ring telekinesis))
		   (4 `(:ring truth))
		   (3 `(:ring truthfulness))
		   (2 `(:ring truthlessness))
		   (5 `(:ring water-walking))
		   (5 `(:ring weakness))
		   (2 `(:ring wishes :charges ,(choose 4 1
						       3 2
						       2 3
						       1 4)))
		   (2 `(:ring x-ray-vision))))
	   (misc-item ()
	     (pick (2 `(:amulet protection-from-crystal-balls-and-esp))
		   (2 `(:bag devouring))
		   (5 `(:bag holding))
		   (3 `(:boat undersea))
		   (2 `(:boots levitation))
		   (3 `(:boots speed))
		   (2 `(:boots travelling-and-leaping))
		   (1 `(:bowl commanding-water-elementals))
		   (1 `(:brazier commanding-fire-elementals))
		   (2 `(:broom flying))
		   (1 `(:censer controlling-air-elementals))
		   (3 `(:chime time))
		   (2 `(:crystal-ball normal))
		   (1 `(:crystal-ball clairaudience))
		   (1 `(:crystal-ball esp))
		   (2 `(:cloak displacer))
		   (1 `(:drums panic))
		   (1 `(:bottle efreeti))
		   (3 `(:egg ,(choose-uniformly 'rock-baboon
						'giant-bat
						'black-bear
						'grizzly-bear
						'boar
						'mountain-lion
						'panther
						'giant-ferret
						'gecko
						'draco
						'racer-snake
						'wolf)))
		   (2 `(:boots elven))
		   (2 `(:cloak elven))
		   (1 `(:carpet flying))
		   (2 `(:gauntlets ogre-power))
		   (2 `(:girdle giant-strength))
		   (2 `(:helm ,(choose-uniformly 'lawful-alignment
						 'neutral-alignment
						 'chaotic-alignment)))
		   (2 `(:helm reading))
		   (1 `(:helm telepathy))
		   (1 `(:helm teleportation))
		   (1 `(:horn blasting))
		   (2 `(:lamp hurricane))
		   (3 `(:lamp long-burning))
		   (2 `(:medallion esp-30-ft-range))
		   (1 `(:medallion esp-90-ft-range))
		   (1 `(:mirror life-trapping)) ;;; fixme include contents
		   (3 `(:muzzle training))
		   (2 `(:nail finger))
		   (3 `(:nail pointing))
		   (5 `(:ointment ,(choose-uniformly 'blessing
						     'healing
						     'poison
						     'scarring
						     'soothing
						     'tanning)))
		   (3 `(:pouch security))
		   (3 `(:quill copying))
		   (4 `(:rope climbing))
		   (2 `(:scarab protection :charges ,(d 6 2)))
		   (3 `(:slate identification))
		   (1 `(:stone controlling-earth-elementals))
		   (2 `(:talisman ,(choose-uniformly 'air-travel
						     'earth-travel
						     'fire-travel
						     'water-travel
						     'elemental-travel)))
		   (3 `(:wheel floating))
		   (1 `(:wheel fortune))
		   (2 `(: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 ()
	     (choose 68 'human
		     13 'dwarf
		     10 'elf
		      7 'halfling
		      2 '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
				 (zerop (random 8)))))
	       `(:bonus ,bonus
		 ,@(and power (cons :power power))
		 :size ,(armour-size)
		 ,@(and cursedp `(:cursed t)))))
	   (armour ()
	     (pick (10 `((:leather ,@(armour-piece 'd))))
		   ( 7 `((:scale-mail ,@(armour-piece 'd))))
		   (13 `((:chain-mail ,@(armour-piece 'c))))
		   ( 9 `((:banded-mail ,@(armour-piece 'd))))
		   (11 `((:plate-mail ,@(armour-piece 'b))))
		   ( 5 `((:suit-armour ,@(armour-piece 'b))))
		   (20 `((:shield ,@(armour-piece 'a))))
		   ( 2 `((:scale-mail ,@(armour-piece 'd))
			 (:shield ,@(armour-piece 'a))))
		   ( 8 `((:chain-mail ,@(armour-piece 'c))
			 (:shield ,@(armour-piece 'a))))
		   ( 5 `((:banded-mail ,@(armour-piece 'd))
			 (:shield ,@(armour-piece 'a))))
		   (10 `((: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 (37 (values :arrow 'a))
		       (22 (values :quarrel 'a))
		       (11 (values :sling-stone 'a))
		       (2 (values :blowgun 'd))
		       (8 (values :long-bow 'd))
		       (5 (values :short-bow 'd))
		       (2 (values :heavy-crossbow 'd))
		       (5 (values :light-crossbow 'd))
		       (8 (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 (zerop (random 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 (65 (values :normal-sword 'c))
		       (19 (values :short-sword 'c))
		       (8 (values :two-handed-sword 'd))
		       (8 (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 class)
		 (pick (7 (values :battle-axe nil 'd))
		       (8 (values :hand-axe (choose 3 nil 1 t) 'b))
		       (3 (values :blackjack nil 'c))
		       (3 (values :bola (choose 2 nil 1 t) 'b))
		       (5 (values :club nil 'c))
		       (14 (values :dagger (choose 11 nil 3 t) 'b))
		       (4 (values :one-handed-flail nil 'c))
		       (2 (values :two-handed-flail nil 'd))
		       (3 (values :halberd nil 'd))
		       (8 (values :war-hammer nil 'c))
		       (4 (values :javelin (choose 3 nil 1 t) 'b))
		       (4 (values :lance nil 'd))
		       (7 (values :mace nil 'c))
		       (5 (values :morning-star nil 'c))
		       (3 (values :net (choose 2 nil 1 t) 'b))
		       (3 (values :pike nil 'd))
		       (2 (values :pole-axe nil 'd))
		       (12 (values :spear (choose 3 nil 1 t) 'b))
		       (3 (values :whip nil 'c)))
	       (let* ((bonus (weapon-bonus class))
		      (cursedp (zerop (random 10)))
		      (modifier (sword-modifier bonus))
		      (intel (and (percentp 40)
				  (weapon-intelligence))))
		 `(,type
		   ,@(and returnsp `(:returning t))
		   :bonus ,bonus
		   ,@modifier
		   ,@intel
		   ,@(and cursedp `(:cursed t)))))))
    (pick ((if (symbol-match-p form :potion) 25 0) (list (potion)))
	  ((if (symbol-match-p form :scroll) 12 0) (list (scroll)))
	  ((if (symbol-match-p form :wandlike) 9 0) (list (wandlike)))
	  ((if (symbol-match-p form :ring) 6 0) (list (ring)))
	  ((if (symbol-match-p form :misc) 10 0) (list (misc-item)))
	  ((if (symbol-match-p form :armour) 10 0) (armour))
	  ((if (symbol-match-p form :missile) 11 0) (list (missile)))
	  ((if (symbol-match-p form :sword) 9 0) (list (sword)))
	  ((if (symbol-match-p form :weapon) 8 0) (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)
	     (tagged-bag
	      :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)
	     (tagged-bag
	      :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 `(:size ,mod) mod-list))
			    (setf value (* value mult))))
		      `(:kind ,kind
			:value ,(max 1 (round value))
			,@mod-list
			,@(and (> i 1) `(:quantity ,i))))))))
	   (jewellery (n)
	     (tagged-bag
	      :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)
	     (tagged-bag :magic
			 (loop with list = nil
			       for (form n) on forms by #'cddr do
			       (loop repeat n do
				     (dolist (item (magic-item 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 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 t 1)))))))