worlds/haxima-1.002/moongate.scm

   1 ;; ----------------------------------------------------------------------------
   2 ;; Moongate sprites & light levels
   3 ;; ----------------------------------------------------------------------------
   4 (define moongate-stages
   5   (list (list '()                       0)
   6         (list s_moongate_quarter        32)
   7         (list s_moongate_half           64)
   8         (list s_moongate_three_quarters 96)
   9         (list s_moongate_full           128)))
  10
  11 (define blackgate-stages
  12   (list (list '()                       0)
  13         (list s_blackgate_quarter        32)
  14         (list s_blackgate_half           64)
  15         (list s_blackgate_three_quarters 96)
  16         (list s_blackgate_full           128)))
  17
  18 (define (stage-sprite stage) (car stage))
  19 (define (stage-light stage) (* 10 (cadr stage)))
  20 (define moongate-default-ttl 10) ;; turns
  21
  22 ;; ----------------------------------------------------------------------------
  23 ;; Moongate gob
  24 ;; ----------------------------------------------------------------------------
  25 (define (moongate-mk moontag temp?)
  26   (list moontag #f '() #f temp? moongate-default-ttl))
  27
  28 (define (moongate-kdest gate)
  29   ;;(println "gate:" gate)
  30   (let ((kmoon (safe-eval (car gate))))
  31     ;;(println "moon:" kmoon)
  32     (cond ((null? kmoon) nil)
  33           (else (moon-get-current-gate kmoon)))))
  34 (define (moongate-open? gate) (cadr gate))
  35 (define (moongate-sequence gate) (caddr gate))
  36 (define (moongate-pending-open? gate) (car (cdddr gate)))
  37 (define (moongate-closed? gate) (and (not (moongate-open? gate))
  38                                      (not (moongate-pending-open? gate))))
  39 (define (moongate-is-temporary? gate) (car (cddddr gate)))
  40 (define (moongate-get-ttl gate) (list-ref gate 5))
  41 (define (moongate-set-ttl! gate val) (set-car! (list-tail gate 5) val))
  42
  43 (define (moongate-set-open! gate val)
  44   (set-car! (cdr gate) val))
  45 (define (moongate-set-sequence! gate sequence)
  46   (set-car! (cddr gate) sequence))
  47 (define (moongate-set-pending-open! gate open?)
  48   (set-car! (cdddr gate) open?))
  49
  50 (define (moongate-destroy kgate)
  51   ;;(println "moongate-destroy")
  52   (kern-obj-remove kgate))
  53
  54 ;; ----------------------------------------------------------------------------
  55 ;; Moongate cut scene
  56 ;; ----------------------------------------------------------------------------
  57 (define (moongate-animate kgate stages)
  58   (let ((view (kern-map-view-create))
  59         ;; Commented-these out to fix mouse.scm's moongate animation; doesn't
  60         ;; seem to effect the starting scene animation which is the only other
  61         ;; reference I see to this procedure. Leaving these as comments for now
  62         ;; just in case.  Update: I think commenting these out causes the
  63         ;; destination gate to remain open in normal moongate travel. Need to
  64         ;; revisit and fix all cases here. SF bug #1520871. Update 2: this was
  65         ;; fixed in moongate-cut-scene, below.
  66         ;;(original-sprite (kern-obj-get-sprite kgate))
  67         ;;(original-light (kern-obj-get-light kgate))
  68         (loc (kern-obj-get-location kgate)))
  69     (kern-map-view-add view)
  70     (kern-map-view-center view loc)
  71     (kern-map-center-camera loc)
  72     (map (lambda (stage)
  73            (kern-obj-set-sprite kgate (stage-sprite stage))
  74            (kern-obj-set-light kgate (stage-light stage))
  75            (kern-map-repaint)
  76            (kern-sleep 250))
  77          stages)
  78     ;;(kern-obj-set-sprite kgate original-sprite)
  79     ;;(kern-obj-set-light kgate original-light)
  80     (kern-map-view-rm view)
  81     (kern-map-view-destroy view)
  82     ))
  83
  84 (define (moongate-cut-scene src-kgate dest-kgate)
  85   (moongate-animate src-kgate (reverse moongate-stages))
  86   (kern-sound-play sound-moongate-enter)
  87   (kern-map-flash 1000)
  88   (kern-place-synch (car (kern-obj-get-location dest-kgate)))
  89   (moongate-animate dest-kgate moongate-stages)
  90   ;; "erase" the destination gate so it doesn't look like it remains open
  91   (if (not (eqv? dest-kgate src-kgate))
  92       (kern-obj-set-sprite dest-kgate (stage-sprite (car moongate-stages))))
  93   (let ((gate (kobj-gob-data src-kgate)))
  94     (if (moongate-is-temporary? gate)
  95         (moongate-destroy src-kgate))))
  96
  97 (define (mk-moongate-cut-scene src-kgate dest-kgate)
  98   (lambda () (moongate-cut-scene src-kgate dest-kgate)))
  99
 100
 101 ;; ----------------------------------------------------------------------------
 102 ;; Moongate signal handlers
 103 ;; ----------------------------------------------------------------------------
 104 (define (moongate-step kgate kstepper)
 105   (let ((gate (kobj-gob-data kgate)))
 106     (if (moongate-open? gate)
 107         (let ((kdest (moongate-kdest gate)))
 108           (cond ((null? kdest) (kern-print "Leads nowhere!\n"))
 109                 (else
 110                  (kern-obj-relocate kstepper
 111                                     (kern-obj-get-location kdest)
 112                                     (mk-moongate-cut-scene kgate kdest))))))))
 113
 114 ;; Opens/closes a moongate, running the animation on the timer tick (not to be
 115 ;; confused with the cut-scene animation that plays when somebody steps through
 116 ;; the gate)
 117 (define (moongate-run-sequence kgate)
 118   (let* ((gate (kobj-gob-data kgate))
 119          (stages (moongate-sequence gate)))
 120     (if (null? stages)
 121         (moongate-set-open! gate (moongate-pending-open? gate))
 122         (let ((stage (car stages)))
 123           (kern-obj-set-sprite kgate (stage-sprite stage))
 124           (kern-obj-set-light kgate (stage-light stage))
 125           (kern-map-set-dirty)
 126           (moongate-set-sequence! gate (cdr stages))
 127           (kern-add-tick-job 1 moongate-run-sequence kgate)))))
 128
 129 ;; The following version does not use the tick queue, however if you use any
 130 ;; delay at all it noticeably pauses the game. This is especially annoying when
 131 ;; the moongate is not visible or even in the same place as the player, who
 132 ;; sees only inexplicable pauses in responsiveness. To make this work smoothly
 133 ;; only moongates which have a visible or at least audible effect should cause
 134 ;; a map repaint and a pause. It will require another kernel call to determine
 135 ;; if this is the case.
 136
 137 ; (define (moongate-run-sequence kgate)
 138 ;   (let* ((gate (kobj-gob-data kgate))
 139 ;          (stages (moongate-sequence gate)))
 140 ;     (if (null? stages)
 141 ;         (moongate-set-open! gate (moongate-pending-open? gate))
 142 ;         (let ((stage (car stages)))
 143 ;           (kern-obj-set-sprite kgate (stage-sprite stage))
 144 ;           (kern-obj-set-light kgate (stage-light stage))
 145 ;           (kern-map-repaint)
 146 ;           (kern-sleep 100)
 147 ;           (moongate-set-sequence! gate (cdr stages))
 148 ;           (moongate-run-sequence kgate)))))
 149
 150
 151 (define (moongate-setup-sequence kgate gate open? stages)
 152   (moongate-set-pending-open! gate open?)
 153   (moongate-set-sequence! gate stages)
 154   (kern-add-tick-job 1 moongate-run-sequence kgate))
 155
 156 (define (moongate-open kgate)
 157   (let ((gate (kobj-gob-data kgate)))
 158     ;;(println "moongate-open:gob=" gate)
 159     (if (not (moongate-open? gate))
 160         (moongate-setup-sequence kgate gate #t moongate-stages)
 161         )))
 162
 163 (define (moongate-close kgate)
 164   ;;(println "moongate-close")
 165   (let ((gate (kobj-gob-data kgate)))
 166     (if (not (moongate-closed? gate))
 167         (moongate-setup-sequence kgate gate #f (reverse moongate-stages))
 168         )))
 169
 170 (define (moongate-init kgate)
 171   (let ((gate (kobj-gob-data kgate)))
 172     (if (moongate-open? gate)
 173         (moongate-setup-sequence kgate gate #t moongate-stages))))
 174
 175 (define (moongate-exec kgate)
 176   (let ((gate (gob kgate)))
 177     (if (moongate-is-temporary? gate)
 178         (let ((ttl (- (moongate-get-ttl gate) 1)))
 179           (moongate-set-ttl! gate ttl)
 180           (if (<= ttl 0)
 181               (begin
 182                 (moongate-animate kgate (reverse moongate-stages))
 183                 (moongate-destroy kgate)
 184                 ))))))
 185
 186 ;; ----------------------------------------------------------------------------
 187 ;; Moongate gifc, kobj-type & constructor
 188 ;; ----------------------------------------------------------------------------
 189 (define moongate-ifc
 190   (ifc '()
 191        (method 'step moongate-step)
 192        (method 'on moongate-open)
 193        (method 'off moongate-close)
 194        (method 'init moongate-init)
 195        (method 'exec moongate-exec)
 196        ))
 197
 198 (mk-obj-type 't_moongate "moongate" '() layer-mechanism moongate-ifc)
 199
 200 (define (mk-moongate moontag)
 201   (bind (kern-mk-obj t_moongate 1)
 202         (moongate-mk moontag #f)))
 203
 204 (define (summon-moongate moontag)
 205   (bind (kern-mk-obj t_moongate 1)
 206         (moongate-mk moontag #t)))