initial commit

.gitignore

@@ -0,0 +1,2 @@
+*.wasm
+reflect.js

README.md

@@ -0,0 +1,10 @@
+# My hoot experiments!
+
+## Prerequisites
+* Need hoot
+* Need to put hoot's `reflect.js` in here
+* Need to put hoot's `js-runtime/` folder in here
+
+## Running
+* Run `guile hello.scm` to build the hello.wasm file
+* Then run `guile web-server.scm` to run a web server and host the files on :8080

hello.js

@@ -0,0 +1,19 @@
+async function load() {
+    const [message] = await Scheme.load_main("hello.wasm", {}, {
+        js: {
+            alert: alert,
+            prompt: prompt,
+        },
+        document: {
+            body() { return document.body; },
+            createTextNode: Document.prototype.createTextNode.bind(document),
+            createElement: Document.prototype.createElement.bind(document),
+        },
+        element: {
+            appendChild(parent, child) { return parent.appendChild(child); },
+            setAttribute(elem, name, value) { elem.setAttribute(name, value); },
+        }
+    });
+    console.log(message);
+}
+window.addEventListener("load", load);

hello.scm

@@ -0,0 +1,86 @@
+(use-modules (hoot compile)
+             (ice-9 binary-ports)
+             (wasm assemble))
+(define src
+  '(let ()
+     (define (sxml->dom exp)
+       (match exp
+         ;; The simple case: a string representing a text node.
+         ((?  string? str)
+          (make-text-node str))
+         ;; An element tree.  The first item is the HTML tag.
+         (((?  symbol? tag) . body)
+          ;; Create a new element with the given tag.
+          (let ((elem (make-element (symbol->string tag))))
+            (define (add-children children)
+              ;; Recursively call sxml->dom for each child node and
+              ;; append it to elem.
+              (for-each (lambda (child)
+                          (append-child! elem (sxml->dom child)))
+                        children))
+            (match body
+              ;; '@' denotes an attribute list.  Child nodes follow.
+              ((('@ . attrs) . children)
+               ;; Set attributes.
+               (for-each (lambda (attr)
+                           (match attr
+                             ;; Attributes are (symbol string) tuples.
+                             (((?  symbol? name) (?  string? val))
+                              (set-attribute! elem
+                                              (symbol->string name)
+                                              val))))
+                         attrs)
+               (add-children children))
+              ;; No attributes, just a list of child nodes.
+              (children (add-children children)))
+            elem))))
+
+     (define sxml
+       '(section
+         (h1 "Vivi rocks!")
+         (p "Vivi is the "
+            (b "best")
+            " and "
+            (i "rocks")
+            " :)")
+         (p "Go to " (a (@ (href "https://vvv.gay")) "vvv.gay") " now!")))
+
+     (define-foreign alert
+       "js" "alert"
+       (ref string) -> (ref null extern))
+
+     (define-foreign prompt
+       "js" "prompt"
+       (ref string) -> (ref string))
+
+     (define-foreign document-body
+       "document" "body"
+       -> (ref null extern))
+
+     (define-foreign make-text-node
+       "document" "createTextNode"
+       (ref string) -> (ref null extern))
+
+     (define-foreign append-child!
+       "element" "appendChild"
+       (ref null extern) (ref null extern) -> (ref null extern))
+
+     (define-foreign make-element
+       "document" "createElement"
+       (ref string) -> (ref null extern))
+
+     (define-foreign set-attribute!
+       "element" "setAttribute"
+       (ref null extern) (ref string) (ref string) -> none)
+
+     (append-child!
+      (document-body)
+      (if (> (string->number (prompt "What's your age?")) 2)
+          (sxml->dom sxml)
+          (make-text-node "You probably can't read! What are you doing here??")))
+
+     "hey :)"))
+
+(call-with-output-file "hello.wasm"
+  (lambda (port)
+    (put-bytevector port (assemble-wasm (compile src)))))

index.html

@@ -0,0 +1,8 @@
+<!DOCTYPE html>
+<html>
+    <head>
+        <script type="text/javascript" src="reflect.js"></script>
+        <script type="text/javascript" src="hello.js"></script>
+    </head>
+    <body/>
+</html>

web-server.scm

@@ -0,0 +1,38 @@
+(use-modules (ice-9 binary-ports) (ice-9 format) (ice-9 match)
+             (web server) (web request) (web response) (web uri))
+
+(define (extension file)
+  (match (string-split file #\.)
+    (() #f)
+    ((_ ... ext) ext)))
+
+(define (mime-type file-name)
+  (or (assoc-ref '(("js" . application/javascript)
+                   ("html" . text/html)
+                   ("wasm" . application/wasm))
+                 (extension file-name))
+      'text/plain))
+
+(define (render-file file-name)
+  (values `((content-type . (,(mime-type file-name))))
+          (call-with-input-file file-name get-bytevector-all)))
+
+(define (not-found path)
+  (values (build-response #:code 404) (string-append "Not found: " path)))
+
+(define (directory? file-name)
+  (eq? (stat:type (stat file-name)) 'directory))
+
+(define (serve-file path)
+  (let ((f (string-append (getcwd) (uri-decode path))))
+    (if (and (file-exists? f) (not (directory? f)))
+        (render-file f)
+        (not-found path))))
+
+(define (handle-request request body)
+  (let ((method (request-method request))
+        (path (uri-path (request-uri request))))
+    (format #t "~a ~a\n" method path)
+    (serve-file path)))
+
+(run-server handle-request 'http '(#:port 8080))