From 67091c5df190b82db566615008c6ee33d9f7027b Mon Sep 17 00:00:00 2001 From: SouthFox Date: Sun, 27 Oct 2024 20:34:16 +0800 Subject: [PATCH] feat: add task and click app --- game.js | 6 +- game.scm | 128 +++++++++++++++++++++++++++++++++++++++- modules/dom/element.scm | 20 ++++++- modules/dom/event.scm | 4 ++ 4 files changed, 153 insertions(+), 5 deletions(-) diff --git a/game.js b/game.js index 31411ba..1ed01c8 100644 --- a/game.js +++ b/game.js @@ -28,11 +28,15 @@ window.addEventListener("load", async () => { removeAttribute: (elem, name) => elem.removeAttribute(name), remove: (elem) => elem.remove(), replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem), - clone: (elem) => elem.cloneNode() + clone: (elem) => elem.cloneNode(), + checked(elem) { return elem.checked; }, + setChecked(elem, checked) { elem.checked = (checked == 1); }, + }, event: { addEventListener: (target, type, listener) => target.addEventListener(type, listener), removeEventListener: (target, type, listener) => target.removeEventListener(type, listener), + target(event) { return event.target; }, preventDefault: (event) => event.preventDefault(), keyboardCode: (event) => event.code }, diff --git a/game.scm b/game.scm index 5513c8c..1bf9946 100644 --- a/game.scm +++ b/game.scm @@ -18,11 +18,135 @@ ;;; ;;; Code: -(use-modules (dom document) +(use-modules (scheme base) + (dom document) (dom element) + (dom event) (math vector) (hoot ffi) (hoot hashtables) (ice-9 match)) -(append-child! (document-body) (make-text-node "Hello, world!")) +(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)) + (((? symbol? name) (? boolean? 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))) + elem)))) + +(define *clicks* 0) +(define *template* '()) + +;; Click +(define (template-click) + `(div + (p ,(number->string *clicks*) " clicks") + (button (@ (click ,(lambda (event) + (set! *clicks* (+ *clicks* 1)) + (render)))) + "Click me!"))) + +;; Task +(define (render) + (let ((old (get-element-by-id "container"))) + (unless (external-null? old) (remove! old)) + (append-child! (document-body) (sxml->dom (wrap-template *template*))))) + +(define-record-type + (make-task name done?) + task? + (name task-name) + (done? task-done? set-task-done!)) + +(define *tasks* '()) + +(define (add-task! task) + (set! *tasks* (cons task *tasks*))) + +(define (remove-task! task) + (set! *tasks* (delq task *tasks*))) + +(define (template-task) + (define (task-template task) + `(li (input (@ (type "checkbox") + (change ,(lambda (event) + (let* ((checkbox (event-target event)) + (checked? (element-checked? checkbox))) + (set-task-done! task checked?) + (render)))) + (checked ,(task-done? task)))) + (span (@ (style "padding: 0 1em 0 1em;")) + ;; Strikethrough if task is done. + ,(if (task-done? task) + `(s ,(task-name task)) + (task-name task))) + (a (@ (href "#") + ;; Remove task on click. + (click ,(lambda (event) + (remove-task! task) + (render)))) + "remove"))) + `(div + (h2 "Tasks") + ;; Tasks are stored in reverse order. + (ul ,@(map task-template (reverse *tasks*))) + (input (@ (id "new-task") + (placeholder "Write more task"))) + ;; Add new task on click + (button (@ (click ,(lambda (event) + (let* ((input (get-element-by-id "new-task")) + (name (element-value input))) + (unless (string=? name "") + (add-task! (make-task name #f)) + (set-element-value! input "") + (render)))))) + "Add task"))) + +;; Main +(define (wrap-template template) + `(div (@ (id "container")) + (button (@ (click ,(lambda (event) + (set! *template* template-click) + (render)))) + "Click") + (button (@ (click ,(lambda (event) + (set! *template* template-task) + (render)))) + "Task") + (div (@ (id "application")) ,(template)))) + +(set! *template* template-task) +(render) diff --git a/modules/dom/element.scm b/modules/dom/element.scm index 394b1a5..cc83130 100644 --- a/modules/dom/element.scm +++ b/modules/dom/element.scm @@ -29,7 +29,9 @@ replace-with! set-attribute! remove-attribute! - clone-element)) + clone-element + element-checked? + set-element-checked!)) (define-foreign element-value "element" "value" @@ -58,7 +60,7 @@ (define-foreign replace-with! "element" "replaceWith" (ref extern) (ref extern) -> none) -(define-foreign set-attribute! +(define-foreign %set-attribute! "element" "setAttribute" (ref extern) (ref string) (ref string) -> none) (define-foreign remove-attribute! @@ -67,3 +69,17 @@ (define-foreign clone-element "element" "clone" (ref extern) -> (ref extern)) + +(define-foreign %element-checked? + "element" "checked" + (ref null extern) -> i32) +(define (element-checked? elem) + (= (%element-checked? elem) 1)) + +(define-foreign set-element-checked! + "element" "setChecked" + (ref null extern) i32 -> none) +(define (set-attribute! elem name val) + (if (string=? name "checked") + (set-element-checked! elem (if val 1 0)) + (%set-attribute! elem name val))) diff --git a/modules/dom/event.scm b/modules/dom/event.scm index 8f68c83..5d4607a 100644 --- a/modules/dom/event.scm +++ b/modules/dom/event.scm @@ -22,6 +22,7 @@ #:use-module (hoot ffi) #:export (add-event-listener! remove-event-listener! + event-target prevent-default! keyboard-event-code)) @@ -32,6 +33,9 @@ (define-foreign remove-event-listener! "event" "removeEventListener" (ref extern) (ref string) (ref extern) -> none) +(define-foreign event-target + "event" "target" + (ref null extern) -> (ref null extern)) ;; Event (define-foreign prevent-default!