worlds/haxima-1.002/lever.scm

   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))