diff options
Diffstat (limited to 'game.scm')
-rw-r--r-- | game.scm | 217 |
1 files changed, 131 insertions, 86 deletions
@@ -132,6 +132,9 @@ "image" "new" (ref string) -> (ref extern)) + ;; Record types are only just beginning to be added to Hoot and + ;; there isn't support for mutable structs, yet. So, tagged + ;; vectors will have to do. (define-syntax-rule (define-type name constructor predicate @@ -157,40 +160,41 @@ (vector-set! obj i val)))))) ...)) - ;; TODO: Add basic fmod as inline wasm function - - ;; Hoot's exact and inexact aren't working right. These next two - ;; procedures are alternatives for now. - (define (trunc x) - ;; rational? is also borked so can't use that here. - (unless (and (number? x) (inexact? x)) - (error "expected inexact rational" x)) + (define (assert-float x) + (unless (and (number? x) (inexact? x) (rational? x)) + (error "expected inexact rational" x))) + (define (truncate x) + (assert-float x) (%inline-wasm '(func (param $x (ref eq)) (result (ref eq)) (call $s64->scm (i64.trunc_f64_s (struct.get $flonum $val (ref.cast $flonum (local.get $x)))))) x)) - (define (inexact x) - (unless (exact-integer? x) - (error "expected exact integer" x)) + (define (fmod x y) + (assert-float x) + (assert-float y) (%inline-wasm - '(func (param $x (ref eq)) (result (ref eq)) - (if (ref eq) - (call $fixnum? (local.get $x)) - (then - (struct.new $flonum - (i32.const 0) - (f64.convert_i32_s - (call $fixnum->i32 (ref.cast i31 (local.get $x)))))) - (else - (struct.new $flonum - (i32.const 0) - (f64.convert_i64_s - (call $bignum-get-i64 - (struct.get $bignum $val - (ref.cast $bignum (local.get $x))))))))) - x)) + '(func (param $x (ref eq)) (param $y (ref eq)) (result (ref eq)) + (struct.new + $flonum + (i32.const 0) + (f64.sub (struct.get + $flonum $val + (ref.cast $flonum (local.get $x))) + (f64.mul + (f64.trunc + (f64.div + (struct.get $flonum $val + (ref.cast $flonum + (local.get $x))) + (struct.get $flonum $val + (ref.cast $flonum + (local.get $y))))) + (struct.get $flonum $val + (ref.cast $flonum + (local.get $y))))))) + x y)) (define s32-ref bytevector-s32-native-ref) (define s32-set! bytevector-s32-native-set!) @@ -198,7 +202,6 @@ (define f64-set! bytevector-ieee-double-native-set!) (define pi (* 4.0 (atan 1.0))) - (define 2pi (* 2.0 pi)) (define pi/2 (/ pi 2.0)) (define tau (* pi 2.0)) @@ -305,7 +308,11 @@ (define image:player-bullets (load-image "images/player-bullets.png")) (define image:enemy-bullets (load-image "images/enemy-bullets.png")) (define image:map (load-image "images/map.png")) - (define image:enemies (load-image "images/enemies.png")) + (define image:turret (load-image "images/turret.png")) + (define image:popcorn (load-image "images/popcorn.png")) + (define image:flyer0 (load-image "images/flyer0.png")) + (define image:flyer1 (load-image "images/flyer1.png")) + (define image:boss (load-image "images/boss.png")) (define image:particles (load-image "images/particles.png")) (define sound:explosion (load-sound-effect "audio/explosion.wav")) (define sound:player-shoot (load-sound-effect "audio/player-shoot.wav")) @@ -482,7 +489,7 @@ (sound-effect-play sound:explosion) (do ((i 0 (+ i 1))) ((= i 16)) - (let ((theta (* 2pi (/ i 16.0)))) + (let ((theta (* tau (/ i 16.0)))) (particle-pool-add! particles 'explosion 20 x y (* (cos theta) speed) (* (sin theta) speed)))))) @@ -609,8 +616,8 @@ (define (point-collides-with-level? level x y) (match level (#('level height foreground collision objects) - (let ((tx (trunc (/ x tile-width))) - (ty (trunc (/ y tile-height)))) + (let ((tx (truncate (/ x tile-width))) + (ty (truncate (/ y tile-height)))) (and (>= tx 0) (< tx level-width) (>= ty 0) (< tx height) (= (bytevector-u8-ref collision (level-offset tx ty)) 1)))))) @@ -618,10 +625,10 @@ (match level (#('level height foreground collision objects) (let* ((y (+ y (- (* height tile-height) game-height *scroll*))) - (tx0 (trunc (/ x tile-width))) - (ty0 (trunc (/ y tile-height))) - (tx1 (trunc (/ (+ x w) tile-width))) - (ty1 (trunc (/ (+ y h) tile-height)))) + (tx0 (truncate (/ x tile-width))) + (ty0 (truncate (/ y tile-height))) + (tx1 (truncate (/ (+ x w) tile-width))) + (ty1 (truncate (/ (+ y h) tile-height)))) (define (occupied? x y) (and (>= x 0) (< x level-width) (>= y 0) (< x height) @@ -637,7 +644,7 @@ (th tile-height) (scroll (* *scroll* parallax)) (pixel-y-offset (- (* height th) scroll game-height)) - (scroll-y-offset (- height (trunc (/ scroll tile-height)))) + (scroll-y-offset (- height (truncate (/ scroll tile-height)))) (y-start (clamp (- scroll-y-offset 21) 0 height)) (y-end (clamp scroll-y-offset 0 height))) (do ((y y-start (+ y 1))) @@ -664,7 +671,7 @@ (let ((scroll (min (+ *scroll* *scroll-speed*) max-scroll))) (set! *last-scroll* *scroll*) (set! *scroll* scroll) - (let ((row (max (- (trunc + (let ((row (max (- (truncate (/ (- (* height tile-height) game-height scroll) tile-height)) 2) @@ -674,13 +681,17 @@ (for-each (lambda (obj) (match obj (#('level-object x type) - (match type - ('enemy-a - (spawn-enemy-a (+ (* x tile-width) - (/ tile-width 2.0)) - (+ (* (- y row 3) tile-height) - (/ tile-height 2.0)))) - (_ #t))))) + (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)))))) (vector-ref objects y))) (set! *last-row-scanned* row)))))) @@ -698,11 +709,13 @@ (points enemy-points set-enemy-points!) (spawn-time enemy-spawn-time set-enemy-spawn-time!) (animation enemy-animation set-enemy-animation!) - (image enemy-image set-enemy-image!)) + (image enemy-image set-enemy-image!) + (image-size enemy-image-size set-enemy-image-size!)) (define (make-enemy type health position size stationary? velocity - script points animation image) + script points animation image image-size) (%make-enemy type health position size stationary? velocity script - points (inexact (current-jiffy)) animation image)) + points (inexact (current-jiffy)) animation image + image-size)) (define (enemy-x enemy) (vec2-x (enemy-position enemy))) (define (enemy-y enemy) @@ -717,18 +730,18 @@ (vec2-y (enemy-velocity enemy))) (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))) @@ -744,7 +757,7 @@ (script-cancel! script)))) (define (enemy-update! enemy) (match enemy - (#('enemy _ _ position size stationary? velocity _ _ _ _ _) + (#('enemy _ _ position size stationary? velocity _ _ _ _ _ _) (if stationary? (set-vec2-y! position (+ (vec2-y position) (- *scroll* *last-scroll*))) (begin @@ -753,18 +766,19 @@ (define (draw-enemy enemy time) (let ((frame-duration 250.0)) (match enemy - (#('enemy type _ position size _ _ _ _ spawn-time animation image) + (#('enemy type _ position size _ _ _ _ spawn-time animation + image image-size) (let* ((tx (vector-ref animation - (modulo (trunc - (remainder (- time spawn-time) - frame-duration)) + (modulo (truncate + (fmod (- time spawn-time) + frame-duration)) (vector-length animation)))) (x (vec2-x position)) (y (vec2-y position)) (hbw (vec2-x size)) (hbh (vec2-y size)) - (w 64.0) - (h 64.0)) + (w (vec2-x image-size)) + (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") @@ -821,6 +835,8 @@ (explode (enemy-x enemy) (enemy-y enemy)) (set! *player-score* (+ *player-score* (enemy-points enemy)))) + (when (eq? (enemy-type enemy) 'boss) + (set! *game-state* 'game-win)) (enemy-pool-remove! pool i) (loop i (- k 1))) (else @@ -843,7 +859,10 @@ (define enemies (make-enemy-pool 64)) - (define (spawn-enemy-a x y) + (define (spawn-enemy enemy) + (enemy-pool-add! enemies enemy)) + + (define (spawn-turret x y) (define (script enemy) (let ((speed 2.0)) (wait 60) @@ -859,10 +878,34 @@ (* (vec2-y v) speed))) (wait 30) (loop (+ theta 0.2))))) - (let ((enemy (make-enemy 'foo 20 (vec2 x y) (vec2 16.0 16.0) - #t (vec2 0.0 0.0) script 100 - #(0.0 0.0 0.0 0.0) image:enemies))) - (enemy-pool-add! enemies enemy))) + (spawn-enemy + (make-enemy 'turret 10 (vec2 x y) (vec2 16.0 16.0) + #t (vec2 0.0 0.0) script 100 + #(0.0 0.0 0.0 0.0) image:turret (vec2 64.0 64.0)))) + + (define (spawn-popcorn x y) + (spawn-enemy + (make-enemy 'popcorn 1 (vec2 x y) (vec2 16.0 16.0) + #t (vec2 0.0 0.0) #f 100 + #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0)))) + + (define (spawn-flyer0 x y) + (spawn-enemy + (make-enemy 'flyer0 20 (vec2 x y) (vec2 16.0 16.0) + #t (vec2 0.0 0.0) #f 100 + #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0)))) + + (define (spawn-flyer1 x y) + (spawn-enemy + (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0) + #t (vec2 0.0 0.0) #f 100 + #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0)))) + + (define (spawn-boss x y) + (spawn-enemy + (make-enemy 'boss 100 (vec2 x y) (vec2 100.0 40.0) + #t (vec2 0.0 0.0) #f 1000000 + #(0.0 0.0 0.0 0.0) image:boss (vec2 120.0 80.0)))) ;; Player state: (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0))) @@ -956,21 +999,26 @@ (dy -1.0)) (particle-pool-add! particles 'muzzle-flash life x y ldx dy) (particle-pool-add! particles 'muzzle-flash life x y rdx dy))) - (vec2-add! player-position player-velocity) - (vec2-clamp! player-position 0.0 0.0 game-width game-height) - (set-vec2-x! player-hitbox-position - (- (vec2-x player-position) - (/ player-hitbox-width 2.0))) - (set-vec2-y! player-hitbox-position - (- (vec2-y player-position) - (/ player-hitbox-height 2.0))) - (when (and (let ((x (vec2-x player-hitbox-position)) - (y (vec2-y player-hitbox-position)) - (w player-hitbox-width) - (h player-hitbox-height)) - (or (rect-collides-with-level? level x y w h) - (find-enemy enemies x y w h)))) - (player-die!)) + (let ((old-x (vec2-x player-position)) + (old-y (vec2-y player-position))) + (vec2-add! player-position player-velocity) + (vec2-clamp! player-position 0.0 0.0 game-width game-height) + (let ((x (vec2-x player-position)) + (y (vec2-y player-position)) + (hbx (vec2-x player-hitbox-position)) + (hby (vec2-y player-hitbox-position)) + (hbw player-hitbox-width) + (hbh player-hitbox-height)) + (if (or (rect-collides-with-level? level x y hbw hbh) + (find-enemy enemies x y hbw hbh)) + (begin + (set-vec2-x! player-position old-x) + (set-vec2-y! player-position + (+ old-y (- *scroll* *last-scroll*))) + (player-die!)) + (begin + (set-vec2-x! player-hitbox-position (- x (/ hbw 2.0))) + (set-vec2-y! player-hitbox-position (- y (/ hbh 2.0))))))) (when (firing?) (set! *player-fire-counter* (modulo (+ *player-fire-counter* 1) @@ -1033,8 +1081,8 @@ (let* ((win (current-window)) (w (window-inner-width win)) (h (window-inner-height win)) - (gw (trunc game-width)) - (gh (trunc game-height)) + (gw (truncate game-width)) + (gh (truncate game-height)) (scale (max (min (quotient w gw) (quotient h gh)) 1)) (cw (* gw scale)) (ch (* gh scale))) @@ -1055,7 +1103,7 @@ (draw-bullets enemy-bullets)) (define (draw-background image parallax) - (let ((scroll (remainder (* *scroll* parallax) game-height))) + (let ((scroll (fmod (* *scroll* parallax) game-height))) ;; Bottom (draw-image context image 0.0 0.0 game-width (- game-height scroll) @@ -1067,8 +1115,8 @@ (define (draw-hud) (let ((y (- game-height 8.0))) - ;; TODO: Don't strings every frame when the UI values rarely - ;; change. + ;; TODO: Don't allocate strings every frame when the UI + ;; values rarely change. (set-fill-color! context "#ffffff") (set-font! context "bold 16px monospace") (set-text-align! context "right") @@ -1081,9 +1129,6 @@ (clear-screen) (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0) (set-scale! context *canvas-scale* *canvas-scale*) - (set-fill-color! context "#3f2832") - (fill-rect context 0.0 0.0 game-width game-height) - ;; (draw-level-background level) (draw-background image:background 0.75) (draw-level-foreground level) (draw-particles particles) |