1(define (trig-mk proc-tag args) (cons proc-tag args))
2(define (trig-proc trg) (eval (car trg)))
3(define (trig-args trg) (cdr trg))
4(define (trig-invoke trg . more-args)
5  (println "more-args: " more-args)
6  (println "trig-args: " (trig-args trg))
7  (apply (trig-proc trg)
8         (append more-args (trig-args trg))))
9
10;;----------------------------------------------------------------------------
11;; Step trigger -- executes a named procedure whan a character steps on it.
12;; The procedure should expect a kernel being as the first arg followed by
13;; the optional args.
14;;----------------------------------------------------------------------------
15(define (step-trig-exec ktrig kbeing)
16  (let ((trg (gob ktrig)))
17    (if (trig-invoke trg kbeing)
18        (kern-obj-remove ktrig))))
19
20(define step-trig-ifc
21  (ifc '()
22       (method 'step step-trig-exec)))
23
24(mk-obj-type 't_step_trig nil nil layer-mechanism step-trig-ifc)
25
26(define (mk-step-trig proc-tag . args)
27  (bind (make-invisible (kern-mk-obj t_step_trig 1))
28        (trig-mk proc-tag args)))
29
30;;-----------------------------------------------------------------------------
31;; Sense trigger -- just like a step trigger, but responds to the 'sense signal
32;; instead, which is sent anytime a character enters or leaves its tile
33;;-----------------------------------------------------------------------------
34(define sense-trig-ifc
35  (ifc '()
36       (method 'sense step-trig-exec)))
37
38(mk-obj-type 't_sense_trig nil nil layer-mechanism sense-trig-ifc)
39
40(define (mk-sense-trig proc-tag . args)
41  (bind (make-invisible (kern-mk-obj t_sense_trig 1))
42        (trig-mk proc-tag args)))
43
44;;----------------------------------------------------------------------------
45;; Procedure for use with step or sense triggers. kchar is the character which
46;; caused the trigger by stepping on the tile (or off it, in the case of a
47;; sense trigger). target-tag is the object which will receive the message
48;; sigval.
49;;
50;; Example:
51;;
52;;   (put (kern-tag 'p1 (mk-portcullis)) 3 4)
53;;   (put (mk-sense-trig 'generic-trig-exec 'p1 'signal) 10 23)
54;;
55;; Whenever anybody enters tile (10, 23), the portcullis at (3, 4) will open in
56;; response to the "signal" message. . When they leave, it will close again.
57;;----------------------------------------------------------------------------
58(define (generic-trig-exec kchar target-tag sigval)
59  (send-signal kchar (eval target-tag) sigval)
60  #f)
61
62;;----------------------------------------------------------------------------
63;; 'on trigger -- object which executes a named procedure when it gets the 'on
64;; signal from something.
65;;----------------------------------------------------------------------------
66(define (on-trig-exec ktrig)
67  (let ((trg (gob ktrig)))
68    (if (trig-invoke trg ktrig)
69        (kern-obj-remove ktrig))))
70
71(define on-trig-ifc
72  (ifc '()
73       (method 'on on-trig-exec)))
74
75(mk-obj-type 't_on_trig nil nil layer-mechanism on-trig-ifc)
76
77(define (mk-on-trig proc-tag args)
78  (bind (make-invisible (kern-mk-obj t_on_trig 1))
79        (trig-mk proc-tag args)))
80
81;;------------------------------------------------------------------------
82;; sensor pad - sends a remote-sensor ifc call when it detects someone
83;;	enters or leaves its tile
84;;------------------------------------------------------------------------
85
86(define char-sensor-ifc
87  (ifc '() (method 'sense
88                   (lambda (ksensor kuser)
89                     (send-signal kuser (eval (gob ksensor)) 'remote-sensor)
90                     ))
91       ))
92
93(mk-obj-type 't_char_sensor nil nil layer-mechanism char-sensor-ifc)
94
95(define (mk-char-sensor target-tag)
96  (bind (make-invisible (kern-mk-obj t_char_sensor 1))
97        target-tag))
98
99;;----------------------------------------------------------------------------
100;; Terrain-changer -- procedure for a step trigger to set the terrain at (x, y)
101;; to kter. kbeing triggered the step. This returns #t so that it is used only
102;; once.
103;;
104(define (terrain-changer kbeing x y kter)
105  (kern-place-set-terrain (list (get-place kbeing) x y)
106                          (eval kter))
107  #t)