commit e970ed8706578375b2b7bce795f6923cbb16386f Author: SouthFox Date: Sun May 19 23:34:25 2024 +0800 [build] first commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d1ab642 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/game.wasm +/game.zip diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..d645695 --- /dev/null +++ b/COPYING @@ -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. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f0d24dd --- /dev/null +++ b/Makefile @@ -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 diff --git a/game.css b/game.css new file mode 100644 index 0000000..5ff196f --- /dev/null +++ b/game.css @@ -0,0 +1,11 @@ +body { + /* background-color: #000; */ + margin: 0; + width: 100vw; + height: 100vh; +} + +canvas { + display: block; + margin: 0 auto; +} diff --git a/game.js b/game.js new file mode 100644 index 0000000..89f0b12 --- /dev/null +++ b/game.js @@ -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; + } +}); diff --git a/game.scm b/game.scm new file mode 100644 index 0000000..c77a00a --- /dev/null +++ b/game.scm @@ -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) diff --git a/index.html b/index.html new file mode 100644 index 0000000..1c4ea28 --- /dev/null +++ b/index.html @@ -0,0 +1,17 @@ + + + + + + + + + + + + + diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js new file mode 100644 index 0000000..1e66c50 --- /dev/null +++ b/js-runtime/reflect.js @@ -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 "#"; } } +class Nil { toString() { return "#nil"; } } +class Null { toString() { return "()"; } } +class Unspecified { toString() { return "#"; } } + +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 "#"; } + 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 "#"; } } + +class Vector extends HeapObject { + toString() { return "#"; } + 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 "#"; } +} + +class Bytevector extends HeapObject { + toString() { return "#"; } + 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 "#"; } +} + +class Bitvector extends HeapObject { + toString() { return "#"; } + 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 "#"; } +} + +class MutableString extends HeapObject { + toString() { return "#"; } + repr() { return string_repr(this.reflector.string_value(this)); } +} + +class Procedure extends HeapObject { + toString() { return "#"; } + call(...arg) { + return this.reflector.call(this, ...arg); + } +} + +class Sym extends HeapObject { + toString() { return "#"; } + repr() { return this.reflector.symbol_name(this); } +} + +class Keyword extends HeapObject { + toString() { return "#"; } + repr() { return `#:${this.reflector.keyword_name(this)}`; } +} + +class Variable extends HeapObject { toString() { return "#"; } } +class AtomicBox extends HeapObject { toString() { return "#"; } } +class HashTable extends HeapObject { toString() { return "#"; } } +class WeakTable extends HeapObject { toString() { return "#"; } } +class Fluid extends HeapObject { toString() { return "#"; } } +class DynamicState extends HeapObject { toString() { return "#"; } } +class Syntax extends HeapObject { toString() { return "#"; } } +class Port extends HeapObject { toString() { return "#"; } } +class Struct extends HeapObject { toString() { return "#"; } } + +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}: #`); + }, + }; + 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}, )`; } +} + +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}: #`); }, + }; + } + 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 + ''; +} diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm new file mode 100644 index 0000000..770c94c Binary files /dev/null and b/js-runtime/reflect.wasm differ diff --git a/js-runtime/wtf8.wasm b/js-runtime/wtf8.wasm new file mode 100644 index 0000000..ca1079d Binary files /dev/null and b/js-runtime/wtf8.wasm differ diff --git a/manifest.scm b/manifest.scm new file mode 100644 index 0000000..198ee07 --- /dev/null +++ b/manifest.scm @@ -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)) diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm new file mode 100644 index 0000000..57bd7fc --- /dev/null +++ b/modules/dom/canvas.scm @@ -0,0 +1,72 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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) diff --git a/modules/dom/document.scm b/modules/dom/document.scm new file mode 100644 index 0000000..6fbbc1b --- /dev/null +++ b/modules/dom/document.scm @@ -0,0 +1,45 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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)) diff --git a/modules/dom/element.scm b/modules/dom/element.scm new file mode 100644 index 0000000..539b5d5 --- /dev/null +++ b/modules/dom/element.scm @@ -0,0 +1,71 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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)) diff --git a/modules/dom/event.scm b/modules/dom/event.scm new file mode 100644 index 0000000..65594fb --- /dev/null +++ b/modules/dom/event.scm @@ -0,0 +1,46 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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)) diff --git a/modules/dom/image.scm b/modules/dom/image.scm new file mode 100644 index 0000000..c85f205 --- /dev/null +++ b/modules/dom/image.scm @@ -0,0 +1,29 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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)) diff --git a/modules/dom/media.scm b/modules/dom/media.scm new file mode 100644 index 0000000..a0acd2a --- /dev/null +++ b/modules/dom/media.scm @@ -0,0 +1,54 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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)) diff --git a/modules/dom/window.scm b/modules/dom/window.scm new file mode 100644 index 0000000..edb2b04 --- /dev/null +++ b/modules/dom/window.scm @@ -0,0 +1,45 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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) diff --git a/modules/math.scm b/modules/math.scm new file mode 100644 index 0000000..2f8c4f9 --- /dev/null +++ b/modules/math.scm @@ -0,0 +1,49 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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))) diff --git a/modules/math/rect.scm b/modules/math/rect.scm new file mode 100644 index 0000000..35b846f --- /dev/null +++ b/modules/math/rect.scm @@ -0,0 +1,96 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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 + (%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)))) diff --git a/modules/math/vector.scm b/modules/math/vector.scm new file mode 100644 index 0000000..6dcf2f2 --- /dev/null +++ b/modules/math/vector.scm @@ -0,0 +1,94 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; 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 + (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)))