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