1;;---------------------------------------------------------------------------- 2;; Doors 3(define door-state-closed 0) 4(define door-state-open 1) 5(define door-state-locked 2) 6(define door-state-magic-locked 3) 7 8(define (mk-door-state sprite opacity pclass) 9 (list sprite opacity pclass)) 10(define (door-state-sprite ds) (car ds)) 11(define (door-state-opacity ds) (cadr ds)) 12(define (door-state-pclass ds) (caddr ds)) 13 14(define (mk-door-states closed open locked magic-locked) 15 (list closed open locked magic-locked)) 16 17;; Define the door gob structure and procedures. 18(define (door-mk open? timeout port active? locked? magic-locked? type) 19 (list open? timeout port active? locked? magic-locked? type nil nil)) 20(define (door-open? door) (car (gob-data door))) 21(define (door-timeout door) (cadr (gob-data door))) 22(define (door-port door) (list-ref (gob-data door) 2)) 23(define (door-active? door) (list-ref (gob-data door) 3)) 24(define (door-locked? door) (list-ref (gob-data door) 4)) 25(define (door-magic-locked? door) (list-ref (gob-data door) 5)) 26(define (door-states door) (eval (list-ref (gob-data door) 6))) 27(define (door-traps door) (list-ref (gob-data door) 7)) 28(define (door-trapped? door) (not (null? (door-traps door)))) 29(define (door-key door) (list-ref (gob-data door) 8)) 30(define (door-needs-key? door) (not (null? (door-key door)))) 31(define (door-key-fits? door ktype) 32 (let ((key (safe-eval (door-key door)))) 33 (and (not (null? key)) 34 (eqv? key ktype)))) 35 36(define (door-set-open door val) (set-car! (gob-data door) val)) 37(define (door-set-timeout! door time) (set-car! (cdr (gob-data door)) time)) 38(define (door-set-port! door port) (set-car! (cddr (gob-data door)) port)) 39(define (door-set-active! door val) (set-car! (cdddr (gob-data door)) val)) 40(define (door-set-locked! door val) (set-car! (cddddr (gob-data door)) val)) 41(define (door-set-magic-locked! door val) 42 (list-set-ref! (gob-data door) 5 val)) 43(define (door-set-traps! door val) (list-set-ref! (gob-data door) 7 val)) 44(define (door-add-trap! door trap-type) 45 (door-set-traps! door (cons (mk-trap (eval trap-type)) 46 (door-traps door)))) 47(define (door-set-key! door key-type-tag) 48 (list-set-ref! (gob-data door) 8 key-type-tag)) 49 50(define (door-send-signal kdoor sig) 51 (let ((door (kobj-gob kdoor))) 52 (if (not (door-active? door)) 53 (begin 54 (let ((port (door-port door))) 55 (door-set-active! door #t) 56 (if (not (null? port)) 57 (begin 58 ((kobj-ifc (eval port)) sig (eval port) kdoor))) 59 (door-set-active! door #f)))))) 60 61(define (door-update-kstate kdoor) 62 (define (update state-no) 63 (let ((state (list-ref (door-states (kobj-gob kdoor)) state-no))) 64 (kern-obj-set-sprite kdoor (door-state-sprite state)) 65 (kern-obj-set-opacity kdoor (door-state-opacity state)) 66 (kern-obj-set-pclass kdoor (door-state-pclass state)))) 67 (let ((door (kobj-gob kdoor))) 68 (cond ((door-magic-locked? door) (update door-state-magic-locked)) 69 ((door-locked? door) (update door-state-locked)) 70 ((door-open? door) (update door-state-open)) 71 (else (update door-state-closed)))) 72 (kern-map-set-dirty) 73 kdoor) 74 75(define (door-trip-traps kdoor kchar) 76 (let ((door (kobj-gob kdoor)) 77 ) 78 (kern-obj-inc-ref kdoor) 79 (kern-obj-inc-ref kchar) 80 (map (lambda (trap) 81 (trap-trigger trap kdoor kchar)) 82 (door-traps door)) 83 (door-set-traps! door nil) 84 (kern-obj-dec-ref kdoor) 85 (kern-obj-dec-ref kchar))) 86 87(define (door-open kdoor khandler) 88 (let ((door (kobj-gob kdoor))) 89 (cond 90 ((door-magic-locked? door) 91 (kern-log-msg "Magically locked!\n") 92 #f) 93 ((door-locked? door) 94 (kern-log-msg "Locked!\n") 95 #f) 96 ((door-trapped? door) 97 (door-trip-traps kdoor khandler) 98 (door-open kdoor khandler) 99 ) 100 (else 101 (door-set-open door #t) 102 (door-set-timeout! door 10) 103 (door-update-kstate kdoor) 104 (door-send-signal kdoor 'open) 105 #t)))) 106 107(define (door-close kdoor khandler) 108 ;;(display "door-close")(newline) 109 (if (not (occupied? (kern-obj-get-location kdoor))) 110 (let ((door (kobj-gob kdoor))) 111 (door-set-open door #f) 112 (door-set-timeout! door 0) 113 (door-update-kstate kdoor) 114 (door-send-signal kdoor 'close) 115 #t))) 116 117(define (door-lock kdoor khandler) 118 (let ((door (kobj-gob kdoor))) 119 ;;(display "door-lock:")(display door)(newline) 120 (cond ((door-open? door) (kern-log-msg "Not closed!\n") #f) 121 ((door-locked? door) (kern-log-msg "Already locked!\n") #f) 122 (else 123 (door-set-locked! door #t) 124 (door-update-kstate kdoor) 125 #t)))) 126 127(define (door-unlock kdoor khandler) 128 (let ((door (kobj-gob kdoor))) 129 ;;(display "door-unlock:")(display door)(newline) 130 (cond ((door-open? door) (kern-log-msg "Not closed!\n") #f) 131 ((not (door-locked? door)) (kern-log-msg "Not locked!\n") #f) 132 ((door-needs-key? door) (kern-log-msg "Needs the key!\n") #f) 133 (else 134 (door-set-locked! door #f) 135 (door-update-kstate kdoor) 136 #t)))) 137 138(define (door-magic-lock kdoor khandler) 139 (let ((door (kobj-gob kdoor))) 140 ;;(display "door-magic-lock:")(display door)(newline) 141 (cond ((door-open? door) (kern-log-msg "Not closed!\n") #f) 142 ((door-magic-locked? door) 143 (kern-log-msg "Already magically locked!\n") #f) 144 (else 145 (door-set-magic-locked! door #t) 146 (door-update-kstate kdoor) 147 #t)))) 148 149(define (door-magic-unlock kdoor khandler) 150 (let ((door (kobj-gob kdoor))) 151 ;;(display "door-magic-unlock:")(display door)(newline) 152 (cond ((door-open? door) (kern-log-msg "Not closed!\n") #f) 153 ((not (door-magic-locked? door)) 154 (kern-log-msg "Not magically locked!\n") #f) 155 (else 156 (door-set-magic-locked! door #f) 157 (door-update-kstate kdoor) 158 #t)))) 159 160(define (door-handle kdoor khandler) 161 (let ((door (kobj-gob kdoor))) 162 (if (door-open? door) 163 (door-close kdoor khandler) 164 (door-open kdoor khandler)))) 165 166(define (door-exec kdoor) 167 (let ((door (kobj-gob kdoor))) 168 (if (door-open? door) 169 (let ((timeout (door-timeout door))) 170 (cond ((> timeout 1) (door-set-timeout! door (- timeout 1))) 171 ((= timeout 1) (door-close kdoor '()))))))) 172 173 174(define (door-connect kobj kto-tag) 175 (let ((door (kobj-gob kobj))) 176 (door-set-port! door kto-tag))) 177 178(define (door-add-trap kdoor trap-sym) 179 (let ((door (kobj-gob kdoor))) 180 (door-add-trap! door trap-sym))) 181 182(define (door-get-traps kdoor) 183 (door-traps (kobj-gob kdoor))) 184 185(define (door-rm-traps kdoor) 186 (let ((door (kobj-gob kdoor))) 187 (door-set-traps! door nil))) 188 189(define (door-use-key kdoor key-type) 190 (let ((door (kobj-gob kdoor))) 191 (cond ((door-open? door) (kern-log-msg "Not closed!")) 192 ((not (door-key-fits? door key-type)) (kern-log-msg "Key won't fit!")) 193 ((door-locked? door) 194 (door-set-locked! door #f) 195 (door-update-kstate kdoor)) 196 (else 197 (door-set-locked! door #t) 198 (door-update-kstate kdoor))))) 199 200(define (door-search kdoor kchar) 201 (kern-log-begin "Searching door...") 202 (let ((door (kobj-gob kdoor))) 203 (if (foldr (lambda (detected? trap) 204 (trap-search trap kdoor kchar) 205 (if (trap-tripped? trap) 206 (door-set-traps! door 207 (filter (lambda (trap2) 208 (not (equal? trap trap2))) 209 (door-traps door)))) 210 (or detected? (trap-detected? trap))) 211 #f 212 (door-traps door)) 213 (kern-log-end "Trap detected!") 214 (kern-log-end "No traps detected!") 215 ))) 216 217(define (door-describe kdoor count) 218 (let ((door (kobj-gob kdoor))) 219 (kern-log-continue "a ") 220 (if (door-magic-locked? door) 221 (kern-log-continue "magically locked, ")) 222 (if (door-locked? door) 223 (if (door-needs-key? door) 224 (kern-log-continue "locked (with a key), ") 225 (kern-log-continue "padlocked, "))) 226 (if (door-open? door) 227 (kern-log-continue "open door ") 228 (kern-log-continue "closed door ")) 229 (kern-log-continue "(") 230 (if (foldr (lambda (described? trap) 231 (cond ((trap-detected? trap) 232 (if described? 233 (kern-log-continue ", ")) 234 (kern-log-continue (trap-name trap)) 235 (if (trap-tripped? trap) 236 (kern-log-continue "[disarmed]")) 237 #t) 238 (else described?))) 239 #f 240 (door-traps door)) 241 (kern-log-continue " trap(s) detected") 242 (kern-log-continue "no traps detected") 243 ) 244 (kern-log-continue ")") 245 )) 246 247(define (door-get-unlock-dc kdoor) 248 (let ((val (door-locked? (kobj-gob kdoor)))) 249 ;; make it backwards-compatible for old saved games where the value is a bool 250 (if (number? val) 251 val 252 (if val dc-normal 0)))) 253 254(define (door-get-magic-unlock-dc kdoor) 255 (let ((val (door-magic-locked? (kobj-gob kdoor)))) 256 ;; make it backwards-compatible for old saved games where the value is a bool 257 (if (number? val) 258 val 259 (if val dc-normal 0)))) 260 261(define door-ifc 262 (ifc '() 263 (method 'exec door-exec) 264 (method 'handle door-handle) 265 (method 'open door-open) 266 (method 'close door-close) 267 (method 'init door-update-kstate) 268 (method 'connect door-connect) 269 (method 'lock door-lock) 270 (method 'unlock door-unlock) 271 (method 'magic-lock door-magic-lock) 272 (method 'magic-unlock door-magic-unlock) 273 (method 'add-trap door-add-trap) 274 (method 'get-traps door-get-traps) 275 (method 'rm-traps door-rm-traps) 276 (method 'use-key door-use-key) 277 (method 'search door-search) 278 (method 'describe door-describe) 279 (method 'get-unlock-dc door-get-unlock-dc) 280 (method 'get-magic-unlock-dc door-get-magic-unlock-dc) 281 )) 282 283;; Create the kernel "door" type 284(mk-obj-type 't_door "door" s_stone_arch layer-mechanism 285 door-ifc) 286 287(define (door-state-factory 288 arch-sprite door-sprite magic-sprite 289 open-opacity closed-opacity 290 open-pclass closed-pclass) 291 (mk-door-states 292 (mk-door-state (mk-composite-sprite (list arch-sprite door-sprite)) 293 closed-opacity closed-pclass) 294 (mk-door-state arch-sprite open-opacity open-pclass) 295 (mk-door-state (mk-composite-sprite (list arch-sprite door-sprite s_door_lock)) 296 closed-opacity closed-pclass) 297 (mk-door-state (mk-composite-sprite (list arch-sprite door-sprite s_door_magiclock)) 298 closed-opacity closed-pclass) 299 )) 300 301;; Types for common door types 302(define solid-wood-door-in-stone 303 (door-state-factory 304 s_stone_arch s_door_wood s_door_magiclock 305 #f #t 306 pclass-none pclass-wall)) 307 308(define windowed-wood-door-in-stone 309 (door-state-factory 310 s_stone_arch s_door_windowed s_door_magiclock 311 #f #f 312 pclass-none pclass-window)) 313 314(define solid-wood-door-in-rock 315 (door-state-factory 316 s_rock_arch s_door_wood s_door_magiclock 317 #f #t 318 pclass-none pclass-wall)) 319 320(define windowed-wood-door-in-rock 321 (door-state-factory 322 s_rock_arch s_door_windowed s_door_magiclock 323 #f #f 324 pclass-none pclass-window)) 325 326;;---------------------------------------------------------------------------- 327;; mk-door -- make and initialize a door object 328;; 329;; Used by the startup scripts when creating new doors. 330;; 331;; type: one of the door state sets listed above 332;; locked: true iff door starts out locked 333;; magic-locked: true iff door starts out magically locked 334;; connected-to: nil, or the tag of an object the door forwards signals to 335;;---------------------------------------------------------------------------- 336(define (mk-door-full type locked? magic-locked? connected-to) 337 (bind (kern-mk-obj t_door 1) 338 (door-mk #f 0 connected-to #f locked? magic-locked? type))) 339 340;; Backward-compatible curried constructors 341(define (mk-door) (mk-door-full 'solid-wood-door-in-stone #f #f nil)) 342(define (mk-door-in-rock) (mk-door-full 'solid-wood-door-in-rock #f #f nil)) 343(define (mk-locked-door) (mk-door-full 'solid-wood-door-in-stone #t #f nil)) 344(define (mk-locked-door-in-rock) (mk-door-full 'solid-wood-door-in-rock #t #f nil)) 345(define (mk-connected-door tag) (mk-door-full 'solid-wood-door-in-stone #f #f tag)) 346(define (mk-windowed-door) (mk-door-full 'windowed-wood-door-in-stone #f #f nil)) 347(define (mk-windowed-door-in-rock) (mk-door-full 'windowed-wood-door-in-rock #f #f nil)) 348(define (mk-magic-locked-door) (mk-door-full 'solid-wood-door-in-stone #f #t nil)) 349(define (mk-locked-windowed-door) 350 (mk-door-full 'windowed-wood-door-in-stone #t #f nil)) 351(define (mk-locked-windowed-door-in-rock) 352 (mk-door-full 'windowed-wood-door-in-rock #t #f nil)) 353 354(define (lock-door-with-key kdoor key-type-tag) 355 (lock-door kdoor nil) 356 (door-set-key! (kobj-gob kdoor) key-type-tag) 357 ) 358 359 360;; Add a trap to a door 361(define (trap-door kdoor trap-tag) 362 (ifccall kdoor 'add-trap trap-tag) 363 kdoor 364 ) 365 366(mk-obj-type 't_archway_rock "archway" s_rock_arch layer-mechanism 367 nil) 368 369(mk-obj-type 't_archway_stone "archway" s_stone_arch layer-mechanism 370 nil) 371 372(define (mk-archway-rock) (kern-mk-obj t_archway_rock 1)) 373 374(define (mk-archway-stone) (kern-mk-obj t_archway_rock 1)) 375 376 377