summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-04-30 10:47:29 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-04-30 10:47:29 -0400
commit424681f151f798b896cdef67ec57efefe3baec3d (patch)
tree459a9a06eaaec47ccc7b3ed5656599c8edc5e18a
parent72e20ab43862f2a7a91cbb7b374bbe152d77e7d6 (diff)
Be more responsive to nested container resizing.
-rw-r--r--catbird/ui.scm16
1 files changed, 12 insertions, 4 deletions
diff --git a/catbird/ui.scm b/catbird/ui.scm
index 7809226..326924c 100644
--- a/catbird/ui.scm
+++ b/catbird/ui.scm
@@ -139,12 +139,17 @@
(define-class <container> (<node-2d>)
(needs-layout? #:accessor needs-layout? #:init-value #t))
+(define-method (needs-layout? (node <node>)) #f)
+
(define-method (initialize (container <container>) initargs)
(next-method)
(layout container))
(define-method (layout (container <container>))
- #t)
+ (for-each-child (lambda (child)
+ (when (needs-layout? child)
+ (layout child)))
+ container))
(define-method (on-attach (container <container>) child)
(set! (needs-layout? container) #t))
@@ -152,6 +157,9 @@
(define-method (on-detach (container <container>) child)
(set! (needs-layout? container) #t))
+(define-method (on-child-resize (container <container>) child)
+ (set! (needs-layout? container) #t))
+
(define-method (update (container <container>) dt)
(when (needs-layout? container)
(layout container)
@@ -203,10 +211,8 @@
(slot-set! container 'margin-top m)
(set! (needs-layout? container) #t))
-(define-method (on-child-resize (container <container>) child)
- (set! (needs-layout? container) #t))
-
(define-method (layout (container <margin-container>))
+ (next-method)
(for-each-child (lambda (child)
(place-at child
(margin-left container)
@@ -224,6 +230,7 @@
(padding #:accessor padding #:init-keyword #:padding #:init-value 0.0))
(define-method (layout (container <horizontal-container>))
+ (next-method)
(let ((p (padding container)))
(let loop ((kids (children container))
(prev #f))
@@ -241,6 +248,7 @@
(padding #:accessor padding #:init-keyword #:padding #:init-value 0.0))
(define-method (layout (container <vertical-container>))
+ (next-method)
(let ((p (padding container)))
(let loop ((kids (children container))
(prev #f))