From dd243dd72e2b1dd6d190816d97e814a0a0187a43 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Tue, 11 Jun 2019 08:04:33 -0400
Subject: node-2d: Respect desired viewport in <view-2d>.

---
 starling/node-2d.scm | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index e63d64d..663942c 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -179,15 +179,34 @@
 
 (define-class <view-2d> ()
   (camera #:accessor camera #:init-keyword #:camera)
-  (area #:getter area #:init-keyword #:area))
+  (area #:getter area #:init-keyword #:area)
+  (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)))
+    (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-projection (projection-matrix (camera view))
-    (draw-sprite* (framebuffer-texture (framebuffer (camera view)))
-                  (area view)
-                  %identity-matrix)))
+  (with-viewport (viewport view)
+    (with-projection (projection-matrix view)
+      (draw-sprite* (framebuffer-texture (framebuffer (camera view)))
+                    (sprite-rect view)
+                    %identity-matrix))))
 
 
 ;;;
-- 
cgit v1.2.3