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