From e02d3d74b1aae368084c3c81145568274054a48c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Tue, 6 Oct 2020 18:55:15 -0400
Subject: node-2d: Stop using framebuffers with canvases.

---
 examples/shmup/shmup.scm |   8 +--
 starling/minibuffer.scm  |   4 +-
 starling/node-2d.scm     | 128 ++++++++++++++---------------------------------
 3 files changed, 41 insertions(+), 99 deletions(-)

diff --git a/examples/shmup/shmup.scm b/examples/shmup/shmup.scm
index 95f6292..b775234 100644
--- a/examples/shmup/shmup.scm
+++ b/examples/shmup/shmup.scm
@@ -653,12 +653,8 @@
   (reset-game shmup))
 
 (define-method (on-boot (shmup <shmup>))
-  (set! (views shmup)
-    (list (make <view-2d>
-            #:camera (make <camera-2d>
-                       #:width game-width
-                       #:height game-height)
-            #:area (make-rect 0 0 window-width window-height))))
+  (set! (cameras shmup)
+    (list (make <camera-2d> #:resolution (vec2 game-width game-height))))
   (attach-to shmup
              (make <parallax>
                #:name 'background
diff --git a/starling/minibuffer.scm b/starling/minibuffer.scm
index dd8edbe..54aa50d 100644
--- a/starling/minibuffer.scm
+++ b/starling/minibuffer.scm
@@ -96,14 +96,14 @@
       (_ #f))))
 
 (define-method (on-boot (minibuffer <minibuffer>))
-  (let* ((view-area (area (car (views minibuffer))))
+  (let* ((res (resolution (car (cameras minibuffer))))
          (font (default-font))
          (line-height (font-line-height font))
          (padding 8.0))
     (attach-to minibuffer
                (make <filled-rect>
                  #:region (make-rect 0.0 0.0
-                                     (rect-width view-area)
+                                     (vec2-x res)
                                      (+ line-height (* padding 2.0)))
                  #:color (make-color 0.0 0.0 0.0 1.0))
                (make <label>
diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 947e377..142da31 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -47,15 +47,11 @@
             target
             offset
             position
-            width
-            height
-
-            <view-2d>
-            camera
-            area
+            resolution
+            viewport
 
             <canvas>
-            views
+            cameras
 
             <scene-2d>
 
@@ -126,29 +122,36 @@
 ;; Cameras define a view into the scene.  They are attached to a 2D
 ;; node and follow it around.
 
+(define (default-resolution)
+  (match (current-window-size)
+    ((width height)
+     (vec2 width height))))
+
+(define (default-viewport)
+  (match (current-window-size)
+    ((width height)
+     (make-viewport 0 0 width height))))
+
 (define-class <camera-2d> ()
   (target #:accessor target #:init-form #f #:init-keyword #:target)
-  (offset #:getter offset #:init-form #v(0.0 0.0) #:init-keyword #:offset)
-  (position #:getter position #:init-form #v(0.0 0.0))
-  (last-position #:getter last-position #:init-form #v(0.0 0.0))
-  (width #:getter width #:init-keyword #:width)
-  (height #:getter height #:init-keyword #:height)
+  (offset #:getter offset #:init-form (vec2 0.0 0.0) #:init-keyword #:offset)
+  (position #:getter position #:init-form (vec2 0.0 0.0))
+  (last-position #:getter last-position #:init-form (vec2 0.0 0.0))
+  (resolution #:getter resolution #:init-keyword #:resolution
+              #:init-thunk default-resolution)
+  (viewport #:getter viewport #:init-keyword #:viewport
+            #:init-thunk default-viewport)
   (projection-matrix #:accessor projection-matrix)
   ;; Combined projection/view matrix
-  (view-matrix #:getter view-matrix #:init-form (make-identity-matrix4))
-  (framebuffer #:accessor framebuffer))
+  (view-matrix #:getter view-matrix #:init-form (make-identity-matrix4)))
 
 (define-method (initialize (camera <camera-2d>) initargs)
   (next-method)
-  ;; Initialize framebuffer and orthographic projection matrix based
-  ;; on the resolution of the camera.
-  (set! (framebuffer camera)
-        (make-framebuffer (width camera)
-                          (height camera)
-                          #:min-filter 'nearest
-                          #:mag-filter 'nearest))
-  (set! (projection-matrix camera)
-        (orthographic-projection 0 (width camera) (height camera) 0 0 1)))
+  ;; Initialize orthographic projection matrix based on the resolution
+  ;; of the camera.
+  (let ((r (resolution camera)))
+    (set! (projection-matrix camera)
+      (orthographic-projection 0 (vec2-x r) (vec2-y r) 0 0 1))))
 
 ;; This method can be overridden by subclasses to create custom camera
 ;; movement.
@@ -172,95 +175,38 @@
         (matrix4-mult! m m (projection-matrix camera))))))
 
 (define-syntax-rule (with-camera camera body ...)
-  (with-framebuffer (framebuffer camera)
-    (clear-screen)
+  (with-viewport (viewport camera)
     (with-projection (if (target camera)
                          (view-matrix camera)
                          (projection-matrix camera))
       body ...)))
 
-
-
-;;;
-;;; 2D View
-;;;
-
-;; Views render the output of a camera to a portion of the game
-;; window.
-
-(define-class <view-2d> ()
-  (camera #:accessor camera #:init-keyword #:camera)
-  (area #:getter area #:init-keyword #:area)
-  (clear-color #:getter clear-color #:init-keyword #:clear-color
-               #:init-value tango-light-sky-blue)
-  (viewport #:accessor viewport)
-  (projection-matrix #:accessor projection-matrix)
-  (sprite-rect #:accessor sprite-rect))
-
-(define-method (initialize (view <view-2d>) initargs)
-  (next-method)
-  (let* ((area (area view))
-         (x (rect-x area))
-         (y (rect-y area))
-         (w (rect-width area))
-         (h (rect-height area)))
-    (set! (viewport view)
-      (make-viewport (inexact->exact x)
-                     (inexact->exact y)
-                     (inexact->exact w)
-                     (inexact->exact h)
-                     #:clear-color (clear-color view)))
-    (set! (sprite-rect view) (make-rect 0.0 0.0 w h))
-    (set! (projection-matrix view) (orthographic-projection 0 w h 0 0 1))))
-
-(define %identity-matrix (make-identity-matrix4))
-
-(define-method (render (view <view-2d>))
-  (with-viewport (viewport view)
-    (with-projection (projection-matrix view)
-      (draw-sprite* (framebuffer-texture (framebuffer (camera view)))
-                    (sprite-rect view)
-                    %identity-matrix))))
-
 
 ;;;
 ;;; 2D Canvas
 ;;;
 
 ;; The canvas is the root of a 2D scene.  It handles rendering one or
-;; more views.
-
-(define (make-default-views)
-  (match (current-window-size)
-    ((width height)
-     (list
-      (make <view-2d>
-        #:camera (make <camera-2d>
-                   #:width width
-                   #:height height)
-        #:area (make-rect 0 0 width height))))))
+;; more cameras.
 
 (define-class <canvas> (<node>)
-  (views #:accessor views #:init-thunk make-default-views
-         #:init-keyword #:views))
+  (cameras #:accessor cameras #:init-form (list (make <camera-2d>))
+           #:init-keyword #:cameras))
 
 (define-method (update (canvas <canvas>) dt)
-  (for-each (lambda (view)
-              (update (camera view) dt))
-            (views canvas)))
+  (for-each (lambda (camera)
+              (update camera dt))
+            (cameras canvas)))
 
 (define-method (render-tree (canvas <canvas>) alpha)
+  (render canvas alpha)
   ;; Draw scene from the viewpoint of each camera.
-  (for-each (lambda (view)
-              (with-camera (camera view)
+  (for-each (lambda (camera)
+              (with-camera camera
                            (for-each-child (lambda (child)
                                              (render-tree child alpha))
                                            canvas)))
-            (views canvas))
-  (render canvas alpha))
-
-(define-method (render (canvas <canvas>) alpha)
-  (for-each render (views canvas)))
+            (cameras canvas)))
 
 
 ;;;
-- 
cgit v1.2.3