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)