Allow regions to be "frozen" so they don't render/update.

1 files changed, 42 insertions, 7 deletions

diff --git a/catbird/region.scm b/catbird/region.scm
index af6f206..c7620ad 100644
--- a/catbird/region.scm
+++ b/catbird/region.scm
@@ -29,7 +29,10 @@
   #:use-module (chickadee)
   #:use-module (chickadee data array-list)
   #:use-module (chickadee graphics engine)
+  #:use-module (chickadee graphics framebuffer)
   #:use-module (chickadee graphics viewport)
+  #:use-module (chickadee graphics sprite)
+  #:use-module (chickadee math matrix)
   #:use-module (chickadee math rect)
   #:use-module (ice-9 exceptions)
   #:use-module (oop goops)
@@ -41,10 +44,13 @@
             area-width
             area-height
             camera
+            freeze
+            frozen?
             scene
             replace-scene
             push-scene
-            pop-scene)
+            pop-scene
+            unfreeze)
   #:re-export (name
                rank
                render
@@ -54,7 +60,12 @@
   (area #:accessor area #:init-keyword #:area)
   (camera #:accessor camera #:init-keyword #:camera #:init-value #f)
   (scene-state #:accessor scene-state #:init-thunk make-pushdown-state)
-  (viewport #:accessor viewport))
+  (viewport #:accessor viewport)
+  (framebuffer #:accessor framebuffer)
+  (framebuffer-rect #:accessor framebuffer-rect)
+  ;; Regions can be frozen for debugging purposes, so that the scene
+  ;; they contain isn't updated or rendered.
+  (frozen? #:accessor frozen? #:init-value #f))
 
 (define-method (area-x (region <region>))
   (rect-x (area region)))
@@ -84,7 +95,14 @@
           (make-viewport (float->int (rect-x r))
                          (float->int (rect-y r))
                          (float->int (rect-width r))
-                         (float->int (rect-height r))))))
+                         (float->int (rect-height r))))
+    (set! (framebuffer region)
+          (make-framebuffer (float->int (rect-width r))
+                            (float->int (rect-height r))))
+    (set! (framebuffer-rect region)
+          (make-rect 0.0 0.0
+                     (float->int (rect-width r))
+                     (float->int (rect-height r))))))
 
 (define (make-region area name rank)
   (let* ((window (current-window))
@@ -98,6 +116,12 @@
        (make-exception-with-message "region area exceeds window area")))
     (make <region> #:area area #:name name #:rank rank)))
 
+(define-method (freeze (region <region>))
+  (set! (frozen? region) #t))
+
+(define-method (unfreeze (region <region>))
+  (set! (frozen? region) #f))
+
 (define-method (scene (region <region>))
   (state-current (scene-state region)))
 
@@ -127,12 +151,23 @@
 
 (define-method (update (region <region>) dt)
   (let ((s (scene region)))
-    (when s (update/around s dt))))
+    (when (and s (not (frozen? region)))
+      (update/around s dt))))
 
+(define %identity-matrix (make-identity-matrix4))
 (define-method (render (region <region>) alpha)
   (let ((s (scene region))
-        (c (camera region)))
+        (c (camera region))
+        (fb (framebuffer region)))
     (when (and s c)
       (parameterize ((current-camera c))
-        (with-projection (projection-matrix (camera region))
-          (render/around s alpha))))))
+        ;; Don't render to the framebuffer if region is frozen.  Just
+        ;; draw the frozen frame instead.
+        (unless (frozen? region)
+          (with-framebuffer fb
+            (with-projection (projection-matrix (camera region))
+              (render/around s alpha))))
+        (with-graphics-state ((g:viewport (viewport region)))
+          (draw-sprite* (framebuffer-texture fb)
+                        (framebuffer-rect region)
+                        %identity-matrix))))))