From 0418c29a160f4c908d76bd19ebeb40571f3d60d4 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 29 Nov 2014 12:30:02 -0500
Subject: render: Add transform stack to render context.

* sly/render/context.scm (<render-context) [transform-stack]: New field.
  (render-context-transform-stack): New accessor.
  (make-null-transform, make-transform-stack): New procedures.
  (make-render-context): Add 'transform-stack-size' parameter.
  (with-temp-transform): New syntax.
---
 sly/render/context.scm | 34 +++++++++++++++++++++++++++++-----
 1 file changed, 29 insertions(+), 5 deletions(-)

diff --git a/sly/render/context.scm b/sly/render/context.scm
index 291e080..d3bd0c3 100644
--- a/sly/render/context.scm
+++ b/sly/render/context.scm
@@ -22,18 +22,21 @@
 ;;; Code:
 
 (define-module (sly render context)
+  #:use-module (ice-9 q)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-42)
   #:use-module (gl)
   #:use-module (gl enums)
   #:use-module (gl low-level)
   #:use-module (sly wrappers gl)
+  #:use-module (sly math transform)
   #:use-module (sly render shader)
   #:use-module (sly render texture)
   #:use-module (sly render utils)
   #:use-module (sly render vertex-array)
   #:export (make-render-context
             render-context?
-            with-render-context
+            with-render-context with-temp-transform
             render-context-blend-mode set-render-context-blend-mode!
             render-context-depth-test? set-render-context-depth-test?!
             render-context-texture set-render-context-texture!
@@ -41,16 +44,30 @@
             render-context-vertex-array set-render-context-vertex-array!))
 
 (define-record-type <render-context>
-  (%make-render-context blend-mode depth-test? texture shader vertex-array)
+  (%make-render-context blend-mode depth-test? texture shader
+                        vertex-array transform-stack)
   render-context?
   (blend-mode render-context-blend-mode %set-render-context-blend-mode!)
   (depth-test? render-context-depth-test? %set-render-context-depth-test?!)
   (texture render-context-texture %set-render-context-texture!)
   (shader render-context-shader %set-render-context-shader!)
-  (vertex-array render-context-vertex-array %set-render-context-vertex-array!))
+  (vertex-array render-context-vertex-array %set-render-context-vertex-array!)
+  (transform-stack render-context-transform-stack))
 
-(define (make-render-context)
-  (%make-render-context #f #f #f #f #f))
+(define (make-null-transform)
+  (make-transform 0 0 0 0
+                  0 0 0 0
+                  0 0 0 0
+                  0 0 0 0))
+
+(define (make-transform-stack size)
+  (let ((stack (make-q)))
+    (do-ec (: i 128) (q-push! stack (make-null-transform)))
+    stack))
+
+(define* (make-render-context #:optional (transform-stack-size 32))
+  (%make-render-context #f #f #f #f #f
+                        (make-transform-stack transform-stack-size)))
 
 (define (render-context-reset! context)
   (gl-disable (enable-cap blend))
@@ -105,3 +122,10 @@
   (unless (equal? (render-context-vertex-array context) vertex-array)
     (apply-vertex-array vertex-array)
     (%set-render-context-vertex-array! context vertex-array)))
+
+;; emacs: (put 'with-temp-transform 'scheme-indent-function 2)
+(define-syntax-rule (with-temp-transform context name body ...)
+  (let* ((stack (render-context-transform-stack context))
+         (name (q-pop! stack)))
+    (begin body ...)
+    (q-push! stack name)))
-- 
cgit v1.2.3