(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)))))
-(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
(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
(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
(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)))
-(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))
(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 ()
- (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 ()
- (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 ()
- (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)
((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)))
(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 ()
- (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
(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)))
- (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 ,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)
(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))
,@(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))
- (cursedp (zerop (random 10)))
+ (cursedp (cursedp 10))
(modifier (sword-modifier bonus))
- (intel (and (percentp 40)
+ (intel (and intelpc
+ (percentp intelpc)
(weapon-intelligence))))
`(,type
,@(and returnsp `(:returning 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 ()
'mink
'sable))
(special (n)
- (tagged-bag
+ (cons
:special
(loop repeat n
collect
(intern (format nil "STAR-~A"
(string kind))))))))
(gems (n)
- (tagged-bag
+ (cons
:gems
(loop while (plusp n)
for i = (min n (d 5))
(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)
- (tagged-bag
+ (cons
:jewellery
(loop while (plusp n)
for i = (min n (d 5))
: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
(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))))
(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))))
(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))))
(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))))
(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))))
(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)))
- (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)))))))
(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)))
(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)
(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)))
- (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)))
- (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)))
- (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)))
- (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<)))
~mdw / dnd / blobdiff