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