diff options
| -rw-r--r-- | catbird/line-editor.scm | 17 | ||||
| -rw-r--r-- | catbird/minibuffer.scm | 3 | ||||
| -rw-r--r-- | catbird/node-2d.scm | 3 | ||||
| -rw-r--r-- | catbird/node.scm | 13 | ||||
| -rw-r--r-- | catbird/overlay.scm | 3 | ||||
| -rw-r--r-- | catbird/ui.scm | 3 |
6 files changed, 18 insertions, 24 deletions
diff --git a/catbird/line-editor.scm b/catbird/line-editor.scm index b991f47..4fe8cc7 100644 --- a/catbird/line-editor.scm +++ b/catbird/line-editor.scm @@ -76,14 +76,8 @@ #:init-value black) (accepting-input? #:accessor accepting-input? #:init-value #t)) -(define-method (on-change (editor <line-editor>) slot old new) - (case slot - ((prompt) - (update-visual editor)) - (else - (next-method)))) - -(define-method (on-boot (editor <line-editor>)) +(define-method (initialize (editor <line-editor>) initargs) + (next-method) (attach-to editor (make <label> #:name 'prompt @@ -116,6 +110,13 @@ (discard-next-char editor) (update-visual editor)) +(define-method (on-change (editor <line-editor>) slot old new) + (case slot + ((prompt) + (update-visual editor)) + (else + (next-method)))) + ;; Whenever a command key sequence is pressed while the line editor is ;; active we have to stop accepting text input for one tick. ;; Otherwise, an errant character shows up. For example, if the user diff --git a/catbird/minibuffer.scm b/catbird/minibuffer.scm index d4c1a5f..85f4e74 100644 --- a/catbird/minibuffer.scm +++ b/catbird/minibuffer.scm @@ -58,7 +58,8 @@ (define-syntax-rule (define-minibuffer-command name body ...) (add-minibuffer-command (symbol->string 'name) (lambda () body ...))) -(define-method (on-boot (minibuffer <minibuffer>)) +(define-method (initialize (minibuffer <minibuffer>) initargs) + (next-method) (attach-to minibuffer (make <canvas> #:name 'background) diff --git a/catbird/node-2d.scm b/catbird/node-2d.scm index 2ba7b7c..44a31f9 100644 --- a/catbird/node-2d.scm +++ b/catbird/node-2d.scm @@ -849,7 +849,8 @@ PADDING on all sides." (let ((t (texture-atlas-ref (atlas sprite) (index sprite)))) (set! (texture sprite) t))) -(define-method (on-boot (sprite <atlas-sprite>)) +(define-method (initialize (sprite <atlas-sprite>) initargs) + (next-method) (sync-texture sprite)) (define-method (on-change (sprite <atlas-sprite>) slot-name old new) diff --git a/catbird/node.scm b/catbird/node.scm index 2553ba3..bc158a5 100644 --- a/catbird/node.scm +++ b/catbird/node.scm @@ -33,9 +33,7 @@ tree-in-view? children for-each-child - on-boot pick - reboot child-ref & attach-to replace @@ -77,26 +75,17 @@ (define-method (initialize (node <node>) initargs) (next-method) - (apply attach-to node (get-keyword #:children initargs '())) - (on-boot node)) + (apply attach-to node (get-keyword #:children initargs '()))) (define-method (sort-children (node <node>)) (set! (children node) (sort-by-rank/ascending (children node)))) -(define-method (on-boot (node <node>)) - #t) - (define-method (on-change (node <node>) slot-name old new) (case slot-name ((rank) ;; Re-sort parent when rank of child node changes. (and=> (parent node) sort-children)))) -(define-method (reboot (node <node>)) - (for-each-child detach node) - (with-agenda (agenda node) (reset-agenda)) - (on-boot node)) - (define-method (write (node <node>) port) (define (strip-angle-brackets str) (let ((start (if (string-prefix? "<" str) 1 0)) diff --git a/catbird/overlay.scm b/catbird/overlay.scm index 1d39c9e..2833e87 100644 --- a/catbird/overlay.scm +++ b/catbird/overlay.scm @@ -111,7 +111,8 @@ (define-class <fps-display> (<node-2d>)) -(define-method (on-boot (fps-display <fps-display>)) +(define-method (initialize (fps-display <fps-display>) initargs) + (next-method) (let* ((font (default-font)) (padding 4.0) (box-width (+ (font-line-width font "999.9") diff --git a/catbird/ui.scm b/catbird/ui.scm index 326924c..dcac4e7 100644 --- a/catbird/ui.scm +++ b/catbird/ui.scm @@ -347,7 +347,8 @@ (fit-to-children button (padding button)) (show (background-up button))) -(define-method (on-boot (button <button>)) +(define-method (initialize (button <button>) initargs) + (next-method) (let ((bg-up (background-up button)) (bg-down (background-down button)) (bg-over (background-over button))) |