Scriptable scroll speed!

1 files changed, 76 insertions, 40 deletions

diff --git a/game.scm b/game.scm
index aa478ab..c9592c0 100644
--- a/game.scm
+++ b/game.scm
@@ -215,6 +215,18 @@
              ((> x max) max)
              (else x)))
 
+     (define (smoothstep t)
+       (* t t (- 3.0 (* 2.0 t))))
+
+     (define (lerp start end alpha)
+       (+ (* start (- 1.0 alpha))
+          (* end alpha)))
+
+     (define (assq-ref lst key)
+       (match (assq key lst)
+         (#f #f)
+         ((_ . val) val)))
+
      (define-type vec2
        make-vec2
        vec2?
@@ -325,6 +337,8 @@
      (define sound:enemy-shoot (load-sound-effect "audio/enemy-shoot.wav"))
      (define sound:bullet-hit (load-sound-effect "audio/bullet-hit.wav"))
 
+     (define *debug?* #f)
+
      ;; Scripting
      (define (make-scheduler max-tasks)
        (vector 0 0 max-tasks (make-vector max-tasks)))
@@ -417,6 +431,14 @@
        (let loop ()
          body ...
          (loop)))
+     (define* (tween proc duration start end ease interpolate)
+       (let loop ((t 0))
+         (if (= t duration)
+             (proc end)
+             (let ((alpha (ease (/ t duration))))
+               (proc (interpolate start end alpha))
+               (wait 1)
+               (loop (+ t 1))))))
 
      ;; Particles:
      (define-type particle-pool
@@ -611,6 +633,12 @@
      (define *scroll* 0.0)
      (define *last-scroll* 0.0)
      (define *scroll-speed* 0.5)
+     (define (change-scroll-speed new-speed duration)
+       (tween (lambda (speed)
+                (set! *scroll-speed* speed))
+              duration
+              *scroll-speed* new-speed
+              smoothstep lerp))
      (define *last-row-scanned* 0)
      ;; action id, sprite sheet offset, x, y
      (define %tile-size (+ 4 8 8 8))
@@ -621,7 +649,8 @@
        make-level-object
        level-object?
        (x level-object-x set-level-object-x!)
-       (type level-object-type set-level-object-type!))
+       (type level-object-type set-level-object-type!)
+       (properties level-object-properties set-level-object-properties!))
      (define-type level
        make-level
        level?
@@ -683,6 +712,19 @@
        (match level
          (#('level height foreground collision objects)
           (draw-level-layer level foreground 1.0))))
+     (define (do-level-action type x y properties)
+       (match type
+         ('turret (spawn-turret x y))
+         ('popcorn (spawn-popcorn x y))
+         ('flyer0 (spawn-flyer0 x y))
+         ('flyer1 (spawn-flyer1 x y))
+         ('boss (spawn-boss x y))
+         ('scroll-speed
+          (let ((speed (assq-ref properties 'speed))
+                (ticks (or (assq-ref properties 'ticks) 0)))
+            (when speed
+              (change-scroll-speed speed ticks))))
+         (_ #t)))
      (define max-scroll (- (* (level-height level) tile-height) game-height))
      (define (level-update! level)
        (match level
@@ -699,18 +741,12 @@
                   ((= y *last-row-scanned*))
                 (for-each (lambda (obj)
                             (match obj
-                              (#('level-object x type)
+                              (#('level-object x type properties)
                                (let ((x* (+ (* x tile-width)
                                             (/ tile-width 2.0)))
                                      (y* (+ (* (- y row 3) tile-height)
                                             (/ tile-height 2.0))))
-                                 (match type
-                                   ('turret (spawn-turret x* y*))
-                                   ('popcorn (spawn-popcorn x* y*))
-                                   ('flyer0 (spawn-flyer0 x* y*))
-                                   ('flyer1 (spawn-flyer1 x* y*))
-                                   ('boss (spawn-boss x* y*))
-                                   (_ #t))))))
+                                 (do-level-action type x* y* properties)))))
                           (vector-ref objects y)))
               (set! *last-row-scanned* row))))))
 
@@ -722,7 +758,6 @@
        (health enemy-health set-enemy-health!)
        (position enemy-position set-enemy-position!)
        (size enemy-size set-enemy-size!)
-       (stationary? enemy-stationary? set-enemy-stationary!)
        (velocity enemy-velocity set-enemy-velocity!)
        (script enemy-script set-enemy-script!)
        (points enemy-points set-enemy-points!)
@@ -730,9 +765,9 @@
        (animation enemy-animation set-enemy-animation!)
        (image enemy-image set-enemy-image!)
        (image-size enemy-image-size set-enemy-image-size!))
-     (define (make-enemy type health position size stationary? velocity
+     (define (make-enemy type health position size velocity
                          script points animation image image-size)
-       (%make-enemy type health position size stationary? velocity script
+       (%make-enemy type health position size velocity script
                     points (inexact (current-jiffy)) animation image
                     image-size))
      (define (enemy-x enemy)
@@ -753,18 +788,18 @@
        (set-vec2-y! (enemy-velocity enemy) dy))
      (define (enemy-damage! enemy damage)
        (match enemy
-         (#('enemy type health _ _ _ _ _ _ _ _ _ _)
+         (#('enemy type health _ _ _ _ _ _ _ _ _)
           (set-enemy-health! enemy (- health damage)))))
      (define (enemy-dead? enemy)
        (<= (enemy-health enemy) 0))
      (define (enemy-out-of-bounds? enemy)
        (match enemy
-         (#('enemy _ _ position size _ _ _ _ _ _ _ _)
+         (#('enemy _ _ position size _ _ _ _ _ _ _)
           (out-of-bounds? (vec2-x position) (vec2-y position)
                           (vec2-x size) (vec2-y size)))))
      (define (enemy-within-rect? enemy x y w h)
        (match enemy
-         (#('enemy _ _ position size _ _ _ _ _ _ _ _)
+         (#('enemy _ _ position size _ _ _ _ _ _ _)
           (let* ((w* (vec2-x size))
                  (h* (vec2-y size))
                  (x* (- (vec2-x position) (/ w* 2.0)))
@@ -780,18 +815,15 @@
            (script-cancel! script))))
      (define (enemy-update! enemy)
        (match enemy
-         (#('enemy _ _ position size stationary? velocity _ _ _ _ _ _)
+         (#('enemy _ _ position size velocity _ _ _ _ _ _)
           (let ((scroll-dy (- *scroll* *last-scroll*)))
-            (if stationary?
-                (set-vec2-y! position (+ (vec2-y position) scroll-dy))
-                (begin
-                  (set-vec2-x! position (+ (vec2-x position) (vec2-x velocity)))
-                  (set-vec2-y! position (+ (vec2-y position)
-                                           (+ (vec2-y velocity) scroll-dy)))))))))
+            (set-vec2-x! position (+ (vec2-x position) (vec2-x velocity)))
+            (set-vec2-y! position (+ (vec2-y position)
+                                     (+ (vec2-y velocity) scroll-dy)))))))
      (define (draw-enemy enemy time)
        (let ((frame-duration 250.0))
          (match enemy
-           (#('enemy type _ position size _ _ _ _ spawn-time animation
+           (#('enemy type _ position size _ _ _ spawn-time animation
                      image image-size)
             (let* ((tx (vector-ref animation
                                    (modulo (truncate
@@ -806,12 +838,12 @@
                    (h (vec2-y image-size)))
               (draw-image context image tx 0.0 w h
                           (- x (/ w 2.0)) (- y (/ h 2.0)) w h)
-              ;; (set-fill-color! context "#ff00ff80")
-              ;; (fill-rect context
-              ;;            (- x (/ hbw 2.0))
-              ;;            (- y (/ hbh 2.0))
-              ;;            hbw hbh)
-              )))))
+              (when *debug?*
+                (set-fill-color! context "#ff00ff80")
+                (fill-rect context
+                           (- x (/ hbw 2.0))
+                           (- y (/ hbh 2.0))
+                           hbw hbh)))))))
 
      (define-type enemy-pool
        %make-enemy-pool
@@ -894,25 +926,25 @@
      (define (spawn-turret* x y script)
        (spawn-enemy
         (make-enemy 'turret 10 (vec2 x y) (vec2 12.0 12.0)
-                    #t (vec2 0.0 0.0) script 100
+                    (vec2 0.0 0.0) script 100
                     #(0.0 0.0 0.0 0.0) image:turret (vec2 32.0 32.0))))
 
      (define (spawn-popcorn* x y script)
        (spawn-enemy
         (make-enemy 'popcorn 1 (vec2 x y) (vec2 12.0 12.0)
-                    #t (vec2 0.0 0.0) script 100
+                    (vec2 0.0 0.0) script 100
                     #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0))))
 
      (define (spawn-flyer0* x y script)
        (spawn-enemy
         (make-enemy 'flyer0 20 (vec2 x y) (vec2 12.0 12.0)
-                    #f (vec2 0.0 0.0) script 100
+                    (vec2 0.0 0.0) script 100
                     #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0))))
 
      (define (spawn-flyer1* x y script)
        (spawn-enemy
         (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0)
-                    #f (vec2 0.0 0.0) script 100
+                    (vec2 0.0 0.0) script 100
                     #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0))))
 
      (define (spawn-turret x y)
@@ -965,7 +997,7 @@
      (define (spawn-boss x y)
        (spawn-enemy
         (make-enemy 'boss 300 (vec2 x y) (vec2 100.0 40.0)
-                    #t (vec2 0.0 0.0) #f 1000000
+                    (vec2 0.0 0.0) #f 1000000
                     #(0.0 0.0 0.0 0.0) image:boss (vec2 120.0 80.0))))
 
      ;; Player state:
@@ -1122,12 +1154,13 @@
                    (- (vec2-y player-position)
                       (/ player-height 2.0))
                    player-width player-height)
-       (set-fill-color! context "#ff00ff80")
-       (fill-rect context
-                  (vec2-x player-hitbox-position)
-                  (vec2-y player-hitbox-position)
-                  player-hitbox-width
-                  player-hitbox-height))
+       (when *debug?*
+         (set-fill-color! context "#ff00ff80")
+         (fill-rect context
+                    (vec2-x player-hitbox-position)
+                    (vec2-y player-hitbox-position)
+                    player-hitbox-width
+                    player-hitbox-height)))
      (define (direction-to-player v)
        (let ((v* (vec2 (vec2-x player-position) (vec2-y player-position))))
          (vec2-sub! v* v)
@@ -1284,6 +1317,9 @@
                ((string-=? code "Enter")
                 (set! *game-state* 'paused)
                 (prevent-default! event))
+               ((string-=? code "KeyD")
+                (set! *debug?* (not *debug?*))
+                (prevent-default! event))
                ((string-=? code "KeyR")
                 (reset!)
                 (prevent-default! event))