worlds/haxima-1.002/potions.scm

   1 ;; ----------------------------------------------------------------------------
   2 ;; potions.scm -- potion object types. Potions work on the drinker.
   3 ;; ----------------------------------------------------------------------------
   4
   5 (kern-mk-sprite-set 'ss_potions 32 32 2 5 0 0 "potions.png")
   6
   7 (kern-mk-sprite 's_healing_potion       ss_potions 1 0 #f 0)
   8 (kern-mk-sprite 's_mana_potion          ss_potions 1 1 #f 0)
   9 (kern-mk-sprite 's_immunity_potion      ss_potions 1 2 #f 0)
  10 (kern-mk-sprite 's_cure_potion          ss_potions 1 3 #f 0)
  11 (kern-mk-sprite 's_invisibility_potion  ss_potions 1 4 #f 0)
  12 (kern-mk-sprite 's_red_bubbly_potion    ss_potions 1 5 #f 0)
  13 (kern-mk-sprite 's_green_bubbly_potion  ss_potions 1 6 #f 0)
  14 (kern-mk-sprite 's_yellow_bubbly_potion ss_potions 1 7 #f 0)
  15 (kern-mk-sprite 's_round_bubbly_purple  ss_potions 1 10 #f 0)
  16 (kern-mk-sprite 's_round_bubbly_lblue   ss_potions 1 11 #f 0)
  17 (kern-mk-sprite 's_round_bubbly_yellow  ss_potions 1 12 #f 0)
  18
  19 ;; mk-potion -- utility for making potion types. 'drink-proc' should return one
  20 ;; of the result-* codes.
  21 (define (mk-potion tag name sprite drink-proc)
  22   (mk-usable-item tag name sprite norm drink-proc
  23                   (lambda (kpotion kuser)
  24                     (drink-proc kpotion kuser))))
  25
  26 ;; mk-clingy-potion -- utility for making potion types that automatically cause
  27 ;; npc's that want them to get them. 'drink-proc' should return one of the
  28 ;; result-* codes.
  29 (define (mk-clingy-potion tag name sprite drink-proc wants-it?)
  30   (mk-usable-clingy-item tag name sprite norm drink-proc wants-it?))
  31
  32 ;; healing (red) potion
  33 (mk-clingy-potion 't_heal_potion "healing potion" s_healing_potion
  34                   (lambda (kpotion kuser)
  35                     (kern-obj-heal kuser (kern-dice-roll "2d10"))
  36                     result-ok)
  37                   wants-healing?)
  38
  39 ;; mana (blue) potion
  40 (mk-clingy-potion 't_mana_potion "mana potion" s_mana_potion
  41                   (lambda (kpotion kuser)
  42                     (kern-char-dec-mana kuser (- 0 (kern-dice-roll "1d8+2")))
  43                     result-ok)
  44                   wants-mana?)
  45
  46 ;; cure (green) potion
  47 (mk-potion 't_cure_potion "cure potion" s_cure_potion
  48            (lambda (kpotion kuser)
  49              (kern-obj-remove-effect kuser ef_poison)
  50              result-ok))
  51
  52 (mk-potion 't_xp_potion "potion of gain level" s_cure_potion
  53            (lambda (kpotion kuser)
  54              (kern-char-add-experience kuser 500)
  55              result-ok))
  56
  57 (define (potion-gain-stats kuser current-stat stat-name stat-setter)
  58   (println "cur:" current-stat)
  59   (cond ((< current-stat 20)
  60          (kern-log-msg (kern-obj-get-name kuser) " gains " stat-name "!")
  61          (stat-setter kuser (+ current-stat (kern-dice-roll "1d3+1")))
  62          result-ok)
  63         ((< current-stat 25)
  64          (kern-log-msg (kern-obj-get-name kuser) " gains a little " stat-name "!")
  65          (stat-setter kuser (+ current-stat (kern-dice-roll "1d3")))
  66          result-ok)
  67         ((< current-stat 35)
  68          (let ((droll (kern-dice-roll "1d2-1")))
  69            (println "droll:" droll)
  70            (cond ((> droll 0)
  71                   (kern-log-msg (kern-obj-get-name kuser) " already has a lot of " stat-name ", but gets a wee bit more.")
  72                   (stat-setter kuser (+ current-stat 1))
  73                   result-ok)
  74                  (else
  75                   (kern-log-msg (kern-obj-get-name kuser) " already has a lot of " stat-name " and now just feels a little sick.")
  76                   result-no-effect))))
  77         (else
  78          (kern-log-msg (kern-obj-get-name kuser) " has too much " stat-name " and has become such an arrogant bore that potions have no more effect.")
  79          result-no-effect)))
  80
  81 (mk-potion 't_str_potion "potion of strength" s_round_bubbly_yellow
  82                 (lambda (kpotion kuser)
  83                         (potion-gain-stats kuser (kern-char-get-base-strength kuser)
  84                                            "strength" kern-char-set-strength)))
  85
  86 (mk-potion 't_dex_potion "potion of dexterity" s_round_bubbly_purple
  87                 (lambda (kpotion kuser)
  88                         (potion-gain-stats kuser (kern-char-get-base-dexterity kuser)
  89                                            "dexterity" kern-char-set-dexterity)))
  90
  91 (mk-potion 't_int_potion "potion of intelligence" s_round_bubbly_lblue
  92                 (lambda (kpotion kuser)
  93                         (potion-gain-stats kuser (kern-char-get-base-intelligence kuser)
  94                                 "intelligence" kern-char-set-intelligence)))
  95
  96 (mk-potion 't_info_potion "potion of enlightenment" s_mana_potion
  97            (lambda (kpotion kuser)
  98             (kern-log-msg "Information about " (kern-obj-get-name kuser))
  99                         (kern-log-msg "Thief skill: " (number->string (occ-ability-thief kuser)))
 100                         (kern-log-msg "Offensive magic: " (number->string (occ-ability-blackmagic kuser)))
 101                         (kern-log-msg "Utility magic: " (number->string (occ-ability-whitemagic kuser)))
 102                         (kern-log-msg "Magic resistance: " (number->string (occ-ability-magicdef kuser)))
 103                         (kern-log-msg "Combat strength: " (number->string (occ-ability-strattack kuser)))
 104                         (kern-log-msg "Combat dexterity: " (number->string (occ-ability-dexattack kuser)))
 105                         (kern-log-msg "Avoidance: " (number->string (occ-ability-dexdefend kuser)))
 106                         result-ok))
 107
 108
 109 ;; posion immunity (bubbly yellow) potion
 110 (mk-potion 't_poison_immunity_potion "immunity potion" s_immunity_potion
 111            (lambda (kpotion kuser)
 112              (kern-obj-add-effect kuser ef_temporary_poison_immunity nil)
 113              result-ok))
 114
 115 ;; invisibility (black) potion
 116 (mk-potion 't_invisibility_potion "invisibility potion" s_invisibility_potion
 117            (lambda (kpotion kuser)
 118              (kern-obj-add-effect kuser ef_invisibility nil)
 119              result-ok))
 120
 121 ;; FIXME: the following "blood" potions need to do stuff
 122 (mk-potion 't_dragons_blood "dragon's blood"  s_red_bubbly_potion
 123            (lambda (kpotion kuser)
 124              (kern-obj-add-effect kuser ef_temporary_fire_immunity nil)
 125              result-ok))
 126
 127 ;; hydra's blood -- turn arrows into poisoned arrows?
 128 (mk-potion 't_hydras_blood "hydra's blood" s_green_bubbly_potion
 129            (lambda (kpotion kuser)
 130              (kern-obj-add-effect kuser ef_temporary_grow_head nil)
 131              result-ok))
 132
 133 ;; lich's blood -- turn arrows into diseased arrows?
 134 (mk-potion 't_lichs_blood "lich's blood" s_yellow_bubbly_potion
 135            (lambda (kpotion kuser)
 136                (kern-obj-add-effect kuser ef_temporary_disease_immunity nil)
 137                (kern-obj-add-effect kuser ef_temporary_poison_immunity nil)
 138                result-ok))
 139
 140