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