vv/guile-scene
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Basic dom support and fix bugs

Browse source
This commit is contained in:
Vivianne 2024-10-11 21:34:43 -04:00
parent 0bbbed4bfe
commit 626c486bc5
4 changed files with 129 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
index.html
View file

@ -12,7 +12,5 @@
this game. We recommend using either Mozilla Firefox or Google
Chrome. Safari is currently unsupported.
</p>
<button id="button" type="button">Counter: <span id="counter"></span></button>
</body>
</html>

9
modules/reactive.scm
View file

@ -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))

22
scene.js
View file

@ -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);
}
}
}

116
scene.scm
View file

@ -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 <element-ref>
(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))