diff --git a/index.html b/index.html index 7ee16df..84405ba 100644 --- a/index.html +++ b/index.html @@ -12,7 +12,5 @@ this game. We recommend using either Mozilla Firefox or Google Chrome. Safari is currently unsupported.

- - diff --git a/modules/reactive.scm b/modules/reactive.scm index 635a75d..331a621 100644 --- a/modules/reactive.scm +++ b/modules/reactive.scm @@ -56,7 +56,7 @@ (iter-proc (lambda (wref) (let ((item (weak-ref-deref wref))) - (if item + (if (not (weak-ref-null? item)) (proc item) (set! num-tombstones (1+ num-tombstones))))) (weak-list-items list))) @@ -64,7 +64,7 @@ (when (> num-tombstones (/ (weak-list-count list) 2)) (set-weak-list-items! list - (filter weak-ref-deref (weak-list-items list)))) + (filter (lambda (item) (not (weak-ref-null? weak-ref-deref))) (weak-list-items list)))) result) (define (weak-list-for-each proc list) @@ -82,7 +82,10 @@ (define (weak-list-memq x list) (memp - (lambda (wref) (eq? x (weak-ref-deref wref))) + (lambda (wref) + (let ((elem (weak-ref-deref wref))) + (and (not (weak-ref-null? elem)) + (eq? x elem)))) (weak-list-items list))) (define current-subscriber (make-parameter #f)) diff --git a/scene.js b/scene.js index eb223dc..7ddb838 100644 --- a/scene.js +++ b/scene.js @@ -5,6 +5,15 @@ window.addEventListener("load", async () => { document: { getElementById(id) { return document.getElementById(id); + }, + body() { + return document.body; + }, + createTextNode(text) { + return document.createTextNode(text); + }, + createElement(tag) { + return document.createElement(tag); } }, element: { @@ -16,6 +25,19 @@ window.addEventListener("load", async () => { }, addEventListener(elem, event, listener) { elem.addEventListener(event, listener); + }, + appendChild(elem, child) { + return elem.appendChild(child); + }, + parentElement(elem) { + return elem.parentElement; + }, + replaceChild(elem, child, newChild) { + // intentionally flipped as it's more intuitive than js + elem.replaceChild(newChild, child); + }, + setAttribute(elem, name, value) { + elem.setAttribute(name, value); } } } diff --git a/scene.scm b/scene.scm index d58541c..f6b3a81 100644 --- a/scene.scm +++ b/scene.scm @@ -1,10 +1,24 @@ (use-modules (reactive) + (ice-9 match) + (srfi srfi-9) (hoot ffi)) (define-foreign get-element-by-id "document" "getElementById" (ref string) -> (ref null extern)) +(define-foreign document-body + "document" "body" + -> (ref null extern)) + +(define-foreign make-text-node + "document" "createTextNode" + (ref string) -> (ref null extern)) + +(define-foreign make-element + "document" "createElement" + (ref string) -> (ref null extern)) + (define-foreign element-inner-text "element" "innerText" (ref null extern) -> (ref string)) @@ -16,26 +30,98 @@ "element" "addEventListener" (ref null extern) (ref string) (ref null extern) -> none) +(define-foreign append-child! + "element" "appendChild" + (ref null extern) (ref null extern) -> (ref null extern)) -(define cell-a (make-cell 42)) -(format #t "~s\n" (! cell-a)) -(define deriv-a (~ (format #f "value is: ~s" (! cell-a)))) +(define-foreign element-parent + "element" "parentElement" + (ref null extern) -> (ref null extern)) -(format #t "~a\n" (! deriv-a)) +(define-foreign replace-child! + "element" "replaceChild" + (ref null extern) (ref null extern) (ref null extern) -> (ref null extern)) -(! cell-a 56) +(define-foreign set-attribute! + "element" "setAttribute" + (ref null extern) (ref string) (ref string) -> none) -(format #t "~a\n" (! deriv-a)) +(define-record-type + (make-element-ref elem deriv children) + element-ref? + (elem element-ref-element element-ref-set-element!) + (deriv element-ref-deriv element-ref-set-deriv!) + (children element-ref-children element-ref-set-children!)) -(define counter-cell (make-cell 0)) +(define (sxml->dom-ref exp) + (match exp + ((or (? cell?) (? deriv?)) + (let* ((ref (make-element-ref #f #f '())) + (deriv (~ (let ((old-elem (element-ref-element ref)) + (inner-ref (sxml->dom (! exp))) + (elem (make-element "deriv"))) + (append-child! elem (element-ref-element inner-ref)) + (when old-elem + (replace-child! (element-parent old-elem) old-elem elem)) + (element-ref-set-element! ref elem) + (element-ref-set-children! ref (list inner-ref)))))) + (element-ref-set-deriv! ref deriv) + ref)) + ((? number? num) + (make-element-ref (make-text-node (number->string num)) #f '())) + ;; The simple case: a string representing a text node. + ((? string? str) + (make-element-ref (make-text-node str) #f '())) + ;; 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))) + (ref (make-element-ref elem #f '()))) + (define (add-children children) + ;; Recursively call sxml->dom for each child node and + ;; append it to elem. + (element-ref-set-children! + ref + (map (lambda (child) + (let ((child-ref (sxml->dom child))) + (append-child! elem (element-ref-element child-ref)) + child-ref)) + 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)) + (((? symbol? name) (? procedure? proc)) + (add-event-listener! elem + (symbol->string name) + (procedure->external proc))))) + attrs) + (add-children children)) + ;; No attributes, just a list of child nodes. + (children (add-children children))) + ref)))) -(define button-elem (get-element-by-id "button")) -(add-event-listener! - button-elem - "click" - (procedure->external - (lambda (e) (! counter-cell (1+ (! counter-cell)))))) +(define counter (make-cell 0)) +(define square (~ (* (! counter) (! counter)))) -(define counter-elem (get-element-by-id "counter")) -(define counter-deriv (~ (set-element-inner-text! counter-elem (number->string (! counter-cell))) #f)) +(define root-ref + (sxml->dom-ref `(div (@ (class "foo")) + (p "this is a test") + (button (@ (id "button") + (type "button") + (click ,(lambda (e) + (! counter (1+ (! counter))) + ;; Hacky hack to ensure root-ref isn't GC'd too early... + (display root-ref)))) + "Counter: " + ,counter) + (p "The square is: " ,square)))) +(append-child! (document-body) (element-ref-element root-ref))