.gitignore: Also ignore Metapost output.

[dnd] / dice.lisp

diff --git a/dice.lisp b/dice.lisp
index 61f99d8..ee031fa 100644 (file)
--- a/dice.lisp
+++ b/dice.lisp
@@ -178,20 +178,19 @@
        (when (< (random n) 1)
          (setf it (car things))))))
 
        (when (< (random n) 1)
          (setf it (car things))))))
 

-(defmacro pick (&rest clauses)
+(defmacro pick (&body clauses)

   `(funcall (choose ,@(loop for (n . clause) in clauses
                           collect n
                           collect `(lambda () ,@clause)))))
 
   `(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)))
+(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
 
 (defconstant cleric-spells
   #((cure-light-wounds detect-evil detect-magic light protection-from-evil


@@ -210,6 +209,21 @@
     (earthquake holy-word raise-dead-fully restore survival travel wish
      wizardry)))
 
     (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
 (defconstant magic-user-spells
   #((analyse charm-person detect-magic floating-disc hold-portal light
      magic-missile protection-from-evil read-languages read-magic shield


@@ -239,8 +253,11 @@
     (contingency create-any-monster gate heal immunity maze meteor-swarm
      power-word-kill prismatic-wall shapechange survival timestop wish)))
 
     (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 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
 
 (defun random-spell (&optional (caster (spell-caster-type))
                               (level (ecase caster


@@ -263,21 +280,31 @@
   (let ((list (aref (ecase caster
                      ((:magic-user) magic-user-spells)
                      ((:cleric) cleric-spells)
   (let ((list (aref (ecase caster
                      ((:magic-user) magic-user-spells)
                      ((:cleric) cleric-spells)

-                     ((:druid) druid-spells))
+                     ((:druid) druid-only-spells))

                    level)))
     (values (elt list (random (length list)))
            caster
            level)))
 
                    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)))))))
+(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))
 
 (defun choose-distinct-items (n seq)
   (let* ((copy (subseq (coerce seq 'vector) 0))


@@ -290,303 +317,369 @@
        (setf (aref copy j) (aref copy len))))))
 
 (defun magic-item (form)
        (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))))
+  (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 ()
           (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))))
+            (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 ()
           (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))))
+            (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 ()
           (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))))
+            (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)
           (weapon-bonus (class)
             (loop for bonus from 1
                   for roll = (random 100) then (- roll item)


@@ -597,11 +690,12 @@
                                 ((d) '(70 18 8 3 1)))
                   when (< roll item) return bonus))
           (armour-size ()
                                 ((d) '(70 18 8 3 1)))
                   when (< roll item) return bonus))
           (armour-size ()

-            (choose 68 'human
-                    13 'dwarf
-                    10 'elf
-                     7 'halfling
-                     2 'giant))
+            (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)))
           (armour-piece (class)
             (let* ((bonus (weapon-bonus class))
                    (power (and (percentp (* 5 (1+ bonus)))


@@ -619,27 +713,40 @@
                                      (7 `(remove-curse :charges ,(d 3))))))
                    (cursedp (if (and power (eq (car power) 'remove-curse))
                                 nil
                                      (7 `(remove-curse :charges ,(d 3))))))
                    (cursedp (if (and power (eq (car power) 'remove-curse))
                                 nil

-                                (zerop (random 8)))))
+                                (cursedp 8))))

               `(:bonus ,bonus
                 ,@(and power (cons :power power))
                 :size ,(armour-size)
                 ,@(and cursedp `(:cursed t)))))
           (armour ()
               `(: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))))))
+            (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
           (opponent ()
             (choose 6 'bugs
                     3 'constructs


@@ -696,39 +803,59 @@
           (missile ()
             (multiple-value-bind
                 (item class)
           (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)))
+                (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)))
               (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)))
+                                         (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))
                             (number (ecase bonus
                                       ((1) (d 10 2))
                                       ((2) (d 8 2))


@@ -740,7 +867,7 @@
                          :number ,number
                          ,@(and cursedp `(:cursed t)))))
                 ((d) (let* ((bonus (weapon-bonus 'd))
                          :number ,number
                          ,@(and cursedp `(:cursed t)))))
                 ((d) (let* ((bonus (weapon-bonus 'd))

-                            (cursedp (zerop (random 10)))
+                            (cursedp (cursedp 10))

                             (modifier (weapon-modifier bonus :missilep t))
                             (range (ecase (+ bonus (d 4))
                                      ((2 3 4) nil)
                             (modifier (weapon-modifier bonus :missilep t))
                             (range (ecase (+ bonus (d 4))
                                      ((2 3 4) nil)


@@ -833,10 +960,14 @@
           (sword ()
             (multiple-value-bind
                 (type class)
           (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)))
+                (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))
               (let* ((bonus (weapon-bonus class))
                      (cursedp (zerop (random 10)))
                      (modifier (sword-modifier bonus))


@@ -847,30 +978,67 @@
                   ,@(and cursedp `(:cursed t))))))
           (weapon ()
             (multiple-value-bind
                   ,@(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)))
+                (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))
               (let* ((bonus (weapon-bonus class))

-                     (cursedp (zerop (random 10)))
+                     (cursedp (cursedp 10))

                      (modifier (sword-modifier bonus))
                      (modifier (sword-modifier bonus))

-                     (intel (and (percentp 40)
+                     (intel (and intelpc
+                                 (percentp intelpc)

                                  (weapon-intelligence))))
                 `(,type
                   ,@(and returnsp `(:returning t))
                                  (weapon-intelligence))))
                 `(,type
                   ,@(and returnsp `(:returning t))


@@ -878,15 +1046,21 @@
                   ,@modifier
                   ,@intel
                   ,@(and cursedp `(:cursed t)))))))
                   ,@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))))))
+    (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 ()
 
 (defun treasure-type (type-code)
   (labels ((common-fur-type ()


@@ -899,7 +1073,7 @@
                               'mink
                               'sable))
           (special (n)
                               'mink
                               'sable))
           (special (n)

-            (tagged-bag
+            (cons

              :special
              (loop repeat n
                    collect
              :special
              (loop repeat n
                    collect


@@ -1008,7 +1182,7 @@
                              (intern (format nil "STAR-~A"
                                              (string kind))))))))
           (gems (n)
                              (intern (format nil "STAR-~A"
                                              (string kind))))))))
           (gems (n)

-            (tagged-bag
+            (cons

              :gems
              (loop while (plusp n)
                    for i = (min n (d 5))
              :gems
              (loop while (plusp n)
                    for i = (min n (d 5))


@@ -1043,14 +1217,14 @@
                                    (2 (values 'good 4))
                                    (1 (values 'very-good 8)))
                            (setf mod-list
                                    (2 (values 'good 4))
                                    (1 (values 'very-good 8)))
                            (setf mod-list

-                                 (append `(:size ,mod) 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)
                            (setf value (* value mult))))
                      `(:kind ,kind
                        :value ,(max 1 (round value))
                        ,@mod-list
                        ,@(and (> i 1) `(:quantity ,i))))))))
           (jewellery (n)

-            (tagged-bag
+            (cons

              :jewellery
              (loop while (plusp n)
                    for i = (min n (d 5))
              :jewellery
              (loop while (plusp n)
                    for i = (min n (d 5))


@@ -1111,13 +1285,13 @@
                          :encumbrance ,enc
                          ,@(and (> i 1) `(:quantity ,i))))))))
           (magic (&rest forms)
                          :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)))))
+            (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
     (ecase type-code
 
       ;; treasure in lair


@@ -1130,7 +1304,7 @@
                (and (percentp 50) (gems (d 6 6)))
                (and (percentp 50) (jewellery (d 6 6)))
                (and (percentp 10) (special (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))))
+               (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))))
       ((b) (bag (tagged-bag :coins
                            (and (percentp 50) `(:cp ,(* 1000 (d 8))))
                            (and (percentp 25) `(:sp ,(* 1000 (d 6))))


@@ -1147,7 +1321,7 @@
                (and (percentp 50) (gems (d 6 6)))
                (and (percentp 50) (jewellery (d 6 6)))
                (and (percentp 5) (special (d 2)))
                (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))))
+               (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))))
       ((d) (bag (tagged-bag :coins
                            (and (percentp 10) `(:cp ,(* 1000 (d 8))))
                            (and (percentp 15) `(:sp ,(* 1000 (d 12))))


@@ -1155,7 +1329,7 @@
                (and (percentp 30) (gems (d 8)))
                (and (percentp 30) (jewellery (d 8)))
                (and (percentp 10) (special (d 2)))
                (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))))
+               (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))))
       ((e) (bag (tagged-bag :coins
                            (and (percentp 5) `(:cp ,(* 1000 (d 10))))
                            (and (percentp 30) `(:sp ,(* 1000 (d 12))))


@@ -1164,7 +1338,7 @@
                (and (percentp 10) (gems (d 10)))
                (and (percentp 10) (jewellery (d 10)))
                (and (percentp 15) (special (d 2)))
                (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))))
+               (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))))
       ((f) (bag (tagged-bag :coins
                            (and (percentp 30) `(:sp ,(* 1000 (d 10 2))))
                            (and (percentp 20) `(:ep ,(* 1000 (d 8))))


@@ -1182,7 +1356,7 @@
                (and (percentp 25) (gems (d 6 3)))
                (and (percentp 25) (jewellery (d 10)))
                (and (percentp 30) (special (d 3)))
                (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))))
+               (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))))
       ((h) (bag (tagged-bag :coins
                            (and (percentp 25) `(:cp ,(* 1000 (d 8 3))))
                            (and (percentp 50) `(:sp ,(* 1000 (d 100))))


@@ -1192,13 +1366,13 @@
                (and (percentp 50) (gems (d 100)))
                (and (percentp 50) (jewellery (* 10 (d 4))))
                (and (percentp 10) (special (d 2)))
                (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))))
