southfox/is-you
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[build] first commit

Browse source
This commit is contained in:
SouthFox 2024-05-19 23:34:25 +08:00
commit e970ed8706
21 changed files with 1682 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored Normal file
View file

@ -0,0 +1,2 @@
/game.wasm
/game.zip

202
COPYING Normal file
View file

@ -0,0 +1,202 @@
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
APPENDIX: How to apply the Apache License to your work.
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "[]"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
Copyright [yyyy] [name of copyright owner]
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

24
Makefile Normal file
View file

@ -0,0 +1,24 @@
modules = \
modules/dom/canvas.scm \
modules/dom/document.scm \
modules/dom/element.scm \
modules/dom/event.scm \
modules/dom/image.scm \
modules/dom/media.scm \
modules/dom/window.scm \
modules/math.scm \
modules/math/rect.scm \
modules/math/vector.scm
game.wasm: game.scm $(modules)
guild compile-wasm -L modules -o $@ $<
serve: game.wasm
guile -c '((@ (hoot web-server) serve))'
bundle: game.wasm
rm game.zip || true
zip game.zip -r assets/ js-runtime/ game.js game.css game.wasm index.html
clean:
rm -f game.wasm game.zip

11
game.css Normal file
View file

@ -0,0 +1,11 @@
body {
/* background-color: #000; */
margin: 0;
width: 100vw;
height: 100vh;
}
canvas {
display: block;
margin: 0 auto;
}

77
game.js Normal file
View file

@ -0,0 +1,77 @@
window.addEventListener("load", async () => {
try {
await Scheme.load_main("game.wasm", {}, {
window: {
get: () => window,
innerWidth: () => window.innerWidth,
innerHeight: () => window.innerHeight,
requestAnimationFrame: (f) => window.requestAnimationFrame(f),
setTimeout: (f, delay) => window.setTimeout(f, delay)
},
document: {
get: () => document,
body: () => document.body,
getElementById: (id) => document.getElementById(id),
createTextNode: (text) => document.createTextNode(text),
createElement: (tag) => document.createElement(tag)
},
element: {
value: (elem) => elem.value,
setValue: (elem, value) => elem.value = value,
width: (elem) => elem.width,
height: (elem) => elem.height,
setWidth: (elem, width) => elem.width = width,
setHeight: (elem, height) => elem.height = height,
appendChild: (parent, child) => parent.appendChild(child),
setAttribute: (elem, name, value) => elem.setAttribute(name, value),
removeAttribute: (elem, name) => elem.removeAttribute(name),
remove: (elem) => elem.remove(),
replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem),
clone: (elem) => elem.cloneNode()
},
event: {
addEventListener: (target, type, listener) => target.addEventListener(type, listener),
removeEventListener: (target, type, listener) => target.removeEventListener(type, listener),
preventDefault: (event) => event.preventDefault(),
keyboardCode: (event) => event.code
},
image: {
new: (src) => {
const img = new Image();
img.src = src;
return img;
}
},
media: {
newAudio: (src) => new Audio(src),
play: (media) => media.play(),
pause: (media) => media.pause(),
volume: (media) => media.volume,
setVolume: (media, volume) => media.volume = volume,
setLoop: (media, loop) => media.loop = (loop == 1),
seek: (media, time) => media.currentTime = time
},
canvas: {
getContext: (elem, type) => elem.getContext(type),
setFillColor: (ctx, color) => ctx.fillStyle = color,
setFont: (ctx, font) => ctx.font = font,
setTextAlign: (ctx, align) => ctx.textAlign = align,
clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h),
fillRect: (ctx, x, y, w, h) => ctx.fillRect(x, y, w, h),
fillText: (ctx, text, x, y) => ctx.fillText(text, x, y),
drawImage: (ctx, image, sx, sy, sw, sh, dx, dy, dw, dh) => ctx.drawImage(image, sx, sy, sw, sh, dx, dy, dw, dh),
setScale: (ctx, sx, sy) => ctx.scale(sx, sy),
setTransform: (ctx, a, b, c, d, e, f) => ctx.setTransform(a, b, c, d, e, f),
setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1)
},
math: {
random: () => Math.random()
}
});
} catch(e) {
if(e instanceof WebAssembly.CompileError) {
document.getElementById("wasm-error").hidden = false;
}
throw e;
}
});

