diff options
Diffstat (limited to 'game.scm')
| -rw-r--r-- | game.scm | 94 |
1 files changed, 44 insertions, 50 deletions
@@ -161,8 +161,9 @@ field))) ... (define setter - (let ((i (1+ (- (length '(field ...)) - (length (memq 'field '(field ...))))))) + (let ((i (+ (- (length '(field ...)) + (length (memq 'field '(field ...)))) + 1))) (lambda (obj val) (match obj (#('name field ...) @@ -172,38 +173,10 @@ (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 (fmod x y) (assert-float x) (assert-float y) - (%inline-wasm - '(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)) + (- x (* (truncate (/ x y)) y))) (define s32-ref bytevector-s32-native-ref) (define s32-set! bytevector-s32-native-set!) @@ -696,8 +669,8 @@ (define (point-collides-with-level? level x y) (match level (#('level height foreground collision objects) - (let ((tx (truncate (/ x tile-width))) - (ty (truncate (/ y tile-height)))) + (let ((tx (exact (truncate (/ x tile-width)))) + (ty (exact (truncate (/ y tile-height))))) (and (>= tx 0) (< tx level-width) (>= ty 0) (< tx height) (= (bytevector-u8-ref collision (level-offset tx ty)) 1)))))) @@ -705,10 +678,10 @@ (match level (#('level height foreground collision objects) (let* ((y (+ y (- (* height tile-height) game-height *scroll*))) - (tx0 (truncate (/ x tile-width))) - (ty0 (truncate (/ y tile-height))) - (tx1 (truncate (/ (+ x w) tile-width))) - (ty1 (truncate (/ (+ y h) tile-height)))) + (tx0 (exact (truncate (/ x tile-width)))) + (ty0 (exact (truncate (/ y tile-height)))) + (tx1 (exact (truncate (/ (+ x w) tile-width)))) + (ty1 (exact (truncate (/ (+ y h) tile-height))))) (define (occupied? x y) (and (>= x 0) (< x level-width) (>= y 0) (< x height) @@ -724,7 +697,7 @@ (th tile-height) (scroll (* *scroll* parallax)) (pixel-y-offset (- (* height th) scroll game-height)) - (scroll-y-offset (- height (truncate (/ scroll tile-height)))) + (scroll-y-offset (- height (exact (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))) @@ -774,10 +747,12 @@ (let ((scroll (min (+ *scroll* *scroll-speed*) max-scroll))) (set! *last-scroll* *scroll*) (set! *scroll* scroll) - (let ((row (max (truncate - (/ (- (* height tile-height) - game-height scroll) - tile-height)) + (let ((row (max + (exact + (truncate + (/ (- (* height tile-height) + game-height scroll) + tile-height))) 0))) (do ((y row (+ y 1))) ((= y *last-row-scanned*)) @@ -872,9 +847,10 @@ (#('enemy type _ position size _ _ _ spawn-time animation image image-size) (let* ((tx (vector-ref animation - (modulo (truncate - (/ (- time spawn-time) - frame-duration)) + (modulo (exact + (truncate + (/ (- time spawn-time) + frame-duration))) (vector-length animation)))) (x (vec2-x position)) (y (vec2-y position)) @@ -1697,13 +1673,13 @@ (let* ((win (current-window)) (w (window-inner-width win)) (h (window-inner-height win)) - (gw (truncate game-width)) - (gh (truncate game-height)) + (gw (exact (truncate game-width))) + (gh (exact (truncate game-height))) (scale (max (min (quotient w gw) (quotient h gh)) 1)) (cw (* gw scale)) (ch (* gh scale))) - (set-element-width! canvas cw) - (set-element-height! canvas ch) + (set-element-width! canvas (pk 'canvas-width cw)) + (set-element-height! canvas (pk 'canvas-height ch)) (set-image-smoothing-enabled! context 0) (set! *canvas-scale* (inexact scale)) (set! *canvas-width* (* game-width *canvas-scale*)) @@ -2053,6 +2029,24 @@ (request-animation-frame draw-callback) (timeout update-callback dt))) +(define %imports + '((scheme base) + (only (scheme inexact) atan cos sin sqrt) + (scheme time) + (only (hoot bytevectors) + bytevector-s32-native-ref + bytevector-s32-native-set! + bytevector-ieee-double-native-ref + bytevector-ieee-double-native-set!) + (only (hoot control) + make-prompt-tag + abort-to-prompt + call-with-prompt) + (hoot ffi) + (hoot match) + (only (hoot syntax) define-syntax-rule define*) + (hoot debug))) + (call-with-output-file "game.wasm" (lambda (port) - (put-bytevector port (assemble-wasm (compile src))))) + (put-bytevector port (assemble-wasm (compile src #:imports %imports))))) |