initial commit
This commit is contained in:
commit
b84e82e1b7
|
@ -0,0 +1,2 @@
|
||||||
|
*.wasm
|
||||||
|
reflect.js
|
|
@ -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
|
|
@ -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);
|
|
@ -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)))))
|
|
@ -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>
|
|
@ -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))
|
Loading…
Reference in New Issue