1;;----------------------------------------------------------------------------
2;; gate-guard -- wizard guards of the Enchanter's Tower
3;;----------------------------------------------------------------------------
4
5;;----------------------------------------------------------------------------
6;; Gob
7;;----------------------------------------------------------------------------
8(define (mk-gate-guard-gob gate-tag post passwd)
9  (list 'gate-guard gate-tag 0 post passwd))
10
11(define (gate-guard-gate-tag guard) (cadr guard))
12(define (gate-guard-gate-timer guard) (caddr guard))
13(define (gate-guard-post guard) (cadddr guard))
14(define (gate-guard-passwd guard) (list-ref guard 4))
15(define (gate-guard-set-gate-timer! guard val) (set-car! (cddr guard) val))
16(define (gate-guard-start-timer! guard) (gate-guard-set-gate-timer! guard 10))
17
18(define (char-is-gate-guard? kchar)
19  (let ((gob (kobj-gob-data kchar)))
20    (if (notnull? gob)
21        (eq? (car gob) 'gate-guard)
22        #f)))
23
24;;----------------------------------------------------------------------------
25;; Conv
26;;----------------------------------------------------------------------------
27
28(define (gate-guard-default knpc kpc)
29  (say knpc "[No reply]"))
30
31(define (gate-guard-hail knpc kpc)
32  (say knpc "Halt! What is the password?")
33  (let ((passwd (kern-conv-get-reply kpc)))
34    (if (eq? passwd (gate-guard-passwd (gob knpc)))
35        (let* ((guard (kobj-gob-data knpc))
36               (gate (eval (gate-guard-gate-tag guard))))
37          (signal-kobj gate 'on gate nil)
38          (gate-guard-start-timer! guard)
39          (say knpc "You may pass")
40          (kern-conv-end))
41        (begin
42          (say knpc "That is not correct")
43          (kern-conv-end)
44          ))))
45
46(define gate-guard-conv
47  (ifc nil
48       (method 'default gate-guard-default)
49       (method 'hail gate-guard-hail)
50       ))
51
52;;----------------------------------------------------------------------------
53;; Mage Guard AI
54;;
55;; FIXME: when and if mundane gate guards are added don't hardcode the
56;; gate-guard AI to use this "sub"-AI
57;;----------------------------------------------------------------------------
58(define (need-more-troops? kchar)
59  (> (length (all-visible-hostiles kchar))
60     (length (all-visible-allies kchar))))
61
62(define (mguard-cast-spell kchar ktarg)
63  (if (and (need-more-troops? kchar)
64           (> (kern-char-get-mana kchar) 4))
65      (begin
66        (kern-log-msg "The mage guard summons help!")
67        (summon (kern-obj-get-location ktarg)
68                mk-ranger
69                (kern-being-get-current-faction kchar)
70                (kern-dice-roll "1d3"))
71        (kern-char-dec-mana kchar 4)
72        (kern-obj-dec-ap kchar 4)
73        #t)
74      ;; don't need or can't summon more troops
75      (if (and (is-undead? ktarg)
76               (can-cast? kchar an-xen-corp))
77          (begin
78            (cast0 kchar (lookup-spell an-xen-corp))
79            #t)
80          ;; don't need or can't repel undead
81          #f)))
82
83(define (mguard-ai kchar)
84  (let ((ktarg (ai-select-target kchar)))
85    (if (null? ktarg)
86        (ai-wander kchar)
87        (or (mguard-cast-spell kchar ktarg)
88            (ai-attack-target kchar ktarg)
89            (ai-pathfind-to-target kchar ktarg)))))
90
91;;----------------------------------------------------------------------------
92;; AI
93;;----------------------------------------------------------------------------
94
95(define (guard-is-holding-gate-open? guard)
96  (> (gate-guard-gate-timer guard) 0))
97
98(define (guard-dec-gate-timer! guard)
99  (gate-guard-set-gate-timer! guard (- (gate-guard-gate-timer guard) 1))
100  (if (<= (gate-guard-gate-timer guard) 0)
101      (let ((kgate (eval (gate-guard-gate-tag guard))))
102        (signal-kobj kgate 'off kgate nil)
103        (gate-guard-set-gate-timer! guard 0))))
104
105(define (guard-start-gate-timer! guard)
106  (gate-guard-start-timer! guard))
107
108(define (gate-is-open? kgate)
109  (signal-kobj kgate 'is-on? kgate nil))
110
111(define (hostiles-visible? kguard)
112  (notnull? (all-visible-hostiles kguard)))
113
114(define (guard-close-gate! guard kgate)
115  (signal-kobj kgate 'off kgate nil)
116  (gate-guard-set-gate-timer! guard 0)
117  (kern-log-msg "The guard closes the gate"))
118
119(define (guard-too-far-from-gate? kguard kgate)
120  (> (distance kguard kgate) 1))
121
122(define (guard-return-to-post kguard)
123  (pathfind kguard
124            (cons (loc-place (kern-obj-get-location kguard))
125                  (gate-guard-post (gob kguard)))))
126
127(define (gate-guard-ai kchar)
128  (or (get-off-bad-tile? kchar)
129      (use-potion? kchar)
130      (let* ((guard (kobj-gob-data kchar))
131             (kgate (eval (gate-guard-gate-tag guard))))
132        (if (any-visible-hostiles? kchar)
133            (if (gate-is-open? kgate)
134                (guard-close-gate! guard kgate)
135                #f)
136            (begin
137              (guard-return-to-post kchar)
138              (if (guard-is-holding-gate-open? guard)
139                  (guard-dec-gate-timer! guard)
140                  (if (gate-is-open? kgate)
141                    (guard-start-gate-timer! guard)
142                    ))
143              #t)))))
144
145;;----------------------------------------------------------------------------
146;; Constructor -- make a guard captain
147;;----------------------------------------------------------------------------
148(define (mk-gate-guard gate-tag post passwd)
149  (println "mk-gate-guard: " gate-tag ", " post)
150  (bind
151   (set-level
152    (kern-char-arm-self
153     (mk-stock-char
154      "a guard captain" ;;......name
155      sp_human ;;.........species
156      oc_warrior ;;........occupation
157      s_companion_paladin ;;........sprite
158      faction-men ;;...faction
159      'gate-guard-ai ;;.......custom ai (optional)
160      ;;..................container (and contents, used to arm char)
161      (mk-inventory
162       (mk-contents
163        (roll-to-add 100  "3"     t_heal_potion)
164        (roll-to-add 100  "1"     t_sword)
165        (roll-to-add 199  "1"     t_shield)
166        (roll-to-add 100  "1"     t_armor_plate)
167        (roll-to-add 100  "1"     t_iron_helm)
168        (roll-to-add 100  "1d5"   t_gold_coins)
169        ))
170
171      nil ;;...............readied arms (in addition to container contents)
172      'gate-guard-conv ;;..conversation
173      ))
174    8)
175   (mk-gate-guard-gob gate-tag post passwd)))
176
177(define (put-gate-guard ktrig gate-tag passwd)
178  (println "put-gate-guard: " ktrig "," gate-tag)
179  (kern-obj-put-at (mk-gate-guard gate-tag
180                                  (cdr (kern-obj-get-location ktrig))
181                                  passwd)
182                   (kern-obj-get-location ktrig))
183  #f)
184
185;;----------------------------------------------------------------------------
186;; gate-guard generator
187;;----------------------------------------------------------------------------
188(define (mk-gate-guard-gen is-one? mk-one . mk-args)
189  (mk-mongen2 0 1 is-one? mk-one mk-args))
190