31
game.scm Normal file
View file

@ -0,0 +1,31 @@
(import (scheme base)
(scheme inexact)
(hoot ffi)
(dom canvas)
(dom document)
(dom element)
(dom event)
(dom image)
(dom media)
(dom window))
(define game-width 640.0)
(define game-height 480.0)
(define canvas (get-element-by-id "canvas"))
(define context (get-context canvas "2d"))
;; Draw
(define (draw prev-time)
(set-fill-color! context "#140c1c")
(set-text-align! context "center")
(set-font! context "bold 24px monospace")
(fill-text context "Hello, World! :)" (/ game-width 2.0) (/ game-height 2.0))
(request-animation-frame draw-callback))
(define draw-callback (procedure->external draw))
(set-element-width! canvas (exact game-width))
(set-element-height! canvas (exact game-height))
(request-animation-frame draw-callback)

17
index.html Normal file
View file

@ -0,0 +1,17 @@
<!DOCTYPE html>
<html>
<head>
<script type="text/javascript" src="js-runtime/reflect.js"></script>
<script type="text/javascript" src="game.js"></script>
<link rel="stylesheet" href="game.css" />
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
</head>
<body>
<canvas id="canvas"></canvas>
<p id="wasm-error" hidden="true">
A browser with Wasm GC and tail call support is required to play
this game. We recommend using either Mozilla Firefox or Google
Chrome. Safari is currently unsupported.
</p>
</body>
</html>

710
js-runtime/reflect.js Normal file
View file

