summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--boot.js35
-rw-r--r--game.scm112
-rw-r--r--js-runtime/reflect.js48
-rw-r--r--js-runtime/reflect.wasmbin4327 -> 4377 bytes
-rw-r--r--manifest.scm64
5 files changed, 139 insertions, 120 deletions
diff --git a/boot.js b/boot.js
index fbb2468..38c91f0 100644
--- a/boot.js
+++ b/boot.js
@@ -1,20 +1,5 @@
async function load() {
- const procMap = new WeakMap();
-
- function wrapProc(obj) {
- function makeWrapper() {
- const proc = scheme.to_js(obj);
- function wrapper (...args) {
- return proc.call(...args);
- }
- procMap.set(obj, wrapper);
- return wrapper;
- }
-
- return procMap.get(obj) || makeWrapper();
- }
-
- const mod = await SchemeModule.fetch_and_instantiate("game.wasm", {}, {
+ const mod = await Scheme.load_main("game.wasm", {}, {
window: {
get() {
return window;
@@ -25,11 +10,11 @@ async function load() {
innerHeight() {
return window.innerHeight;
},
- requestAnimationFrame(proc) {
- window.requestAnimationFrame(wrapProc(proc));
+ requestAnimationFrame(f) {
+ window.requestAnimationFrame(f);
},
- setTimeout(proc, delay) {
- window.setTimeout(wrapProc(proc), delay);
+ setTimeout(f, delay) {
+ window.setTimeout(f, delay);
}
},
document: {
@@ -67,11 +52,11 @@ async function load() {
replaceWith(oldElem, newElem) {
oldElem.replaceWith(newElem);
},
- addEventListener(elem, name, proc) {
- elem.addEventListener(name, wrapProc(proc));
+ addEventListener(elem, name, f) {
+ elem.addEventListener(name, f);
},
- removeEventListener(elem, name, proc) {
- elem.removeEventListener(name, wrapProc(proc));
+ removeEventListener(elem, name, f) {
+ elem.removeEventListener(name, f);
},
clone(elem) {
return elem.cloneNode();
@@ -151,7 +136,5 @@ async function load() {
}
}
});
- const scheme = await mod.reflect();
- scheme.init_module(mod);
}
window.addEventListener("load", load);
diff --git a/game.scm b/game.scm
index 7e7ddf1..5d6c567 100644
--- a/game.scm
+++ b/game.scm
@@ -7,139 +7,139 @@
;; Host imports
(define-foreign current-window
"window" "get"
- -> (ref extern))
+ -> (ref null extern))
(define-foreign window-inner-width
"window" "innerWidth"
- (ref extern) -> i32)
+ (ref null extern) -> i32)
(define-foreign window-inner-height
"window" "innerHeight"
- (ref extern) -> i32)
+ (ref null extern) -> i32)
(define-foreign request-animation-frame
"window" "requestAnimationFrame"
- (ref eq) -> none)
+ (ref null extern) -> none)
(define-foreign timeout
"window" "setTimeout"
- (ref eq) f64 -> i32)
+ (ref null extern) f64 -> i32)
(define-foreign current-document
"document" "get"
- -> (ref extern))
+ -> (ref null extern))
(define-foreign document-body
"document" "body"
- -> (ref extern))
+ -> (ref null extern))
(define-foreign get-element-by-id
"document" "getElementById"
(ref string) -> (ref null extern))
(define-foreign make-text-node
"document" "createTextNode"
- (ref string) -> (ref extern))
+ (ref string) -> (ref null extern))
(define-foreign make-element
"document" "createElement"
- (ref string) -> (ref extern))
+ (ref string) -> (ref null extern))
(define-foreign element-value
"element" "value"
- (ref extern) -> (ref string))
+ (ref null extern) -> (ref string))
(define-foreign set-element-value!
"element" "setValue"
- (ref extern) (ref string) -> none)
+ (ref null extern) (ref string) -> none)
(define-foreign set-element-width!
"element" "setWidth"
- (ref extern) i32 -> none)
+ (ref null extern) i32 -> none)
(define-foreign set-element-height!
"element" "setHeight"
- (ref extern) i32 -> none)
+ (ref null extern) i32 -> none)
(define-foreign append-child!
"element" "appendChild"
- (ref extern) (ref extern) -> (ref extern))
+ (ref null extern) (ref null extern) -> (ref null extern))
(define-foreign remove!
"element" "remove"
- (ref extern) -> none)
+ (ref null extern) -> none)
(define-foreign replace-with!
"element" "replaceWith"
- (ref extern) (ref extern) -> none)
+ (ref null extern) (ref null extern) -> none)
(define-foreign set-attribute!
"element" "setAttribute"
- (ref extern) (ref string) (ref string) -> none)
+ (ref null extern) (ref string) (ref string) -> none)
(define-foreign remove-attribute!
"element" "removeAttribute"
- (ref extern) (ref string) -> none)
+ (ref null extern) (ref string) -> none)
(define-foreign add-event-listener!
"element" "addEventListener"
- (ref extern) (ref string) (ref eq) -> none)
+ (ref null extern) (ref string) (ref null extern) -> none)
(define-foreign remove-event-listener!
"element" "removeEventListener"
- (ref extern) (ref string) (ref eq) -> none)
+ (ref null extern) (ref string) (ref null extern) -> none)
(define-foreign clone-element
"element" "clone"
- (ref extern) -> (ref extern))
+ (ref null extern) -> (ref null extern))
(define-foreign prevent-default!
"event" "preventDefault"
- (ref extern) -> none)
+ (ref null extern) -> none)
(define-foreign keyboard-event-code
"event" "keyboardCode"
- (ref extern) -> (ref string))
+ (ref null extern) -> (ref string))
(define-foreign get-context
"canvas" "getContext"
- (ref extern) (ref string) -> (ref extern))
+ (ref null extern) (ref string) -> (ref null extern))
(define-foreign set-fill-color!
"canvas" "setFillColor"
- (ref extern) (ref string) -> none)
+ (ref null extern) (ref string) -> none)
(define-foreign set-font!
"canvas" "setFont"
- (ref extern) (ref string) -> none)
+ (ref null extern) (ref string) -> none)
(define-foreign set-text-align!
"canvas" "setTextAlign"
- (ref extern) (ref string) -> none)
+ (ref null extern) (ref string) -> none)
(define-foreign clear-rect
"canvas" "clearRect"
- (ref extern) f64 f64 f64 f64 -> none)
+ (ref null extern) f64 f64 f64 f64 -> none)
(define-foreign fill-rect
"canvas" "fillRect"
- (ref extern) f64 f64 f64 f64 -> none)
+ (ref null extern) f64 f64 f64 f64 -> none)
(define-foreign fill-text
"canvas" "fillText"
- (ref extern) (ref string) f64 f64 -> none)
+ (ref null extern) (ref string) f64 f64 -> none)
(define-foreign draw-image
"canvas" "drawImage"
- (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
+ (ref null extern) (ref null extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
(define-foreign set-scale!
"canvas" "setScale"
- (ref extern) f64 f64 -> none)
+ (ref null extern) f64 f64 -> none)
(define-foreign set-transform!
"canvas" "setTransform"
- (ref extern) f64 f64 f64 f64 f64 f64 -> none)
+ (ref null extern) f64 f64 f64 f64 f64 f64 -> none)
(define-foreign set-image-smoothing-enabled!
"canvas" "setImageSmoothingEnabled"
- (ref extern) i32 -> none)
+ (ref null extern) i32 -> none)
(define-foreign load-audio
"audio" "new"
- (ref string) -> (ref extern))
+ (ref string) -> (ref null extern))
(define-foreign audio-play
"audio" "play"
- (ref extern) -> none)
+ (ref null extern) -> none)
(define-foreign audio-pause
"audio" "pause"
- (ref extern) -> none)
+ (ref null extern) -> none)
(define-foreign audio-volume
"audio" "volume"
- (ref extern) -> f64)
+ (ref null extern) -> f64)
(define-foreign set-audio-volume!
"audio" "setVolume"
- (ref extern) f64 -> none)
+ (ref null extern) f64 -> none)
(define-foreign set-audio-loop!
"audio" "setLoop"
- (ref extern) i32 -> none)
+ (ref null extern) i32 -> none)
(define-foreign audio-seek
"audio" "seek"
- (ref extern) f64 -> none)
+ (ref null extern) f64 -> none)
(define-foreign load-image
"image" "new"
- (ref string) -> (ref extern))
+ (ref string) -> (ref null extern))
;; Record types are only just beginning to be added to Hoot and
;; there isn't support for mutable structs, yet. So, tagged
@@ -1771,14 +1771,14 @@
(draw-enemies enemies time)
(draw-player)
(draw-enemy-bullets)
+ (draw-hud)
(when *show-warning?*
(set-fill-color! context "#d27d2c")
(set-text-align! context "center")
(set-font! context "bold 72px monogram")
(fill-text context "WARNING"
(/ game-width 2.0)
- (/ game-height 2.0)))
- (draw-hud))
+ (/ game-height 2.0))))
(define (draw-pause time)
(draw-background image:starfield-bg 0.3)
@@ -1864,7 +1864,8 @@
('game-over draw-game-over)
('game-clear draw-game-clear))))
(draw* time))
- (request-animation-frame draw)))
+ (request-animation-frame draw-callback)))
+ (define draw-callback (procedure->external draw))
(define (reset!)
(music-stop)
@@ -1938,8 +1939,7 @@
(match *game-state*
('splash
(when (string-=? code "Enter")
- (reset!)
- (set! *game-state* 'play)))
+ (reset!)))
('play
(cond
((string-=? code "Enter")
@@ -2038,14 +2038,18 @@
(bullet-pool-update! enemy-bullets enemy-bullet-collide)
(particle-pool-update! particles))
(_ #t))
- (timeout update dt))
-
- (add-event-listener! (current-window) "resize" (lambda (_) (resize-canvas)))
- (add-event-listener! (current-document) "keydown" on-key-down)
- (add-event-listener! (current-document) "keyup" on-key-up)
+ (timeout update-callback dt))
+ (define update-callback (procedure->external update))
+
+ (add-event-listener! (current-window) "resize"
+ (procedure->external (lambda (_) (resize-canvas))))
+ (add-event-listener! (current-document) "keydown"
+ (procedure->external on-key-down))
+ (add-event-listener! (current-document) "keyup"
+ (procedure->external on-key-up))
(resize-canvas)
- (request-animation-frame draw)
- (timeout update dt)))
+ (request-animation-frame draw-callback)
+ (timeout update-callback dt)))
(call-with-output-file "game.wasm"
(lambda (port)
diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js
index 7ba19b7..a930547 100644
--- a/js-runtime/reflect.js
+++ b/js-runtime/reflect.js
@@ -1,3 +1,4 @@
+// -*- js2-basic-offset: 4 -*-
class Char {
constructor(codepoint) {
this.codepoint = codepoint;
@@ -170,25 +171,33 @@ class Scheme {
return new Scheme(instance, abi);
}
- init_module(mod) {
+ #init_module(mod) {
mod.set_debug_handler({
debug_str(x) { console.log(`debug: ${x}`); },
debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
debug_str_scm: (x, y) => {
- console.log(`debug: ${x}: ${repr(this.to_js(y))}`);
+ console.log(`debug: ${x}: ${repr(this.#to_js(y))}`);
},
});
- let proc = new Procedure(this, mod.get_export('$load').value)
+ mod.set_ffi_handler({
+ procedure_to_extern: (obj) => {
+ const proc = this.#to_js(obj);
+ return (...args) => {
+ return proc.call(...args);
+ };
+ }
+ });
+ let proc = new Procedure(this, mod.get_export('$load').value);
return proc.call();
}
static async load_main(path, abi, user_imports = {}) {
let mod = await SchemeModule.fetch_and_instantiate(path, abi, user_imports);
let reflect = await mod.reflect();
- return reflect.init_module(mod);
+ return reflect.#init_module(mod);
}
- async load_extension(path) {
- let mod = await SchemeModule.fetch_and_instantiate(path, this.#abi);
- return this.init_module(mod);
+ async load_extension(path, user_imports = {}) {
+ let mod = await SchemeModule.fetch_and_instantiate(path, this.#abi, user_imports);
+ return this.#init_module(mod);
}
#to_scm(js) {
@@ -222,7 +231,7 @@ class Scheme {
}
}
- to_js(scm) {
+ #to_js(scm) {
let api = this.#instance.exports;
let descr = api.describe(scm);
let handlers = {
@@ -238,8 +247,8 @@ class Scheme {
bignum: () => api.bignum_value(scm),
complex: () => new Complex(api.complex_real(scm),
api.complex_imag(scm)),
- fraction: () => new Fraction(this.to_js(api.fraction_num(scm)),
- this.to_js(api.fraction_denom(scm))),
+ fraction: () => new Fraction(this.#to_js(api.fraction_num(scm)),
+ this.#to_js(api.fraction_denom(scm))),
pair: () => new Pair(this, scm),
'mutable-pair': () => new MutablePair(this, scm),
vector: () => new Vector(this, scm),
@@ -278,16 +287,16 @@ class Scheme {
argv = api.call(func, argv);
let results = [];
for (let idx = 0; idx < api.vector_length(argv); idx++)
- results.push(this.to_js(api.vector_ref(argv, idx)))
+ results.push(this.#to_js(api.vector_ref(argv, idx)))
return results;
}
- car(x) { return this.to_js(this.#instance.exports.car(x.obj)); }
- cdr(x) { return this.to_js(this.#instance.exports.cdr(x.obj)); }
+ car(x) { return this.#to_js(this.#instance.exports.car(x.obj)); }
+ cdr(x) { return this.#to_js(this.#instance.exports.cdr(x.obj)); }
vector_length(x) { return this.#instance.exports.vector_length(x.obj); }
vector_ref(x, i) {
- return this.to_js(this.#instance.exports.vector_ref(x.obj, i));
+ return this.#to_js(this.#instance.exports.vector_ref(x.obj, i));
}
bytevector_length(x) {
@@ -359,6 +368,7 @@ class SchemeModule {
#instance;
#io_handler;
#debug_handler;
+ #ffi_handler;
static #rt = {
bignum_from_string(str) { return BigInt(str); },
bignum_from_i32(n) { return BigInt(n); },
@@ -492,10 +502,15 @@ class SchemeModule {
debug_str_i32(x, y) { mod.#debug_handler.debug_str_i32(x, y); },
debug_str_scm(x, y) { mod.#debug_handler.debug_str_scm(x, y); },
}
+ let ffi = {
+ procedure_to_extern(proc) {
+ return mod.#ffi_handler.procedure_to_extern(proc);
+ }
+ };
let imports = {
rt: SchemeModule.#rt,
abi: imported_abi,
- debug, io, ...user_imports
+ debug, io, ffi, ...user_imports
};
let { module, instance } = await instantiate_streaming(path, imports);
let mod = new SchemeModule(instance);
@@ -503,6 +518,7 @@ class SchemeModule {
}
set_io_handler(h) { this.#io_handler = h; }
set_debug_handler(h) { this.#debug_handler = h; }
+ set_ffi_handler(h) { this.#ffi_handler = h; }
all_exports() { return this.#instance.exports; }
exported_abi() {
let abi = {}
@@ -539,6 +555,6 @@ function repr(obj) {
return flonum_to_string(obj);
if (typeof obj === 'string')
// FIXME: Improve to match Scheme.
- return '"' + obj.replace(/(["\\])/g, '\\$1') + '"';
+ return '"' + obj.replace(/(["\\])/g, '\\$1').replace(/\n/g, '\\n') + '"';
return obj + '';
}
diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm
index d3c857f..68441b9 100644
--- a/js-runtime/reflect.wasm
+++ b/js-runtime/reflect.wasm
Binary files differ
diff --git a/manifest.scm b/manifest.scm
index 8fd1412..a91ac44 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -12,31 +12,47 @@
(gnu packages pkg-config)
(gnu packages texinfo))
+(define guile-next-next
+ (let ((commit "49aa0940bcd1f77819326e73aaee44f5f359d830")
+ (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 "164i4q0vcb3i790fx6fa9ajjlnx253cabgan2m92kigbpid988hi")))))))
+
(define guile-hoot
- (let ((commit "3ff1a556e3056db32e3cd7ccde95faf1f5100887")
+ (let ((commit "bfe760073151f6e4bd2161b32d6e6f28706df9eb")
(revision "1"))
(package
- (name "guile-hoot")
- (version (git-version "0.0.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 "087jjqziziahmny45ddjj4ww16935n8i0341yzqx8a81l22f8vc1"))))
- (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+)))))
+ (name "guile-hoot")
+ (version (git-version "0.0.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 "05fik20y9v7dz0xamlpas3xp3fwx7qn5n2lrf2qgm6byk2crwxnv"))))
+ (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-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-next guile-hoot gnu-make zip))