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