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 "A spider hatches!")
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             "spider egg"
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                " sucks the juices from "
85                (kern-obj-get-name ktarg))
86  (let ((amount (min amount (kern-char-get-hp ktarg))))
87    (kern-obj-apply-damage ktarg nil amount)
88    (kern-obj-heal kspider amount)))
89
90(define (spider-paralyze ktarg)
91  (spider-display "spider-paralyze")(spider-newline)
92  (paralyze ktarg))
93
94(define (ensnare-loc loc)
95  (spider-display "ensnare-loc")(spider-newline)
96  (kern-obj-put-at (kern-mk-obj web-type 1) loc))
97
98
99
100;; ----------------------------------------------------------------------------
101;; Spider AI
102;; ----------------------------------------------------------------------------
103(define (spider-is-aggressive? kspider)
104  (> (kern-char-get-hp kspider)
105     (/ (* 4 (kern-char-get-max-hp kspider)) 5)))
106
107(define (is-queen-spider? kspider)
108  (eqv? (kern-char-get-species kspider) sp_queen_spider))
109
110(define (spider-try-to-lay-egg kspider)
111  (spider-display "spider-try-to-lay-egg")(spider-newline)
112  (let ((loc (kern-obj-get-location kspider)))
113    (if (and (not (is-object-type-at? loc spider-egg-type))
114             (> (kern-dice-roll "1d20") 18))
115        (kern-obj-put-at (mk-spider-egg) loc))))
116
117(define (spider-no-hostiles kspider)
118  (spider-display "spider-no-hostiles")(spider-newline)
119  (let ((loc (kern-obj-get-location kspider)))
120    (if (not (is-object-type-at? loc web-type))
121        (ensnare-loc loc))
122    (if (is-queen-spider? kspider)
123        (spider-try-to-lay-egg kspider)))
124  (wander kspider))
125
126(define (is-helpless? kchar)
127  (or (kern-char-is-asleep? kchar)
128      (is-ensnared? kchar)
129      (is-paralyzed? kchar)))
130
131(define (spider-attack-helpless-foe kspider kfoe)
132  (define (attack kspider coords)
133    (spider-display "spider-attack")(spider-newline)
134    (if (is-paralyzed? kfoe)
135        (suck-hp kspider kfoe (kern-dice-roll "1d6"))
136        (spider-paralyze kfoe)))
137  (spider-display "spider-attack-helpless-foe")(spider-newline)
138  (do-or-goto kspider (kern-obj-get-location kfoe) attack))
139
140(define (spider-foe-in-range-of-web-spew? kspider kfoe)
141  (spider-display "spider-foe-in-range-of-web-spew?")(spider-newline)
142  (< (kern-get-distance (kern-obj-get-location kspider)
143                        (kern-obj-get-location kfoe))
144     (/ (kern-char-get-level kspider) 2)))
145
146(define (spider-pathfind-to-foe kspider kfoe)
147  (spider-display "spider-pathfind-to-foe")(spider-newline)
148  (pathfind kspider (kern-obj-get-location kfoe)))
149
150(define (spider-try-to-spew-web kspider foe)
151  (spider-display "spider-try-to-spew-web")(spider-newline)
152  (if (and (can-use-ability? web-spew kspider)
153           (spider-foe-in-range-of-web-spew? kspider foe))
154      (use-ability web-spew kspider foe)
155      (spider-attack-helpless-foe kspider foe)))
156
157(define (spider-no-helpless-foes kspider foes)
158  (spider-display "spider-no-helpless-foes")(spider-newline)
159  (if (is-queen-spider? kspider)
160      (spider-try-to-spew-web kspider (closest-obj
161                                            (kern-obj-get-location kspider)
162                                            foes))
163      (if (spider-is-aggressive? kspider)
164          (spider-attack-helpless-foe kspider
165                                      (closest-obj
166                                       (kern-obj-get-location kspider)
167                                       foes))
168          (evade kspider foes))))
169
170(define (spider-hostiles kspider foes)
171  (spider-display "spider-hostiles")(spider-newline)
172  (let ((helpless-foes (filter is-helpless? foes)))
173    (if (null? helpless-foes)
174        (spider-no-helpless-foes kspider foes)
175        (spider-attack-helpless-foe kspider
176                                         (closest-obj
177                                          (kern-obj-get-location kspider)
178                                          helpless-foes)))))
179
180(define spider-bad-fields
181  (filter (lambda (x) (and (not (eqv? x web-type))
182                           (not (eqv? x F_web_perm))))
183          all-field-types))
184
185(define (spider-ai kspider)
186  (spider-display "spider-ai")(spider-newline)
187  (or (get-off-bad-tile? kspider)
188      (let ((foes (all-visible-hostiles kspider)))
189        (if (null? foes)
190            (spider-no-hostiles kspider)
191            (spider-hostiles kspider foes))
192        #t)))
193