summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile3
-rw-r--r--game.scm94
-rw-r--r--js-runtime/reflect.js150
-rw-r--r--js-runtime/reflect.wasmbin4377 -> 5196 bytes
-rw-r--r--manifest.scm44
-rw-r--r--web-server.scm5
6 files changed, 209 insertions, 87 deletions
diff --git a/Makefile b/Makefile
index 09171f6..a20c180 100644
--- a/Makefile
+++ b/Makefile
@@ -10,3 +10,6 @@ bundle: game.wasm
serve: game.wasm
guile web-server.scm
+
+clean:
+ rm game.wasm level.scm
diff --git a/game.scm b/game.scm
index 52c373a..9dd788b 100644
--- a/game.scm
+++ b/game.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
index 68441b9..770c94c 100644
--- a/js-runtime/reflect.wasm
+++ b/js-runtime/reflect.wasm
Binary files differ
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)))