@ -0,0 +1,710 @@
// -*- js2-basic-offset: 4 -*-
class Char {
constructor(codepoint) {
this.codepoint = codepoint;
}
toString() {
let ch = String.fromCodePoint(this.codepoint);
if (ch.match(/[a-zA-Z0-9$[\]().]/)) return `#\\${ch}`;
return `#\\x${this.codepoint.toString(16)}`;
}
}
class Eof { toString() { return "#<eof>"; } }
class Nil { toString() { return "#nil"; } }
class Null { toString() { return "()"; } }
class Unspecified { toString() { return "#<unspecified>"; } }
class Complex {
constructor(real, imag) {
this.real = real;
this.imag = imag;
}
toString() {
const sign = this.imag >= 0 && Number.isFinite(this.imag) ? "+": "";
return `${flonum_to_string(this.real)}${sign}${flonum_to_string(this.imag)}i`;
}
}
class Fraction {
constructor(num, denom) {
this.num = num;
this.denom = denom;
}
toString() {
return `${this.num}/${this.denom}`;
}
}
class HeapObject {
constructor(reflector, obj) {
this.reflector = reflector;
this.obj = obj;
}
repr() { return this.toString(); } // Default implementation.
}
class Pair extends HeapObject {
toString() { return "#<pair>"; }
repr() {
let car_repr = repr(this.reflector.car(this));
let cdr_repr = repr(this.reflector.cdr(this));
if (cdr_repr == '()')
return `(${car_repr})`;
if (cdr_repr.charAt(0) == '(')
return `(${car_repr} ${cdr_repr.substring(1)}`;
return `(${car_repr} . ${cdr_repr})`;
}
}
class MutablePair extends Pair { toString() { return "#<mutable-pair>"; } }
class Vector extends HeapObject {
toString() { return "#<vector>"; }
repr() {
let len = this.reflector.vector_length(this);
let out = '#(';
for (let i = 0; i < len; i++) {
if (i) out += ' ';
out += repr(this.reflector.vector_ref(this, i));
}
out += ')';
return out;
}
}
class MutableVector extends Vector {
toString() { return "#<mutable-vector>"; }
}
class Bytevector extends HeapObject {
toString() { return "#<bytevector>"; }
repr() {
let len = this.reflector.bytevector_length(this);
let out = '#vu8(';
for (let i = 0; i < len; i++) {
if (i) out += ' ';
out += this.reflector.bytevector_ref(this, i);
}
out += ')';
return out;
}
}
class MutableBytevector extends Bytevector {
toString() { return "#<mutable-bytevector>"; }
}
class Bitvector extends HeapObject {
toString() { return "#<bitvector>"; }
repr() {
let len = this.reflector.bitvector_length(this);
let out = '#*';
for (let i = 0; i < len; i++) {
out += this.reflector.bitvector_ref(this, i) ? '1' : '0';
}
return out;
}
}
class MutableBitvector extends Bitvector {
toString() { return "#<mutable-bitvector>"; }
}
class MutableString extends HeapObject {
toString() { return "#<mutable-string>"; }
repr() { return string_repr(this.reflector.string_value(this)); }
}
class Procedure extends HeapObject {
toString() { return "#<procedure>"; }
call(...arg) {
return this.reflector.call(this, ...arg);
}
}
class Sym extends HeapObject {
toString() { return "#<symbol>"; }
repr() { return this.reflector.symbol_name(this); }
}
class Keyword extends HeapObject {
toString() { return "#<keyword>"; }
repr() { return `#:${this.reflector.keyword_name(this)}`; }
}
class Variable extends HeapObject { toString() { return "#<variable>"; } }
class AtomicBox extends HeapObject { toString() { return "#<atomic-box>"; } }
class HashTable extends HeapObject { toString() { return "#<hash-table>"; } }
class WeakTable extends HeapObject { toString() { return "#<weak-table>"; } }
class Fluid extends HeapObject { toString() { return "#<fluid>"; } }
class DynamicState extends HeapObject { toString() { return "#<dynamic-state>"; } }
class Syntax extends HeapObject { toString() { return "#<syntax>"; } }
class Port extends HeapObject { toString() { return "#<port>"; } }
class Struct extends HeapObject { toString() { return "#<struct>"; } }
function instantiate_streaming(path, imports) {
if (typeof fetch !== 'undefined')
return WebAssembly.instantiateStreaming(fetch(path), imports);
let bytes;
if (typeof read !== 'undefined') {
bytes = read(path, 'binary');
} else if (typeof readFile !== 'undefined') {
bytes = readFile(path);
} else {
let fs = require('fs');
bytes = fs.readFileSync(path);
}
return WebAssembly.instantiate(bytes, imports);
}
class Scheme {
#instance;
#abi;
constructor(instance, abi) {
this.#instance = instance;
this.#abi = abi;
}
static async reflect(abi) {
let debug = {
debug_str(x) { console.log(`reflect debug: ${x}`); },
debug_str_i32(x, y) { console.log(`reflect debug: ${x}: ${y}`); },
debug_str_scm: (x, y) => {
console.log(`reflect debug: ${x}: #<scm>`);
},
};
let { module, instance } =
await instantiate_streaming('js-runtime/reflect.wasm', {
abi,
debug,
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); },
}
});
return new Scheme(instance, abi);
}
#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))}`);
},
});
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);
}
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) {
let api = this.#instance.exports;
if (typeof(js) == 'number') {
return api.scm_from_f64(js);
} else if (typeof(js) == 'bigint') {
if (BigInt(api.scm_most_negative_fixnum()) <= js
&& js <= BigInt(api.scm_most_positive_fixnum()))
return api.scm_from_fixnum(Number(js));
return api.scm_from_bignum(js);
} else if (typeof(js) == 'boolean') {
return js ? api.scm_true() : api.scm_false();
} else if (typeof(js) == 'string') {
return api.scm_from_string(js);
} else if (typeof(js) == 'object') {
if (js instanceof Eof) return api.scm_eof();
if (js instanceof Nil) return api.scm_nil();
if (js instanceof Null) return api.scm_null();
if (js instanceof Unspecified) return api.scm_unspecified();
if (js instanceof Char) return api.scm_from_char(js.codepoint);
if (js instanceof HeapObject) return js.obj;
if (js instanceof Fraction)
return api.scm_from_fraction(this.#to_scm(js.num),
this.#to_scm(js.denom));
if (js instanceof Complex)
return api.scm_from_complex(js.real, js.imag);
return api.scm_from_extern(js);
} else {
throw new Error(`unexpected; ${typeof(js)}`);
}
}
#to_js(scm) {
let api = this.#instance.exports;
let descr = api.describe(scm);
let handlers = {
fixnum: () => BigInt(api.fixnum_value(scm)),
char: () => new Char(api.char_value(scm)),
true: () => true,
false: () => false,
eof: () => new Eof,
nil: () => new Nil,
null: () => new Null,
unspecified: () => new Unspecified,
flonum: () => api.flonum_value(scm),
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))),
pair: () => new Pair(this, scm),
'mutable-pair': () => new MutablePair(this, scm),
vector: () => new Vector(this, scm),
'mutable-vector': () => new MutableVector(this, scm),
bytevector: () => new Bytevector(this, scm),
'mutable-bytevector': () => new MutableBytevector(this, scm),
bitvector: () => new Bitvector(this, scm),
'mutable-bitvector': () => new MutableBitvector(this, scm),
string: () => api.string_value(scm),
'mutable-string': () => new MutableString(this, scm),
procedure: () => new Procedure(this, scm),
symbol: () => new Sym(this, scm),
keyword: () => new Keyword(this, scm),
variable: () => new Variable(this, scm),
'atomic-box': () => new AtomicBox(this, scm),
'hash-table': () => new HashTable(this, scm),
'weak-table': () => new WeakTable(this, scm),
fluid: () => new Fluid(this, scm),
'dynamic-state': () => new DynamicState(this, scm),
syntax: () => new Syntax(this, scm),
port: () => new Port(this, scm),
struct: () => new Struct(this, scm),
'extern-ref': () => api.extern_value(scm)
};
let handler = handlers[descr];
return handler ? handler() : scm;
}
call(func, ...args) {
let api = this.#instance.exports;
let argv = api.make_vector(args.length + 1, api.scm_false());
func = this.#to_scm(func);
api.vector_set(argv, 0, func);
for (let [idx, arg] of args.entries())
api.vector_set(argv, idx + 1, this.#to_scm(arg));
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)))
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)); }
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));
}
bytevector_length(x) {
return this.#instance.exports.bytevector_length(x.obj);
}
bytevector_ref(x, i) {
return this.#instance.exports.bytevector_ref(x.obj, i);
}
bitvector_length(x) {
return this.#instance.exports.bitvector_length(x.obj);
}
bitvector_ref(x, i) {
return this.#instance.exports.bitvector_ref(x.obj, i) == 1;
}
string_value(x) { return this.#instance.exports.string_value(x.obj); }
symbol_name(x) { return this.#instance.exports.symbol_name(x.obj); }
keyword_name(x) { return this.#instance.exports.keyword_name(x.obj); }
}
class SchemeTrapError extends Error {
constructor(tag, data) { super(); this.tag = tag; this.data = data; }
// FIXME: data is raw Scheme object; would need to be reflected to
// have a toString.
toString() { return `SchemeTrap(${this.tag}, <data>)`; }
}
function string_repr(str) {
// FIXME: Improve to match Scheme.
return '"' + str.replace(/(["\\])/g, '\\$1').replace(/\n/g, '\\n') + '"';
}
function flonum_to_string(f64) {
if (Object.is(f64, -0)) {
return '-0.0';
} else if (Number.isFinite(f64)) {
let repr = f64 + '';
return /^-?[0-9]+$/.test(repr) ? repr + '.0' : repr;
} else if (Number.isNaN(f64)) {
return '+nan.0';
} else {
return f64 < 0 ? '-inf.0' : '+inf.0';
}
}
let wtf8_helper;
function wtf8_to_string(wtf8) {
let { as_iter, iter_next } = wtf8_helper.exports;
let codepoints = [];
let iter = as_iter(wtf8);
for (let cp = iter_next(iter); cp != -1; cp = iter_next(iter))
codepoints.push(cp);
// 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) {
let { string_builder, builder_push_codepoint, finish_builder } =
wtf8_helper.exports;
let builder = string_builder()
for (let cp of str)
builder_push_codepoint(builder, cp.codePointAt(0));
return finish_builder(builder);
}
async function load_wtf8_helper_module() {
if (wtf8_helper) return;
let { module, instance } = await instantiate_streaming("js-runtime/wtf8.wasm");
wtf8_helper = instance;
}
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); },
bignum_from_i64(n) { return n; },
bignum_from_u64(n) { return n < 0n ? 0xffff_ffff_ffff_ffffn + (n + 1n) : n; },
bignum_is_i64(n) {
return -0x8000_0000_0000_0000n <= n && n <= 0x7FFF_FFFF_FFFF_FFFFn;
},
bignum_is_u64(n) {
return 0n <= n && n <= 0xFFFF_FFFF_FFFF_FFFFn;
},
// This truncates; see https://tc39.es/ecma262/#sec-tobigint64.
bignum_get_i64(n) { return n; },
bignum_add(a, b) { return BigInt(a) + BigInt(b) },
bignum_sub(a, b) { return BigInt(a) - BigInt(b) },
bignum_mul(a, b) { return BigInt(a) * BigInt(b) },
bignum_lsh(a, b) { return BigInt(a) << BigInt(b) },
bignum_rsh(a, b) { return BigInt(a) >> BigInt(b) },
bignum_quo(a, b) { return BigInt(a) / BigInt(b) },
bignum_rem(a, b) { return BigInt(a) % BigInt(b) },
bignum_mod(a, b) {
let r = BigInt(a) % BigInt(b);
if ((b > 0n && r < 0n) || (b < 0n && r > 0n)) {
return b + r;
} else {
return r;
}
},
bignum_gcd(a, b) {
a = BigInt(a);
b = BigInt(b);
if (a < 0n) { a = -a; }
if (b < 0n) { b = -b; }
if (a == 0n) { return b; }
if (b == 0n) { return a; }
let r;
while (b != 0n) {
r = a % b;
a = b;
b = r;
}
return a;
},
bignum_logand(a, b) { return BigInt(a) & BigInt(b); },
bignum_logior(a, b) { return BigInt(a) | BigInt(b); },
bignum_logxor(a, b) { return BigInt(a) ^ BigInt(b); },
bignum_logsub(a, b) { return BigInt(a) & (~ BigInt(b)); },
bignum_lt(a, b) { return a < b; },
bignum_le(a, b) { return a <= b; },
bignum_eq(a, b) { return a == b; },
bignum_to_f64(n) { return Number(n); },
f64_is_nan(n) { return Number.isNaN(n); },
f64_is_infinite(n) { return !Number.isFinite(n); },
flonum_to_string,
string_upcase: Function.call.bind(String.prototype.toUpperCase),
string_downcase: Function.call.bind(String.prototype.toLowerCase),
make_weak_map() { return new WeakMap; },
weak_map_get(map, k, fail) {
const val = map.get(k);
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); },
fsqrt: Math.sqrt,
fsin: Math.sin,
fcos: Math.cos,
ftan: Math.tan,
fasin: Math.asin,
facos: Math.acos,
fatan: Math.atan,
fatan2: Math.atan2,
flog: Math.log,
fexp: Math.exp,
jiffies_per_second() { return 1000000; },
current_jiffy() { return performance.now() * 1000; },
current_second() { return Date.now() / 1000; },
// Wrap in functions to allow for lazy loading of the wtf8
// module.
wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); },
string_to_wtf8(str) { return string_to_wtf8(str); },
die(tag, data) { throw new SchemeTrapError(tag, data); }
};
constructor(instance) {
this.#instance = instance;
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,
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 if (typeof window !== 'undefined') { // web browser
this.#io_handler = {
write_stdout: console.log,
write_stderr: console.error,
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}`); },
debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
debug_str_scm(x, y) { console.log(`debug: ${x}: #<scm>`); },
};
}
static async fetch_and_instantiate(path, imported_abi, user_imports = {}) {
await load_wtf8_helper_module();
let io = {
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); },
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, ffi, ...user_imports
};
let { module, instance } = await instantiate_streaming(path, imports);
let mod = new SchemeModule(instance);
return mod;
}
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 = {}
for (let [k, v] of Object.entries(this.all_exports())) {
if (k.startsWith("$"))
abi[k] = v;
}
return abi;
}
exports() {
let ret = {}
for (let [k, v] of Object.entries(this.all_exports())) {
if (!k.startsWith("$"))
ret[k] = v;
}
return ret;
}
get_export(name) {
if (name in this.all_exports())
return this.all_exports()[name];
throw new Error(`unknown export: ${name}`)
}
async reflect() {
return await Scheme.reflect(this.exported_abi());
}
}
function repr(obj) {
if (obj instanceof HeapObject)
return obj.repr();
if (typeof obj === 'boolean')
return obj ? '#t' : '#f';
if (typeof obj === 'number')
return flonum_to_string(obj);
if (typeof obj === 'string')
return string_repr(obj);
return obj + '';
}

