# HG changeset patch # User Steve Losh # Date 1484869211 0 # Node ID 5ac0bb8b19b55b52781b04654af0112f01e01e62 # Parent 421231bbf89f5933943b10d7dc45b4e0cf005d5c Flavor diff -r 421231bbf89f -r 5ac0bb8b19b5 src/robots/rpg-shopkeeper.lisp --- a/src/robots/rpg-shopkeeper.lisp Thu Jan 19 22:52:27 2017 +0000 +++ b/src/robots/rpg-shopkeeper.lisp Thu Jan 19 23:40:11 2017 +0000 @@ -6,91 +6,16 @@ (defun muffenize (str) (symb '* (string-upcase (substitute #\- #\space str)) '*))) +(defmacro maybe (expr &optional (chance 0.5)) + `(when (randomp ,chance) + ,expr)) + ;;;; General ------------------------------------------------------------------ (define-rule (bonus :distribution (:zipf :exponent 1.8)) 1 2 3 4 5) -;;;; Materials ---------------------------------------------------------------- -(defclass* material () - (kind name multiplier)) - -(defun make-material (kind name multiplier) - (make-instance 'material :kind kind :name name :multiplier multiplier)) - -(defmethod print-object ((o material) s) - (print-unreadable-object (o s :type t) - (princ (material-name o) s))) - -(defmacro define-material (kind name multiplier) - `(defparameter ,(muffenize name) - (make-material ,kind ,name ,multiplier))) - - -(define-material :metal "iron" 1.0) -(define-material :metal "steel" 1.5) -(define-material :metal "silver" 5.0) -(define-material :metal "meteoric iron" 10.0) -(define-material :metal "mithril" 50.0) -(define-material :metal "adamantine" 60.0) -(define-material :textile "cloth" 1.0) -(define-material :textile "leather" 1.5) -(define-material :textile "silk" 2.0) -(define-material :textile "spider silk" 6.0) -(define-material :wood "pine" 1.0) ; http://www.wood-database.com/wood-articles/bow-woods/ -(define-material :wood "poplar" 1.2) -(define-material :wood "walnut" 1.3) -(define-material :wood "maple" 2.0) -(define-material :wood "oak" 3.0) -(define-material :wood "yew" 5.0) -(define-material :wood "rosewood" 10.0) - - -(define-rule (metal :distribution :zipf) - !*iron* - !*steel* - !*silver* - !*meteoric-iron* - !*mithril* - !*adamantine*) - -(define-rule (textile :distribution :weighted) - (1.00 !*cloth*) - (1.00 !*leather*) - (0.80 !*silk*) - (0.01 !*spider-silk*)) - -(define-rule (wood :distribution (:zipf :exponent 0.8)) - !*pine* - !*poplar* - !*walnut* - !*maple* - !*oak* - !*yew* - !*rosewood*) - - -(define-string material-picture-wood - "carved with images of" - "covered in carvings of" - "painted with pictures of") - -(define-string material-picture-metal - "engraved with an image of" - "painted with images of") - -(define-string material-picture-textile - "embroidered with images of") - - -(defun material-picture (material) - (ecase (material-kind material) - (:metal (material-picture-metal)) - (:wood (material-picture-wood)) - (:textile (material-picture-textile)))) - - ;;;; Monsters ----------------------------------------------------------------- (defclass* monster () (singular multiplier plural adjective)) @@ -142,20 +67,121 @@ (0.01 !*dragon*)) +;;;; Materials ---------------------------------------------------------------- +(defclass* material () + (kind name multiplier)) + +(defun make-material (kind name multiplier) + (make-instance 'material :kind kind :name name :multiplier multiplier)) + +(defmethod print-object ((o material) s) + (print-unreadable-object (o s :type t) + (princ (material-name o) s))) + +(defmacro define-material (kind name multiplier) + `(defparameter ,(muffenize name) + (make-material ,kind ,name ,multiplier))) + + +(define-material :metal "iron" 1.0) +(define-material :metal "steel" 1.5) +(define-material :metal "silver" 5.0) +(define-material :metal "meteoric iron" 10.0) +(define-material :metal "mithril" 50.0) +(define-material :metal "adamantine" 60.0) +(define-material :textile "cloth" 1.0) +(define-material :textile "leather" 1.5) +(define-material :textile "silk" 2.0) +(define-material :textile "spider silk" 6.0) +(define-material :wood "pine" 1.0) ; http://www.wood-database.com/wood-articles/bow-woods/ +(define-material :wood "poplar" 1.2) +(define-material :wood "walnut" 1.3) +(define-material :wood "maple" 2.0) +(define-material :wood "oak" 3.0) +(define-material :wood "yew" 5.0) +(define-material :wood "rosewood" 10.0) +(define-material :skin "leather" 1.0) + + +(define-rule (metal :distribution :zipf) + !*iron* + !*steel* + !*silver* + !*meteoric-iron* + !*mithril* + !*adamantine*) + +(define-rule (textile :distribution :weighted) + (1.00 !*cloth*) + (1.00 !*leather*) + (0.80 !*silk*) + (0.01 !*spider-silk*)) + +(define-rule (wood :distribution (:zipf :exponent 0.8)) + !*pine* + !*poplar* + !*walnut* + !*maple* + !*oak* + !*yew* + !*rosewood*) + +(define-rule (skin :distribution :weighted) + (3 !*leather*) + (1 !(let ((monster (monster))) + (make-material :skin + $(!(monster-singular monster) :. "skin") + (1+ (monster-multiplier monster)))))) + + +(define-string material-picture-wood + "carved with images of" + "covered in carvings of" + "painted with pictures of") + +(define-string material-picture-metal + "engraved with an image of" + "etched with a picture of" + "painted with images of") + +(define-string material-picture-textile + "sewn with pictures of" + "embroidered with images of") + +(define-string material-picture-skin + "dyed with images of" + "sewn with pictures of" + "embossed with drawings of") + + +(defun material-picture (material) + (ecase (material-kind material) + (:metal (material-picture-metal)) + (:wood (material-picture-wood)) + (:textile (material-picture-textile)) + (:skin (material-picture-skin)))) + + ;;;; Roles -------------------------------------------------------------------- (define-rule role "cleric" "warrior" "wizard" + "bard" + "jester" + "priest" + "hermit" "rogue") ;;;; Elements ----------------------------------------------------------------- (define-rule element - ("ice" "icy") - ("fire" "flaming") - ("electricity" "electrified") - ("poison" "venomous")) + ("good" "holy") + ("evil" "unholy") + ("ice" "icy") + ("fire" "flaming") + ("lightning" "electrified") + ("poison" "venomous")) ;;;; Pieces ------------------------------------------------------------------- @@ -175,6 +201,7 @@ ;;;; Ornaments ---------------------------------------------------------------- (define-string ornament-scene + "a strange land" ([monster monster-plural] "fighting" [monster monster-plural]) ("a famous" [monster monster-singular] role)) @@ -220,6 +247,10 @@ (defclass* armor () (material piece enchantment ornament)) +(define-with-macro armor + material piece enchantment ornament) + + (define-piece "scale mail" 50) (define-piece "ring mail" 50) (define-piece "chain mail" 150) @@ -248,9 +279,10 @@ !*skirt*) -(define-rule vanilla-armor - (metal piece-armor) - (textile piece-clothing)) +(define-rule (vanilla-armor :distribution :weighted) + (1 (metal piece-armor)) + (1 (textile piece-clothing)) + (0.2 (skin piece-clothing))) (define-rule (armor% :distribution :weighted) (2 (vanilla-armor nil)) @@ -268,12 +300,13 @@ (defun armor-value (armor) - (let ((enchantment (armor-enchantment armor))) - (* (+ (* (-> armor armor-piece piece-base-value) - (-> armor armor-material material-multiplier)) - (if enchantment 100 0)) + (with-armor (armor) + (* (+ (* (-> piece piece-base-value) + (-> material material-multiplier)) + (if enchantment 100 0) + (if ornament 10 0)) (enchantment-multiplier enchantment) - (if (armor-ornament armor) 1.5 1.0)))) + (if ornament 1.5 1.0)))) (defgeneric enchanted-armor-description @@ -321,6 +354,10 @@ (defclass* weapon () (material piece enchantment ornament)) +(define-with-macro weapon + material piece enchantment ornament) + + (define-piece "dagger" 5) (define-piece "longsword" 50) (define-piece "short sword" 20) @@ -335,6 +372,7 @@ (define-piece "staff" 5) (define-piece "mace" 25) (define-piece "flail" 45) +(define-piece "sling" 5) (define-rule piece-melee !*dagger* @@ -358,16 +396,20 @@ (define-piece "crossbow" 80) (define-piece "compound bow" 80) -(define-rule (piece-ranged :distribution :weighted) +(define-rule (piece-bow :distribution :weighted) (2 !*shortbow*) (2 !*longbow*) (1 !*crossbow*) (1 !*compound-bow*)) +(define-rule piece-sling + !*sling*) -(define-rule vanilla-weapon - (metal piece-melee) - (wood piece-ranged)) + +(define-rule (vanilla-weapon :distribution :weighted) + (2 (metal piece-melee)) + (1 (wood piece-bow)) + (0.5 (skin piece-sling))) (define-rule (weapon% :distribution :weighted) (2 (vanilla-weapon nil)) @@ -384,12 +426,14 @@ (defun weapon-value (weapon) - (let ((enchantment (weapon-enchantment weapon))) - (* (+ (* (-> weapon weapon-piece piece-base-value) - (-> weapon weapon-material material-multiplier)) - (if enchantment 100 0)) + (with-weapon (weapon) + (* (+ (* (-> piece piece-base-value) + (-> material material-multiplier)) + (if enchantment 100 0) + (if ornament 10 0)) (enchantment-multiplier enchantment) - (if (weapon-ornament weapon) 1.5 1.0)))) + (if ornament 1.5 1.0)))) + (defgeneric enchanted-weapon-description (base enchantment-type enchantment-arguments)) @@ -411,9 +455,10 @@ (defun vanilla-weapon-description (vanilla-weapon) - (format nil "~A ~A" - (-> vanilla-weapon weapon-material material-name) - (-> vanilla-weapon weapon-piece piece-name))) + (with-weapon (vanilla-weapon) + (format nil "~A ~A" + (-> material material-name) + (-> piece piece-name)))) (defun weapon-description (weapon) (let ((vanilla-description (vanilla-weapon-description weapon)) @@ -431,10 +476,18 @@ ;;;; Flavor ------------------------------------------------------------------- +(define-string fluid + "blood" + "slime") + (define-string sales-pitch "Only used once!" "Brand new!" - "The blood will wash right off..." + ("That" fluid "will wash right off...") + "You won't find a better deal!" + "This could save your life!" + "It breaks my heart to part with it..." + "Its last owner... doesn't need it anymore." ("I bought it from" [monster monster-adjective a] role :. ".") "Look at the workmanship!" "This is gonna go fast!") @@ -450,9 +503,11 @@ (defun sanitize-price (price) (let ((price (round-to price 3))) - (if (< 50 price) - (* 5 (round price 5)) - price))) + (cond + ((< price 50) price) + ((in-range-p 50 price 100) (* 5 (round price 5))) + ((in-range-p 100 price 1000) (* 10 (round price 10))) + (t price)))) (defun item-value (item) (-<> (etypecase item @@ -490,12 +545,14 @@ sales-pitch))) -; (loop :repeat 10 :do -; (terpri) -; (terpri) -; (print '-------------------------------) -; (terpri) -; (princ (offer))) +(defun dump () + (loop :repeat 10 :do + (terpri) + (terpri) + (print '-------------------------------) + (terpri) + (princ (offer)))) + ;;;; API ---------------------------------------------------------------------- (defun random-string ()