1;; A lever is a basic binary mechanism.
2
3(define (lever-state on?)
4  (if on?
5      (state-mk 's_R_lever_up #f pclass-none 0)
6      (state-mk 's_R_lever_down #f pclass-none 0)))
7
8(define lever-ifc
9  (ifc bim-ifc
10       (method 'handle bim-toggle)
11       (method 'state lever-state)))
12
13(mk-obj-type 't_lever "lever" '() layer-mechanism lever-ifc)
14
15(define (mk-lever dest-tag)
16  (bind (kern-mk-obj t_lever 1)
17        (bim-mk #f dest-tag nil)))
18
19(define (mk-lever-on dest-tag)
20  (bind (kern-mk-obj t_lever 1)
21        (bim-mk #t dest-tag nil)))
22
23(define (mk-lever-with-id dest-tag id)
24  (bind (kern-mk-obj t_lever 1)
25         (bim-mk #f dest-tag id)))
26
27
28;;----------------------------------------------------------------------------
29;; Disguised lever
30;;----------------------------------------------------------------------------
31(define (disg-lvr-state on? klvr)
32  (let ((bim (kobj-gob-data klvr)))
33    (state-mk (bim-members bim) #f pclass-none 0)))
34
35(define disg-lvr-ifc
36  (ifc bim-ifc
37       (method 'handle bim-toggle)
38       (method 'state disg-lvr-state)))
39
40(mk-obj-type 't_disg_lvr nil '() layer-mechanism disg-lvr-ifc)
41
42(define (mk-disg-lvr dest-tag sprite-tag)
43  (bind (kern-mk-obj t_disg_lvr 1)
44        (bim-mk #f dest-tag sprite-tag)))
45
46
47;;----------------------------------------------------------------------------
48;; Searchable Description of hidden mechanisms
49;;----------------------------------------------------------------------------
50
51(mk-obj-type 't_hidden_mech  ;; tag
52             "hidden mechanism"       ;; name
53             s_blank    ;; sprite
54             layer-tfeat    ;; stacking layer
55             nil    ;; interface
56             )
57
58(define (mk-hidden-mech)
59	(mk-hidden 't_hidden_mech 1))
60