BIN
js-runtime/reflect.wasm Normal file
View file

Binary file not shown.

BIN
js-runtime/wtf8.wasm Normal file
View file

Binary file not shown.

7
manifest.scm Normal file
View file

@ -0,0 +1,7 @@
(use-modules (guix packages)
(gnu packages base)
(gnu packages compression)
(gnu packages guile)
(gnu packages guile-xyz))
(packages->manifest (list guile-next guile-hoot gnu-make zip))

72
modules/dom/canvas.scm Normal file
View file

@ -0,0 +1,72 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; HTMLCanvasElement and CanvasRenderingContext2D bindings.
;;;
;;; Code:
(define-module (dom canvas)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (get-context
set-fill-color!
set-font!
set-text-align!
clear-rect
fill-rect
fill-text
draw-image
set-scale!
set-transform!
set-image-smoothing-enabled!))
;; HTMLCanvasElement
(define-foreign get-context
"canvas" "getContext"
(ref extern) (ref string) -> (ref extern))
;; CanvasRenderingContext2D
(define-foreign set-fill-color!
"canvas" "setFillColor"
(ref extern) (ref string) -> none)
(define-foreign set-font!
"canvas" "setFont"
(ref extern) (ref string) -> none)
(define-foreign set-text-align!
"canvas" "setTextAlign"
(ref extern) (ref string) -> none)
(define-foreign clear-rect
"canvas" "clearRect"
(ref extern) f64 f64 f64 f64 -> none)
(define-foreign fill-rect
"canvas" "fillRect"
(ref extern) f64 f64 f64 f64 -> none)
(define-foreign fill-text
"canvas" "fillText"
(ref 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)
(define-foreign set-scale!
"canvas" "setScale"
(ref extern) f64 f64 -> none)
(define-foreign set-transform!
"canvas" "setTransform"
(ref extern) f64 f64 f64 f64 f64 f64 -> none)
(define-foreign set-image-smoothing-enabled!
"canvas" "setImageSmoothingEnabled"
(ref extern) i32 -> none)

45
modules/dom/document.scm Normal file
View file

@ -0,0 +1,45 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Document bindings.
;;;
;;; Code:
(define-module (dom document)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (current-document
document-body
get-element-by-id
make-text-node
make-element))
(define-foreign current-document
"document" "get"
-> (ref extern))
(define-foreign document-body
"document" "body"
-> (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))
(define-foreign make-element
"document" "createElement"
(ref string) -> (ref extern))

71
modules/dom/element.scm Normal file
View file

@ -0,0 +1,71 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Element bindings.
;;;
;;; Code:
(define-module (dom element)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (element-value
set-element-value!
element-width set-element-width!
element-height set-element-height!
append-child!
remove!
replace-with!
set-attribute!
remove-attribute!
clone-element))
(define-foreign element-value
"element" "value"
(ref extern) -> (ref string))
(define-foreign set-element-value!
"element" "setValue"
(ref extern) (ref string) -> none)
(define-foreign element-width
"element" "width"
(ref extern) -> i32)
(define-foreign element-height
"element" "height"
(ref extern) -> i32)
(define-foreign set-element-width!
"element" "setWidth"
(ref extern) i32 -> none)
(define-foreign set-element-height!
"element" "setHeight"
(ref extern) i32 -> none)
(define-foreign append-child!
"element" "appendChild"
(ref extern) (ref extern) -> (ref extern))
(define-foreign remove!
"element" "remove"
(ref extern) -> none)
(define-foreign replace-with!
"element" "replaceWith"
(ref extern) (ref extern) -> none)
(define-foreign set-attribute!
"element" "setAttribute"
(ref extern) (ref string) (ref string) -> none)
(define-foreign remove-attribute!
"element" "removeAttribute"
(ref extern) (ref string) -> none)
(define-foreign clone-element
"element" "clone"
(ref extern) -> (ref extern))

46
modules/dom/event.scm Normal file
View file

@ -0,0 +1,46 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; EventTarget and Event bindings.
;;;
;;; Code:
(define-module (dom event)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (add-event-listener!
remove-event-listener!
prevent-default!
keyboard-event-code))
;; EventTarget
(define-foreign add-event-listener!
"event" "addEventListener"
(ref extern) (ref string) (ref extern) -> none)
(define-foreign remove-event-listener!
"event" "removeEventListener"
(ref extern) (ref string) (ref extern) -> none)
;; Event
(define-foreign prevent-default!
"event" "preventDefault"
(ref extern) -> none)
;; KeyboardEvent
(define-foreign keyboard-event-code
"event" "keyboardCode"
(ref extern) -> (ref string))

29
modules/dom/image.scm Normal file
View file

@ -0,0 +1,29 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; HTMLImageElement bindings.
;;;
;;; Code:
(define-module (dom image)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (make-image))
(define-foreign make-image
"image" "new"
(ref string) -> (ref extern))

54
modules/dom/media.scm Normal file
View file

@ -0,0 +1,54 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; HTMLMediaElement bindings.
;;;
;;; Code:
(library (dom media)
(export make-audio
media-play
media-pause
media-volume
set-media-volume!
set-media-loop!
media-seek)
(import (scheme base)
(hoot ffi)
(hoot match)
(only (hoot syntax) define*))
(define-foreign make-audio
"media" "newAudio"
(ref string) -> (ref extern))
(define-foreign media-play
"media" "play"
(ref extern) -> none)
(define-foreign media-pause
"media" "pause"
(ref extern) -> none)
(define-foreign media-volume
"media" "volume"
(ref extern) -> f64)
(define-foreign set-media-volume!
"media" "setVolume"
(ref extern) f64 -> none)
(define-foreign set-media-loop!
"media" "setLoop"
(ref extern) i32 -> none)
(define-foreign media-seek
"media" "seek"
(ref extern) f64 -> none))

45
modules/dom/window.scm Normal file
View file

@ -0,0 +1,45 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Window bindings.
;;;
;;; Code:
(define-module (dom window)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (current-window
window-inner-width
window-inner-height
request-animation-frame
timeout))
(define-foreign current-window
"window" "get"
-> (ref extern))
(define-foreign window-inner-width
"window" "innerWidth"
(ref extern) -> i32)
(define-foreign window-inner-height
"window" "innerHeight"
(ref extern) -> i32)
(define-foreign request-animation-frame
"window" "requestAnimationFrame"
(ref extern) -> none)
(define-foreign timeout
"window" "setTimeout"
(ref extern) f64 -> i32)

49
modules/math.scm Normal file
View file

@ -0,0 +1,49 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Helpful math things.
;;;
;;; Code:
;; (library (math)
;; (export random
;; clamp)
;; (import (scheme base)
;; (hoot ffi))
;; (define-foreign random
;; "math" "random"
;; -> f64)
;; (define (clamp x min max)
;; (cond ((< x min) min)
;; ((> x max) max)
;; (else x))))
(define-module (math)
#:pure
#:use-module (scheme base)
#:use-module (hoot ffi)
#:export (random clamp))
(define-foreign random
"math" "random"
-> f64)
(define (clamp x min max)
(cond ((< x min) min)
((> x max) max)
(else x)))

96
modules/math/rect.scm Normal file
View file

@ -0,0 +1,96 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Rectangle data type.
;;;
;;; Code:
(define-module (math rect)
#:pure
#:use-module (scheme base)
#:use-module ((hoot bytevectors)
#:select
(bytevector-ieee-double-native-ref
bytevector-ieee-double-native-set!))
#:export (make-rect
rect?
rect-x
rect-y
rect-width
rect-height
set-rect-x!
set-rect-y!
set-rect-width!
set-rect-height!
rect-intersects?
rect-clip))
;; For speed, a rect is a wrapper around a bytevector so that we can
;; use unboxed floats.
(define-record-type <rect>
(%make-rect bv)
rect?
(bv rect-bv))
(define f64-ref bytevector-ieee-double-native-ref)
(define f64-set! bytevector-ieee-double-native-set!)
(define (make-rect x y w h)
(let ((bv (make-bytevector (* 8 4))))
(f64-set! bv 0 x)
(f64-set! bv 8 y)
(f64-set! bv 16 w)
(f64-set! bv 24 h)
(%make-rect bv)))
(define (rect-x r)
(f64-ref (rect-bv r) 0))
(define (rect-y r)
(f64-ref (rect-bv r) 8))
(define (rect-width r)
(f64-ref (rect-bv r) 16))
(define (rect-height r)
(f64-ref (rect-bv r) 24))
(define (set-rect-x! r x)
(f64-set! (rect-bv r) 0 x))
(define (set-rect-y! r y)
(f64-set! (rect-bv r) 8 y))
(define (set-rect-width! r width)
(f64-set! (rect-bv r) 16 width))
(define (set-rect-height! r height)
(f64-set! (rect-bv r) 24 height))
(define (rect-intersects? a b)
(and (< (rect-x a) (+ (rect-x b) (rect-width b)))
(< (rect-y a) (+ (rect-y b) (rect-height b)))
(> (+ (rect-x a) (rect-width a)) (rect-x b))
(> (+ (rect-y a) (rect-height a)) (rect-y b))))
(define (rect-clip a b)
(let* ((x1 (max (rect-x a) (rect-x b)))
(x2 (min (+ (rect-x a) (rect-width a))
(+ (rect-x b) (rect-width b))))
(y1 (max (rect-y a) (rect-y b)))
(y2 (min (+ (rect-y a) (rect-height a))
(+ (rect-y b) (rect-height b)))))
(make-rect x1 y1 (- x2 x1) (- y2 y1))))

