worlds/haxima-1.002/spider.scm

   1 ;; Local variables
   2 (define spider-melee-weapon t_hands)
   3
   4 ;; Remapped display and newline to local procs so they can be disabled/enabled
   5 ;; for debug more conveniently
   6 ; (define (spider-display . args)
   7 ;   (display (kern-get-ticks))
   8 ;   (display ":")
   9 ;   (apply display args))
  10 ; (define (spider-newline) (newline))
  11
  12 (define (spider-display . args) )
  13 (define (spider-newline) )
  14
  15 ;; ----------------------------------------------------------------------------
  16 ;; Spider Egg
  17 ;;
  18 ;; ----------------------------------------------------------------------------
  19
  20 (define spider-egg-hatch-time 10)
  21 (define (spider-egg-gob-mk) (list spider-egg-hatch-time))
  22 (define (spider-egg-hatch-timer gob) (car gob))
  23 (define (spider-egg-set-hatch-timer! gob val) (set-car! gob val))
  24 (define (spider-egg-hatch-timer-expired? gob) (= 0 (spider-egg-hatch-timer gob)))
  25 (define (spider-egg-dec-hatch-timer! gob)
  26   (spider-egg-set-hatch-timer! gob
  27                                (- (spider-egg-hatch-timer gob)
  28                                   1)))
  29
  30 ;; spider-egg-disturbed - obsolete function that would return true if any
  31 ;; neighboring tiles contained non-spiders. I discontinued it because it made
  32 ;; eggs run too slowly (about 30ms per). Replaced it with a simple egg timer.
  33 (define (spider-egg-disturbed kegg)
  34   (spider-display "spider-egg-disturbed")(spider-newline)
  35   (define (check val loc)
  36     ;;(display "loc:")(display loc)(newline)
  37     (or val
  38         (foldr (lambda (a b) (or a
  39                                  (and (obj-is-char? b)
  40                                       (not (is-spider? b)))))
  41                #f
  42                (kern-get-objects-at loc))))
  43   (let ((loc (kern-obj-get-location kegg)))
  44     (kern-fold-rect (loc-place loc)
  45                     (- (loc-x loc) 2)
  46                     (- (loc-y loc) 2)
  47                     5
  48                     5
  49                     check
  50                     #f)))
  51
  52 (define (spider-egg-hatch kegg)
  53   (spider-display "spider-egg-hatch")(spider-newline)
  54   (kern-log-msg "¥¯¥â¤¬ÕÛ¤Ã¤¿¡ª")
  55   (kern-obj-put-at (mk-npc 'giant-spider (calc-level)) (kern-obj-get-location kegg))
  56   (kern-obj-remove kegg))
  57
  58 (define (spider-egg-exec kegg)
  59   (let ((gob (kobj-gob-data kegg)))
  60     (if (spider-egg-hatch-timer-expired? gob)
  61         (spider-egg-hatch kegg)
  62         (spider-egg-dec-hatch-timer! gob))))
  63
  64 (define spider-egg-ifc
  65   (ifc '()
  66        (method 'exec spider-egg-exec)))
  67
  68 (mk-obj-type 'spider-egg-type
  69              "¥¯¥â¤ÎÍñ"
  70              s_magic
  71              layer-item
  72              spider-egg-ifc)
  73
  74 (define (mk-spider-egg)
  75   (bind (kern-mk-obj spider-egg-type 1)
  76         (spider-egg-gob-mk)))
  77
  78 ;; ----------------------------------------------------------------------------
  79 ;; Spider "Skills"
  80 ;; ----------------------------------------------------------------------------
  81
  82 (define (suck-hp kspider ktarg amount)
  83   (kern-log-msg (kern-obj-get-name kspider)
  84                 "¤Ï"
  85                 (kern-obj-get-name ktarg)
  86                 "¤ÎÂÎ±Õ¤òµÛ¤Ã¤¿¡ª")
  87   (let ((amount (min amount (kern-char-get-hp ktarg))))
  88     (kern-obj-apply-damage ktarg nil amount)
  89     (kern-obj-heal kspider amount)))
  90
  91 (define (spider-paralyze ktarg)
  92   (spider-display "spider-paralyze")(spider-newline)
  93   (paralyze ktarg))
  94
  95 (define (ensnare-loc loc)
  96   (spider-display "ensnare-loc")(spider-newline)
  97   (kern-obj-put-at (kern-mk-obj web-type 1) loc))
  98
  99
 100
 101 ;; ----------------------------------------------------------------------------
 102 ;; Spider AI
 103 ;; ----------------------------------------------------------------------------
 104 (define (spider-is-aggressive? kspider)
 105   (> (kern-char-get-hp kspider)
 106      (/ (* 4 (kern-char-get-max-hp kspider)) 5)))
 107
 108 (define (is-queen-spider? kspider)
 109   (eqv? (kern-char-get-species kspider) sp_queen_spider))
 110
 111 (define (spider-try-to-lay-egg kspider)
 112   (spider-display "spider-try-to-lay-egg")(spider-newline)
 113   (let ((loc (kern-obj-get-location kspider)))
 114     (if (and (not (is-object-type-at? loc spider-egg-type))
 115              (> (kern-dice-roll "1d20") 18))
 116         (kern-obj-put-at (mk-spider-egg) loc))))
 117
 118 (define (spider-no-hostiles kspider)
 119   (spider-display "spider-no-hostiles")(spider-newline)
 120   (let ((loc (kern-obj-get-location kspider)))
 121     (if (not (is-object-type-at? loc web-type))
 122         (ensnare-loc loc))
 123     (if (is-queen-spider? kspider)
 124         (spider-try-to-lay-egg kspider)))
 125   (wander kspider))
 126
 127 (define (is-helpless? kchar)
 128   (or (kern-char-is-asleep? kchar)
 129       (is-ensnared? kchar)
 130       (is-paralyzed? kchar)))
 131
 132 (define (spider-attack-helpless-foe kspider kfoe)
 133   (define (attack kspider coords)
 134     (spider-display "spider-attack")(spider-newline)
 135     (if (is-paralyzed? kfoe)
 136         (suck-hp kspider kfoe (kern-dice-roll "1d6"))
 137         (spider-paralyze kfoe)))
 138   (spider-display "spider-attack-helpless-foe")(spider-newline)
 139   (do-or-goto kspider (kern-obj-get-location kfoe) attack))
 140
 141 (define (spider-foe-in-range-of-web-spew? kspider kfoe)
 142   (spider-display "spider-foe-in-range-of-web-spew?")(spider-newline)
 143   (< (kern-get-distance (kern-obj-get-location kspider)
 144                         (kern-obj-get-location kfoe))
 145      (/ (kern-char-get-level kspider) 2)))
 146
 147 (define (spider-pathfind-to-foe kspider kfoe)
 148   (spider-display "spider-pathfind-to-foe")(spider-newline)
 149   (pathfind kspider (kern-obj-get-location kfoe)))
 150
 151 (define (spider-try-to-spew-web kspider foe)
 152   (spider-display "spider-try-to-spew-web")(spider-newline)
 153   (if (and (can-use-ability? web-spew kspider)
 154            (spider-foe-in-range-of-web-spew? kspider foe))
 155       (use-ability web-spew kspider foe)
 156       (spider-attack-helpless-foe kspider foe)))
 157
 158 (define (spider-no-helpless-foes kspider foes)
 159   (spider-display "spider-no-helpless-foes")(spider-newline)
 160   (if (is-queen-spider? kspider)
 161       (spider-try-to-spew-web kspider (closest-obj
 162                                             (kern-obj-get-location kspider)
 163                                             foes))
 164       (if (spider-is-aggressive? kspider)
 165           (spider-attack-helpless-foe kspider
 166                                       (closest-obj
 167                                        (kern-obj-get-location kspider)
 168                                        foes))
 169           (evade kspider foes))))
 170
 171 (define (spider-hostiles kspider foes)
 172   (spider-display "spider-hostiles")(spider-newline)
 173   (let ((helpless-foes (filter is-helpless? foes)))
 174     (if (null? helpless-foes)
 175         (spider-no-helpless-foes kspider foes)
 176         (spider-attack-helpless-foe kspider
 177                                          (closest-obj
 178                                           (kern-obj-get-location kspider)
 179                                           helpless-foes)))))
 180
 181 (define spider-bad-fields
 182   (filter (lambda (x) (and (not (eqv? x web-type))
 183                            (not (eqv? x F_web_perm))))
 184           all-field-types))
 185
 186 (define (spider-ai kspider)
 187   (spider-display "spider-ai")(spider-newline)
 188   (or (get-off-bad-tile? kspider)
 189       (let ((foes (all-visible-hostiles kspider)))
 190         (if (null? foes)
 191             (spider-no-hostiles kspider)
 192             (spider-hostiles kspider foes))
 193         #t)))