worlds/haxima-1.002/wind-bridge.scm

   1 ;; A wind bridge appears to rotates in the wind. It blits a map to lay down the
   2 ;; bridge terrain. Position the object in the upper left corner of where the
   3 ;; bridge map should be blitted. The bridge will delay a few turns before
   4 ;; turning, giving the player some time to get to safety.
   5
   6 (kern-mk-map
   7  'm_wind_bridge_ns 9 9 pal_expanded
   8  (list
   9   "vv vv vv vv ee vv vv vv vv "
  10   "vv vv vv vv ee vv vv vv vv "
  11   "vv vv vv vv ee vv vv vv vv "
  12   "vv vv vv ee ee ee vv vv vv "
  13   "vv vv vv ee oo ee vv vv vv "
  14   "vv vv vv ee ee ee vv vv vv "
  15   "vv vv vv vv ee vv vv vv vv "
  16   "vv vv vv vv ee vv vv vv vv "
  17   "vv vv vv vv ee vv vv vv vv "
  18   ))
  19
  20 (kern-mk-map
  21  'm_wind_bridge_ew 9 9 pal_expanded
  22  (list
  23   "vv vv vv vv vv vv vv vv vv "
  24   "vv vv vv vv vv vv vv vv vv "
  25   "vv vv vv vv vv vv vv vv vv "
  26   "vv vv vv ee ee ee vv vv vv "
  27   "ee ee ee ee oo ee ee ee ee "
  28   "vv vv vv ee ee ee vv vv vv "
  29   "vv vv vv vv vv vv vv vv vv "
  30   "vv vv vv vv vv vv vv vv vv "
  31   "vv vv vv vv vv vv vv vv vv "
  32   ))
  33
  34 (define (wind-bridge-mk) (list here 0))
  35 (define (wind-bridge-facing gob) (car gob))
  36 (define (wind-bridge-delay gob) (cadr gob))
  37 (define (wind-bridge-set-facing! gob val) (set-car! gob val))
  38 (define (wind-bridge-inc-delay! gob) (set-car! (cdr gob) (+ 1 (cadr gob))))
  39 (define (wind-bridge-reset-delay! gob) (set-car! (cdr gob) 0))
  40
  41 (define (wind-bridge-exec kobj)
  42   (let ((wind (kern-get-wind))
  43         (gob (gob kobj))
  44         (loc (kern-obj-get-location kobj))
  45         )
  46      (define (check-fall offset)
  47                 (map chasm-fall (kern-get-objects-at (mk-loc (loc-place loc)
  48                             (+ (loc-x loc) (car offset))
  49                             (+ (loc-y loc) (cadr offset))))
  50                 ))
  51     ;;(println "wind=" wind "gob=" gob "loc=" loc)
  52      (define (turn amap dir)
  53       (cond ((< (wind-bridge-delay gob) 2)
  54              (kern-log-msg "The bridge creaks in the wind!")
  55              (wind-bridge-inc-delay! gob))
  56             (else
  57              (kern-blit-map (kern-place-map (loc-place loc))
  58                             (loc-x loc)
  59                             (loc-y loc)
  60                             amap 0 0 9 9)
  61              (map check-fall
  62                 (list
  63                         (list 4 0)
  64                         (list 4 1)
  65                         (list 4 2)
  66                         (list 4 6)
  67                         (list 4 7)
  68                         (list 4 8)
  69                         (list 0 4)
  70                         (list 1 4)
  71                         (list 2 4)
  72                         (list 6 4)
  73                         (list 7 4)
  74                         (list 8 4)
  75                                         )
  76                                         )
  77              (wind-bridge-set-facing! gob dir)
  78              (wind-bridge-reset-delay! gob)
  79              )))
  80     (cond ((and (or (= wind north)
  81                     (= wind south))
  82                 (not (= (wind-bridge-facing gob) north)))
  83            (turn m_wind_bridge_ns north)
  84            )
  85           ((and (or (= wind east)
  86                     (= wind west))
  87                 (not (= (wind-bridge-facing gob) east)))
  88            (turn m_wind_bridge_ew east)
  89            )
  90           (else
  91            (wind-bridge-reset-delay! gob)
  92           ))))
  93
  94 (define wind-bridge-ifc
  95   (ifc '()
  96        (method 'exec wind-bridge-exec)
  97        ))
  98
  99 ;; Make a kernel portcullis type
 100 (mk-obj-type 't_wind_bridge nil nil layer-mechanism wind-bridge-ifc)
 101
 102 ;; Define a constructor
 103 (define (mk-wind-bridge)
 104   (bind (make-invisible (kern-mk-obj t_wind_bridge 1))
 105         (wind-bridge-mk)))