94
modules/math/vector.scm Normal file
View file

@ -0,0 +1,94 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Vectors, in the linear algebra sense.
;;;
;;; Code:
(define-module (math vector)
#:pure
#:use-module (scheme base)
#:use-module (scheme inexact)
#:use-module ((hoot bytevectors)
#:select
(bytevector-ieee-double-native-ref
bytevector-ieee-double-native-set!))
#:use-module (math)
#:export (vec2
vec2?
vec2-x
vec2-y
set-vec2-x!
set-vec2-y!
vec2-add!
vec2-sub!
vec2-mul-scalar!
vec2-magnitude
vec2-normalize!
vec2-clamp!))
;; For speed, a vec2 is a wrapper around a bytevector so that we can
;; use unboxed floats.
(define-record-type <vec2>
(make-vec2 bv)
vec2?
(bv vec2-bv))
(define f64-ref bytevector-ieee-double-native-ref)
(define f64-set! bytevector-ieee-double-native-set!)
(define (vec2 x y)
(let ((v (make-vec2 (make-bytevector 16))))
(set-vec2-x! v x)
(set-vec2-y! v y)
v))
(define (vec2-x v)
(f64-ref (vec2-bv v) 0))
(define (vec2-y v)
(f64-ref (vec2-bv v) 8))
(define (set-vec2-x! v x)
(f64-set! (vec2-bv v) 0 x))
(define (set-vec2-y! v y)
(f64-set! (vec2-bv v) 8 y))
(define (vec2-add! v w)
(set-vec2-x! v (+ (vec2-x v) (vec2-x w)))
(set-vec2-y! v (+ (vec2-y v) (vec2-y w))))
(define (vec2-sub! v w)
(set-vec2-x! v (- (vec2-x v) (vec2-x w)))
(set-vec2-y! v (- (vec2-y v) (vec2-y w))))
(define (vec2-mul-scalar! v x)
(set-vec2-x! v (* (vec2-x v) x))
(set-vec2-y! v (* (vec2-y v) x)))
(define (vec2-magnitude v)
(sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v)))))
(define (vec2-normalize! v)
(unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
(let ((m (vec2-magnitude v)))
(set-vec2-x! v (/ (vec2-x v) m))
(set-vec2-y! v (/ (vec2-y v) m)))))
(define (vec2-clamp! v xmin ymin xmax ymax)
(set-vec2-x! v (clamp (vec2-x v) xmin xmax))
(set-vec2-y! v (clamp (vec2-y v) ymin ymax)))