1;; A portcullis is a trivial extension of the binary mechanism. It responds to 2;; a generic 'signal by toggling its state. 3 4;; Extend the bim interface to support the 'signal message 5(define (portcullis-state on?) 6 (if on? 7 (state-mk 's_portcullis_up #f pclass-none 0) 8 (state-mk 's_portcullis_down #f pclass-bars 0))) 9 10(define (kportcullis-manual kobj khandler) 11 (kern-log-msg "Portcullis won't budge!")) 12 13(define portcullis-ifc 14 (ifc bim-ifc 15 (method 'open kportcullis-manual) 16 (method 'close kportcullis-manual) 17 (method 'open-remote bim-on) 18 (method 'close-remote bim-off) 19 (method 'signal bim-toggle) 20 (method 'state portcullis-state) 21 )) 22 23;; Make a kernel portcullis type 24(mk-obj-type 't_portcullis "portcullis" nil layer-mechanism portcullis-ifc) 25 26;; Define a constructor 27(define (mk-connected-portcullis dest-tag) 28 (bind (kern-mk-obj t_portcullis 1) 29 (bim-mk #f dest-tag nil))) 30 31(define (mk-portcullis) 32 (mk-connected-portcullis nil)) 33 34(define (mk-open-portcullis) 35 (bind (kern-mk-obj t_portcullis 1) 36 (bim-mk #t nil nil))) 37