From 7d23369b60e43193a34d61adfe23930506069a13 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 29 Jan 2024 21:06:02 -0500 Subject: Update to latest hoot. --- Makefile | 2 +- boot.js | 2 +- game.scm | 74 ++++++++++++++++++++++++++------------------------- js-runtime/reflect.js | 7 ++--- manifest.scm | 70 +++++++++++++++++++----------------------------- 5 files changed, 71 insertions(+), 84 deletions(-) diff --git a/Makefile b/Makefile index 161c4e5..09171f6 100644 --- a/Makefile +++ b/Makefile @@ -8,5 +8,5 @@ bundle: game.wasm rm strigoform.zip || true zip strigoform.zip -r audio/*.{wav,ogg} images/*.png fonts/ js-runtime/ boot.js game.css game.wasm index.html -serve: +serve: game.wasm guile web-server.scm diff --git a/boot.js b/boot.js index 38c91f0..2955e9f 100644 --- a/boot.js +++ b/boot.js @@ -1,5 +1,5 @@ async function load() { - const mod = await Scheme.load_main("game.wasm", {}, { + await Scheme.load_main("game.wasm", {}, { window: { get() { return window; diff --git a/game.scm b/game.scm index 5d6c567..52c373a 100644 --- a/game.scm +++ b/game.scm @@ -1665,9 +1665,9 @@ (scheduler-reset! *scheduler*) (music-stop) (set! *game-state* 'game-clear) - (set! *clear-show-1cc-bonus?* #f) - (set! *clear-show-life-bonus?* #f) - (set! *clear-show-total-score?* #f) + (set! *clear-show-1cc-bonus?* #t) + (set! *clear-show-life-bonus?* #t) + (set! *clear-show-total-score?* #t) (if *player-1cc?* (let ((1cc-bonus 1000000) (life-bonus (* *player-lives* 250000))) @@ -1678,14 +1678,16 @@ (set! *clear-1cc-bonus* "0") (set! *clear-life-bonus* "0"))) (set! *clear-total-score* (number->string *player-score*)) - (run-script - (lambda () - (wait 60) - (set! *clear-show-1cc-bonus?* #t) - (wait 60) - (set! *clear-show-life-bonus?* #t) - (wait 60) - (set! *clear-show-total-score?* #t)))) + ;; Disabled due to a Hoot compiler bug :((( + ;; (run-script + ;; (lambda () + ;; (wait 60) + ;; (set! *clear-show-1cc-bonus?* #t) + ;; (wait 60) + ;; (set! *clear-show-life-bonus?* #t) + ;; (wait 60) + ;; (set! *clear-show-total-score?* #t))) + ) ;; Canvas sizing/scaling. (define *canvas-scale* 0.0) @@ -1893,86 +1895,86 @@ (define (on-key-down event) (let ((code (keyboard-event-code event))) (cond - ((string-=? code "ArrowLeft") + ((string=? code "ArrowLeft") (set-left! #t) (prevent-default! event)) - ((string-=? code "ArrowRight") + ((string=? code "ArrowRight") (set-right! #t) (prevent-default! event)) - ((string-=? code "ArrowDown") + ((string=? code "ArrowDown") (set-down! #t) (prevent-default! event)) - ((string-=? code "ArrowUp") + ((string=? code "ArrowUp") (set-up! #t) (prevent-default! event)) - ((string-=? code "KeyZ") + ((string=? code "KeyZ") (set-firing! #t) (prevent-default! event)) - ((string-=? code "KeyX";; "ShiftLeft" - ) + ((string=? code "KeyX" ;; "ShiftLeft" + ) (set-focusing! #t) (prevent-default! event))))) (define (on-key-up event) (let ((code (keyboard-event-code event))) (cond - ((string-=? code "ArrowLeft") + ((string=? code "ArrowLeft") (set-left! #f) (prevent-default! event)) - ((string-=? code "ArrowRight") + ((string=? code "ArrowRight") (set-right! #f) (prevent-default! event)) - ((string-=? code "ArrowDown") + ((string=? code "ArrowDown") (set-down! #f) (prevent-default! event)) - ((string-=? code "ArrowUp") + ((string=? code "ArrowUp") (set-up! #f) (prevent-default! event)) - ((string-=? code "KeyZ") + ((string=? code "KeyZ") (set-firing! #f) (prevent-default! event)) - ((string-=? code "KeyX";; "ShiftLeft" - ) + ((string=? code "KeyX" ;; "ShiftLeft" + ) (set-focusing! #f) (prevent-default! event)) (else (match *game-state* ('splash - (when (string-=? code "Enter") + (when (string=? code "Enter") (reset!))) ('play (cond - ((string-=? code "Enter") + ((string=? code "Enter") (set! *game-state* 'pause) (music-pause) (prevent-default! event)) - ;; ((string-=? code "KeyD") + ;; ((string=? code "KeyD") ;; (set! *debug?* (not *debug?*)) ;; (prevent-default! event)) - ((string-=? code "KeyR") + ((string=? code "KeyR") (reset!) (prevent-default! event)) - ;; ((string-=? code "KeyW") - ;; (do-game-clear) - ;; (prevent-default! event)) - ;; ((string-=? code "KeyO") + ((string=? code "KeyW") + (do-game-clear) + (prevent-default! event)) + ;; ((string=? code "KeyO") ;; (do-game-over) ;; (prevent-default! event)) )) ('pause (cond - ((string-=? code "Enter") + ((string=? code "Enter") (set! *game-state* 'play) (music-play) (prevent-default! event)))) ('game-clear (cond - ((string-=? code "Enter") + ((string=? code "Enter") (do-splash) (prevent-default! event)))) ('game-over (cond - ((string-=? code "Enter") + ((string=? code "Enter") (do-continue) (prevent-default! event)))) (_ #t)))))) diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js index b7d88f3..5ee2928 100644 --- a/js-runtime/reflect.js +++ b/js-runtime/reflect.js @@ -20,7 +20,8 @@ class Complex { this.imag = imag; } toString() { - return `${flonum_to_string(this.real)}+${flonum_to_string(this.imag)}i`; + const sign = this.imag >= 0 && Number.isFinite(this.imag) ? "+": ""; + return `${flonum_to_string(this.real)}${sign}${flonum_to_string(this.imag)}i`; } } class Fraction { @@ -440,9 +441,9 @@ class SchemeModule { string_downcase: Function.call.bind(String.prototype.toLowerCase), make_weak_map() { return new WeakMap; }, - weak_map_get(map, k) { + weak_map_get(map, k, fail) { const val = map.get(k); - return val === undefined ? null: val; + return val === undefined ? fail: val; }, weak_map_set(map, k, v) { return map.set(k, v); }, weak_map_delete(map, k) { return map.delete(k); }, diff --git a/manifest.scm b/manifest.scm index c0c5013..690128b 100644 --- a/manifest.scm +++ b/manifest.scm @@ -13,47 +13,31 @@ (gnu packages pkg-config) (gnu packages texinfo)) -(define guile-next* - (let ((commit "d7cf5bf373392a18e9a4de06f751eae3d66ce1af") - (revision "1")) - (package - (inherit guile-next) - (version (git-version "3.0.9" revision commit)) - (source - (origin - (method git-fetch) - (uri (git-reference - (url "https://git.savannah.gnu.org/git/guile.git") - (commit commit))) - (file-name (git-file-name "guile" version)) - (sha256 - (base32 "05irlc0q7jlx5n5c7xm3cd35azgwyngkdzf46ngs1alnlxibc6kh"))))))) +;; (define guile-hoot* +;; (let ((commit "90b9c8c8ece2b60ccaf7cad6228234feb7c1e734") +;; (revision "1")) +;; (package +;; (name "guile-hoot") +;; (version (git-version "0.2.0" revision commit)) +;; (source (origin +;; (method git-fetch) +;; (uri (git-reference +;; (url "https://gitlab.com/spritely/guile-hoot.git") +;; (commit commit))) +;; (file-name (git-file-name "guile-hoot" version)) +;; (sha256 +;; (base32 "09km5i3yj4zklvm1jc2j6qrha47xywscxw2djwljxrwmzxawz865")))) +;; (build-system gnu-build-system) +;; (arguments +;; '(#:make-flags '("GUILE_AUTO_COMPILE=0") +;; #:tests? #f)) +;; (native-inputs +;; (list autoconf automake pkg-config texinfo)) +;; (inputs +;; (list guile-next)) +;; (synopsis "WASM compiler for Guile Scheme") +;; (description "Guile-hoot is an ahead-of-time WebAssembly compiler for GNU Guile.") +;; (home-page "https://spritely.institute/hoot/") +;; (license (list license:asl2.0 license:lgpl3+))))) -(define guile-hoot* - (let ((commit "90b9c8c8ece2b60ccaf7cad6228234feb7c1e734") - (revision "1")) - (package - (name "guile-hoot") - (version (git-version "0.2.0" revision commit)) - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://gitlab.com/spritely/guile-hoot.git") - (commit commit))) - (file-name (git-file-name "guile-hoot" version)) - (sha256 - (base32 "09km5i3yj4zklvm1jc2j6qrha47xywscxw2djwljxrwmzxawz865")))) - (build-system gnu-build-system) - (arguments - '(#:make-flags '("GUILE_AUTO_COMPILE=0") - #:tests? #f)) - (native-inputs - (list autoconf automake pkg-config texinfo)) - (inputs - (list guile-next*)) - (synopsis "WASM compiler for Guile Scheme") - (description "Guile-hoot is an ahead-of-time WebAssembly compiler for GNU Guile.") - (home-page "https://spritely.institute/hoot/") - (license (list license:asl2.0 license:lgpl3+))))) - -(packages->manifest (list guile-next* guile-hoot* gnu-make zip)) +(packages->manifest (list guile-next guile-hoot gnu-make zip)) -- cgit v1.2.3