From e970ed8706578375b2b7bce795f6923cbb16386f Mon Sep 17 00:00:00 2001 From: SouthFox Date: Sun, 19 May 2024 23:34:25 +0800 Subject: [PATCH] [build] first commit --- .gitignore | 2 + COPYING | 202 +++++++++++ Makefile | 24 ++ game.css | 11 + game.js | 77 +++++ game.scm | 31 ++ index.html | 17 + js-runtime/reflect.js | 710 +++++++++++++++++++++++++++++++++++++++ js-runtime/reflect.wasm | Bin 0 -> 5196 bytes js-runtime/wtf8.wasm | Bin 0 -> 1071 bytes manifest.scm | 7 + modules/dom/canvas.scm | 72 ++++ modules/dom/document.scm | 45 +++ modules/dom/element.scm | 71 ++++ modules/dom/event.scm | 46 +++ modules/dom/image.scm | 29 ++ modules/dom/media.scm | 54 +++ modules/dom/window.scm | 45 +++ modules/math.scm | 49 +++ modules/math/rect.scm | 96 ++++++ modules/math/vector.scm | 94 ++++++ 21 files changed, 1682 insertions(+) create mode 100644 .gitignore create mode 100644 COPYING create mode 100644 Makefile create mode 100644 game.css create mode 100644 game.js create mode 100644 game.scm create mode 100644 index.html create mode 100644 js-runtime/reflect.js create mode 100644 js-runtime/reflect.wasm create mode 100644 js-runtime/wtf8.wasm create mode 100644 manifest.scm create mode 100644 modules/dom/canvas.scm create mode 100644 modules/dom/document.scm create mode 100644 modules/dom/element.scm create mode 100644 modules/dom/event.scm create mode 100644 modules/dom/image.scm create mode 100644 modules/dom/media.scm create mode 100644 modules/dom/window.scm create mode 100644 modules/math.scm create mode 100644 modules/math/rect.scm create mode 100644 modules/math/vector.scm 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 0000000000000000000000000000000000000000..770c94c16c0500eca9e63e50db1e656495e0355c GIT binary patch literal 5196 zcmds4S##Ug6}}f6mkW>}MNzv92#~j!@e;?5vkH!_CTW_w`yPrSAej~yg@j~###8ps z^eNLm_O1O5u7hd+LtpyRmku@4e&+(DXydR)U-n7k0c-Lxf57#oGUn|8BP0bm5`-j>=$QoSm_K7P2nYD16_CR( z{vL4iEF-;!Dr`#99iddF0NGMTNO~BvkONoAL55RX2Dde7ODL6TGf%Y{T9_dUB(+Ns zdE_#VRGQ{V38wKAT9K=DDN8fUlob+@<(L0zknqrwzcPDiaK>l*GU9M4A0Szsjixqb zB=0q`VXBmSz}{~fFN>t%W;6E{sZ^YA=D$uMbr+h2Z_r8g#b)uF)zae9w_05OR*O2N z9BM3FV_}_P-caX8QvoIx&=@oNK9TjMzLFNk)Vf9!jo~|t?HJk2hT53zDB%FL-r;SA z5d|6W5F8Y;Q*4LvF<3AVKnL=ShXshku9SD-0rSs8v7z z5vil1WNLD&a3Lj&DKS$E4Ur*C9+r31una_zma;fXaIA)vu?*kFK*F<)UnQ)jOjU{u zWRqsp+tFt^lcRcA;$aD^)@V01TuD>tK?TU$CR9E0k-F2Ry9U(+ES&Jz9^?vZHqIl%4a#Xs>nDjT?uZr^_6&Yd^kdix#udH21o;O^b`@7=$@z5SgJKK$sT z?|%HfPrm=)2S5DLkAL!0P1A1t?B~Du<*$By_cxz5Z`{~v?Y5E34dWmDLYwjDO#I*e zs{FYs#ynsm_fPFoK8!}~VP`jD!6KU5>g|{!fhyr;^>yJ}obrr#824GEtCht2>IAnIqiqbeWZx=&0LeB?;r;I=xJ|v&~5fxy@=g252B}!2g5LB@2hR3=&J2-$Tmc;br3a=qjo$PGQXID z<|vBU=9C#md+fZGX}VE=KYqwAly;xS(HZNDX9cw4Qss_#%S7_l5|N^{NJLl*L@aBb zh-uY{l&v`;C96iHVpWLPR+Y${RVGrkY$EfPMWkkxh}12U$buz^ELue(OICr%vXv*Y zV&#aeS_Y9dODD2!X++LhNPJRrEQN?`aUup)#XFyvE5ch$%w^$uiMb@a)x=yB-g06t z2=7W_)`fR5G3SN1l$bT)T~5q7;k}ZWRpHeWvm(55V%oxU6SFM5jl?VouauaU@T|l% zg;z;TA-q=;vnV_}F$=D)%w@OI`fQxANYocF*@*(FqO|yJ+{f`HL=9(8-W4=#vchOlX`uk z)JfwoFX!d4ig|@e{mMkSqS&v$xIST5?YCcCvpsP;?V)bpP`3;uoceXNnwDdZ{>Wn= zX@6%0uDhD6x{AwPhQ{ObZ?4h-EmZj!aiV`NBA%?eiu_gOulBVy)hFdISJl9a+JPKJ z{ZK=JCuLg`sI&nA%57jW&NFZ*wBZ<}pOqRapUYAcQV8jUWcf8hD1siSgfN+Upa8j2 zMg!+cJ4Q$mFRt1iIj71}KdFZHYu>fQ)t{^WHFQLuuo4E^!~2)iYuvsi);NyrR5<&# zt2*jmwXo+XIvT1_rS>#AXgJX;A*?3KiUKQczX5~tp-VfZ5g}a-|0nKiThGlhMr=|y zDOq^o1a<5U=sduY)=9wF^CX$+*U#w5{@j;%C*%L6;Hd}- zlLBMD05X8MZvs_-6yM5Zs$a^G=9htr(CWSoL~9Md0;B=u{3?(D%KLLbXy%4rKZZnVsb?0+HvEzXW6fmHlO)GLY@BWOfyQ6^M4L`fETc(44=X$!h*N zpb}*Bz5_(@)qOXUE%+Om-J3V5<7DX7uHs<)27>T9PzThKO8)6$Xl$uO(Kqd+%vD@qc=2)6I>>@D(hCJIw&DTB hwmW#j^T(}WM~1A+yD!gWcLQFXMslW9=2S+p{ulE8lm-9* literal 0 HcmV?d00001 diff --git a/js-runtime/wtf8.wasm b/js-runtime/wtf8.wasm new file mode 100644 index 0000000000000000000000000000000000000000..ca1079dcdb787237c463525b72e85fd7fe3824f9 GIT binary patch literal 1071 zcmc&zy>in)5Z>K8Np{Y$ND9@bhJqnALxnB{8Hx-uJOFY)1|+~qY(3{)&9`^o?zcZD!P(+70suZ8zP`qiDgYY*Elz~BmaLs%1y~^iqMfiy z6ROApUl3CwiG_^fWDp4iOkPFF*`lo5=^SwAp`1;xTcGixo!7JX<(sSeQ^lmnetG4^ z)#5|>_Pm;2oY%7!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)))