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