+               (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)))
       ((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))))
+               (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)))))))
       ((j) (bag (tagged-bag :coins
                            (and (percentp 25) `(:cp ,(* 1000 (d 4))))
                            (and (percentp 10) `(:sp ,(* 1000 (d 3)))))))


@@ -1228,7 +1402,7 @@
                (and (percentp 5) (gems (d 2)))
                (and (percentp 5) (gems (d 4)))
                (and (percentp 2) (special 1))
                (and (percentp 5) (gems (d 2)))
                (and (percentp 5) (gems (d 4)))
                (and (percentp 2) (special 1))

-               (and (percentp 2) (magic t 1))))
+               (and (percentp 2) (magic :any 1))))

       ((v) (bag (tagged-bag :coins
                            (and (percentp 10) `(:sp ,(d 100)))
                            (and (percentp 5) `(:ep ,(d 100)))
       ((v) (bag (tagged-bag :coins
                            (and (percentp 10) `(:sp ,(d 100)))
                            (and (percentp 5) `(:ep ,(d 100)))


@@ -1237,7 +1411,7 @@
                (and (percentp 10) (gems (d 2)))
                (and (percentp 10) (gems (d 4)))
                (and (percentp 5) (special 1))
                (and (percentp 10) (gems (d 2)))
                (and (percentp 10) (gems (d 4)))
                (and (percentp 5) (special 1))

-               (and (percentp 5) (magic t 1))))
+               (and (percentp 5) (magic :any 1))))

 
       ;; unguarded treasures
       ((unguarded-1)
 
       ;; unguarded treasures
       ((unguarded-1)


@@ -1246,32 +1420,81 @@
                        (and (percentp 50) `(:gp ,(* 10 (d 6)))))
            (and (percentp 5) (gems (d 6)))
            (and (percentp 2) (jewellery (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))))
+           (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)))
       ((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))))
+           (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)))
       ((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))))
+           (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)))
       ((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))))
+           (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)))
       ((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)))))))
+           (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<)))