diff options
| -rw-r--r-- | Makefile | 3 | ||||
| -rw-r--r-- | game.scm | 94 | ||||
| -rw-r--r-- | js-runtime/reflect.js | 150 | ||||
| -rw-r--r-- | js-runtime/reflect.wasm | bin | 4377 -> 5196 bytes | |||
| -rw-r--r-- | manifest.scm | 44 | ||||
| -rw-r--r-- | web-server.scm | 5 |
6 files changed, 209 insertions, 87 deletions
@@ -10,3 +10,6 @@ bundle: game.wasm serve: game.wasm guile web-server.scm + +clean: + rm game.wasm level.scm @@ -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))))) diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js index 5ee2928..172f187 100644 --- a/js-runtime/reflect.js +++ b/js-runtime/reflect.js @@ -165,6 +165,7 @@ class Scheme { await instantiate_streaming('js-runtime/reflect.wasm', { abi, rt: { + die(tag, data) { throw new SchemeTrapError(tag, data); }, wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); }, string_to_wtf8(str) { return string_to_wtf8(str); }, } @@ -352,7 +353,22 @@ function wtf8_to_string(wtf8) { let iter = as_iter(wtf8); for (let cp = iter_next(iter); cp != -1; cp = iter_next(iter)) codepoints.push(cp); - return String.fromCodePoint(...codepoints); + + // Passing too many codepoints can overflow the stack. + let maxcp = 100000; + if (codepoints.length <= maxcp) { + return String.fromCodePoint(...codepoints); + } + + // For converting large strings, concatenate several smaller + // strings. + let substrings = []; + let end = 0; + for (let start = 0; start != codepoints.length; start = end) { + end = Math.min(start + maxcp, codepoints.length); + substrings.push(String.fromCodePoint(...codepoints.slice(start, end))); + } + return substrings.join(''); } function string_to_wtf8(str) { @@ -473,25 +489,131 @@ class SchemeModule { constructor(instance) { this.#instance = instance; - let read_stdin = () => ''; - if (typeof printErr === 'function') { + if (typeof printErr === 'function') { // v8/sm dev console // On the console, try to use 'write' (v8) or 'putstr' (sm), // as these don't add an extraneous newline. Unfortunately // JSC doesn't have a printer that doesn't add a newline. let write_no_newline = typeof write === 'function' ? write : typeof putstr === 'function' ? putstr : print; + // Use readline when available. v8 strips newlines so + // we need to add them back. + let read_stdin = + typeof readline == 'function' ? () => { + let line = readline(); + if (line) { + return `${line}\n`; + } else { + return '\n'; + } + }: () => ''; + let delete_file = (filename) => false; this.#io_handler = { write_stdout: write_no_newline, write_stderr: printErr, - read_stdin + read_stdin, + file_exists: (filename) => false, + open_input_file: (filename) => {}, + open_output_file: (filename) => {}, + close_file: () => undefined, + read_file: (handle, length) => 0, + write_file: (handle, length) => 0, + seek_file: (handle, offset, whence) => -1, + file_random_access: (handle) => false, + file_buffer_size: (handle) => 0, + file_buffer_ref: (handle, i) => 0, + file_buffer_set: (handle, i, x) => undefined, + delete_file: (filename) => undefined }; - } else { + } else if (typeof window !== 'undefined') { // web browser this.#io_handler = { write_stdout: console.log, write_stderr: console.error, - read_stdin - } + read_stdin: () => '', + file_exists: (filename) => false, + open_input_file: (filename) => {}, + open_output_file: (filename) => {}, + close_file: () => undefined, + read_file: (handle, length) => 0, + write_file: (handle, length) => 0, + seek_file: (handle, offset, whence) => -1, + file_random_access: (handle) => false, + file_buffer_size: (handle) => 0, + file_buffer_ref: (handle, i) => 0, + file_buffer_set: (handle, i, x) => undefined, + delete_file: (filename) => undefined + }; + } else { // nodejs + const fs = require('fs'); + const process = require('process'); + const bufLength = 1024; + const stdinBuf = Buffer.alloc(bufLength); + const SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2; + this.#io_handler = { + write_stdout: console.log, + write_stderr: console.error, + read_stdin: () => { + let n = fs.readSync(process.stdin.fd, stdinBuf, 0, stdinBuf.length); + return stdinBuf.toString('utf8', 0, n); + }, + file_exists: fs.existsSync.bind(fs), + open_input_file: (filename) => { + let fd = fs.openSync(filename, 'r'); + return { + fd, + buf: Buffer.alloc(bufLength), + pos: 0 + }; + }, + open_output_file: (filename) => { + let fd = fs.openSync(filename, 'w'); + return { + fd, + buf: Buffer.alloc(bufLength), + pos: 0 + }; + }, + close_file: (handle) => { + fs.closeSync(handle.fd); + }, + read_file: (handle, count) => { + const n = fs.readSync(handle.fd, handle.buf, 0, count, handle.pos); + handle.pos += n; + return n; + }, + write_file: (handle, count) => { + const n = fs.writeSync(handle.fd, handle.buf, 0, count, handle.pos); + handle.pos += n; + return n; + }, + seek_file: (handle, offset, whence) => { + // There doesn't seem to be a way to ask NodeJS if + // a position is valid or not. + if (whence == SEEK_SET) { + handle.pos = offset; + return handle.pos; + } else if (whence == SEEK_CUR) { + handle.pos += offset; + return handle.pos; + } + + // SEEK_END not supported. + return -1; + }, + file_random_access: (handle) => { + return true; + }, + file_buffer_size: (handle) => { + return handle.buf.length; + }, + file_buffer_ref: (handle, i) => { + return handle.buf[i]; + }, + file_buffer_set: (handle, i, x) => { + handle.buf[i] = x; + }, + delete_file: fs.rmSync.bind(fs) + }; } this.#debug_handler = { debug_str(x) { console.log(`debug: ${x}`); }, @@ -505,7 +627,19 @@ class SchemeModule { write_stdout(str) { mod.#io_handler.write_stdout(str); }, write_stderr(str) { mod.#io_handler.write_stderr(str); }, read_stdin() { return mod.#io_handler.read_stdin(); }, - } + file_exists(filename) { return mod.#io_handler.file_exists(filename); }, + open_input_file(filename) { return mod.#io_handler.open_input_file(filename); }, + open_output_file(filename) { return mod.#io_handler.open_output_file(filename); }, + close_file(handle) { mod.#io_handler.close_file(handle); }, + read_file(handle, length) { return mod.#io_handler.read_file(handle, length); }, + write_file(handle, length) { return mod.#io_handler.write_file(handle, length); }, + seek_file(handle, offset, whence) { return mod.#io_handler.seek_file(handle, offset, whence); }, + file_random_access(handle) { return mod.#io_handler.file_random_access(handle); }, + file_buffer_size(handle) { return mod.#io_handler.file_buffer_size(handle); }, + file_buffer_ref(handle, i) { return mod.#io_handler.file_buffer_ref(handle, i); }, + file_buffer_set(handle, i, x) { return mod.#io_handler.file_buffer_set(handle, i, x); }, + delete_file(filename) { mod.#io_handler.delete_file(filename); } + }; let debug = { debug_str(x) { mod.#debug_handler.debug_str(x); }, debug_str_i32(x, y) { mod.#debug_handler.debug_str_i32(x, y); }, diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm Binary files differindex 68441b9..770c94c 100644 --- a/js-runtime/reflect.wasm +++ b/js-runtime/reflect.wasm diff --git a/manifest.scm b/manifest.scm index 690128b..a2e24be 100644 --- a/manifest.scm +++ b/manifest.scm @@ -13,31 +13,21 @@ (gnu packages pkg-config) (gnu packages texinfo)) -;; (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-next + (let ((commit "f161d83c51bb39b372fd9d5d102841c2a4d6d524") + (revision "1")) + (package + (inherit guile-hoot) + (version (git-version "0.3.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 "1wr170q2rsd1bg7gbcp28f1nm8fxxkdlgijs68ssdf231vr8gq1w")))) + (native-inputs + (list autoconf automake pkg-config texinfo))))) -(packages->manifest (list guile-next guile-hoot gnu-make zip)) +(packages->manifest (list guile-next guile-hoot-next gnu-make zip)) diff --git a/web-server.scm b/web-server.scm index 86a6902..e21eb42 100644 --- a/web-server.scm +++ b/web-server.scm @@ -153,5 +153,6 @@ FILE-NAME." "Run a simple HTTP server that serves files in WORK-DIR." (run-server (make-handler work-dir) 'http open-params)) -(when (batch-mode?) - (serve (getcwd) #:open-params `(#:port 8088 #:addr ,INADDR_ANY))) +(let ((port 8088)) + (format #t "Serving on http://localhost:~a\n" port) + (serve (getcwd) #:open-params `(#:port ,port #:addr ,INADDR_ANY))) |