Reduce garbage generated by graphics state management.

1 files changed, 36 insertions, 60 deletions

diff --git a/chickadee/graphics/engine.scm b/chickadee/graphics/engine.scm
index 7fe6def..ed0650e 100644
--- a/chickadee/graphics/engine.scm
+++ b/chickadee/graphics/engine.scm
@@ -42,14 +42,15 @@
 ;; GPU when the value really needs updating.
 
 (define-record-type <graphics-state-spec>
-  (%make-graphics-state-spec name default binder)
+  (%make-graphics-state-spec id name default binder)
   graphics-state-spec?
+  (id graphics-state-spec-id)
   (name graphics-state-spec-name)
   (default graphics-state-spec-default)
   (binder graphics-state-spec-binder))
 
-(define* (make-graphics-state-spec name #:key default bind)
-  (%make-graphics-state-spec name default bind))
+(define* (make-graphics-state-spec id name #:key default bind)
+  (%make-graphics-state-spec id name default bind))
 
 (define-record-type <graphics-state>
   (%make-graphics-state binder value bound-value dirty? stack)
@@ -83,18 +84,28 @@
       (set-graphics-state-bound-value! state x)
       (set-graphics-state-dirty! state #f))))
 
-(define *graphics-states* (make-hash-table))
+(define *graphics-states* (make-array-list))
+
+;; Box the counter so the compiler doesn't do constant propagation on
+;; it and screw everything up.
+(define *graphics-state-id-counter* (vector 0))
+
+(define (next-graphics-state-id)
+  (let ((id (vector-ref *graphics-state-id-counter* 0)))
+    (vector-set! *graphics-state-id-counter* 0 (+ id 1))
+    id))
 
 (define-syntax-rule (define-graphics-state name getter args ...)
   (begin
     (define name
-      (let ((spec (make-graphics-state-spec 'name args ...)))
-        (hashq-set! *graphics-states* 'name spec)
+      (let* ((id (next-graphics-state-id))
+             (spec (make-graphics-state-spec id 'name args ...)))
+        (array-list-push! *graphics-states* spec)
         (when (current-graphics-engine)
           (install-graphics-state (current-graphics-engine) spec))
         spec))
     (define* (getter #:optional (engine (current-graphics-engine)))
-      (graphics-engine-state-ref 'name engine))))
+      (graphics-engine-state-ref name engine))))
 
 
 ;;;
@@ -161,8 +172,7 @@
 
 (define-record-type <graphics-engine>
   (%make-graphics-engine gl-context gl-version glsl-version max-texture-size
-                         projection-matrix guardian states modified-states
-                         variables)
+                         projection-matrix guardian states variables)
   graphics-engine?
   (gl-context %graphics-engine-gl-context)
   (gl-version %graphics-engine-gl-version)
@@ -172,14 +182,13 @@
                      %set-graphics-engine-projection-matrix!)
   (guardian graphics-engine-guardian)
   (states graphics-engine-states)
-  (modified-states graphics-engine-modified-states)
   (variables graphics-engine-variables))
 
 (define (install-graphics-state engine spec)
   (let ((binder (graphics-state-spec-binder spec))
         (default (graphics-state-spec-default spec)))
-    (hashq-set! (graphics-engine-states engine)
-                (graphics-state-spec-name spec)
+    (hashv-set! (graphics-engine-states engine)
+                (graphics-state-spec-id spec)
                 (make-graphics-state binder default))))
 
 (define (install-graphics-variable engine var)
@@ -204,15 +213,14 @@
                                        (make-identity-matrix4)
                                        (make-guardian)
                                        (make-hash-table)
-                                       (make-hash-table)
                                        (make-hash-table))))
     ;; Variable initialization must be delayed until after engine
     ;; creation because variable initializers may modify graphics
     ;; engine state to create shaders, textures, etc.
     (parameterize ((current-graphics-engine engine))
-      (hash-for-each (lambda (key spec)
-                       (install-graphics-state engine spec))
-                     *graphics-states*)
+      (array-list-for-each (lambda (i spec)
+                             (install-graphics-state engine spec))
+                           *graphics-states*)
       (hash-for-each (lambda (key var)
                        (install-graphics-variable engine var))
                      *graphics-variables*))
@@ -249,43 +257,25 @@
 (define* (set-graphics-engine-projection-matrix! matrix #:optional (engine (current-graphics-engine)))
   (%set-graphics-engine-projection-matrix! engine matrix))
 
-(define* (graphics-engine-state-ref name #:optional
+(define* (graphics-engine-state-ref spec #:optional
                                     (engine (current-graphics-engine)))
-  (let ((state (hashq-ref (graphics-engine-states engine) name)))
-    (if state
-        (graphics-state-ref state)
-        (error
-         (format #f
-                 "No such graphics state '~a'.  Did you include the module that defines it?"
-                 name)))))
-
-(define* (graphics-engine-state-set! name value #:optional
-                                     (engine (current-graphics-engine)))
-  (let ((state (hashq-ref (graphics-engine-states engine) name)))
-    (graphics-state-set! state value)
-    (hashq-set! (graphics-engine-modified-states engine)
-                name
-                #t)))
+  (let ((state (hashv-ref (graphics-engine-states engine)
+                          (graphics-state-spec-id spec))))
+    (and state (graphics-state-ref state))))
 
 (define* (graphics-engine-state-push! spec value #:optional
                                       (engine (current-graphics-engine)))
   (if (graphics-state-spec? spec)
-      (let ((name (graphics-state-spec-name spec)))
-        (graphics-state-push! (hashq-ref (graphics-engine-states engine) name)
-                              value)
-        (hashq-set! (graphics-engine-modified-states engine)
-                    name
-                    #t))
+      (let ((id (graphics-state-spec-id spec)))
+        (graphics-state-push! (hashv-ref (graphics-engine-states engine) id)
+                              value))
       (error "not a graphics state specification" spec)))
 
 (define* (graphics-engine-state-pop! spec #:optional
                                      (engine (current-graphics-engine)))
   (if (graphics-state-spec? spec)
-      (let ((name (graphics-state-spec-name spec)))
-        (graphics-state-pop! (hashq-ref (graphics-engine-states engine) name))
-        (hashq-set! (graphics-engine-modified-states engine)
-                    name
-                    #t))
+      (let ((id (graphics-state-spec-id spec)))
+        (graphics-state-pop! (hashv-ref (graphics-engine-states engine) id)))
       (error "not a graphics state specification" spec)))
 
 (define* (graphics-variable-ref var #:optional
@@ -297,12 +287,9 @@
   (hashq-set! (graphics-engine-variables engine) var value))
 
 (define* (graphics-engine-commit! #:optional (engine (current-graphics-engine)))
-  (let ((states (graphics-engine-states engine))
-        (modified-states (graphics-engine-modified-states engine)))
-    (hash-for-each (lambda (key value)
-                     (graphics-state-bind-maybe (hashq-ref states key)))
-                   modified-states)
-    (hash-clear! modified-states)))
+  (hash-for-each (lambda (id state)
+                   (graphics-state-bind-maybe state))
+                 (graphics-engine-states engine)))
 
 (define* (graphics-engine-guard! obj #:optional
                                  (engine (current-graphics-engine)))
@@ -330,17 +317,6 @@
     (lambda ()
       (graphics-engine-state-pop! spec) ...)))
 
-;; (define-syntax-rule (with-graphics-state ((spec value) ...) body ...)
-;;   (let ((thunk (lambda ()
-;;                  (graphics-engine-state-set! (graphics-state-spec-name spec) value) ...
-;;                  body ...))
-;;         (spec (graphics-engine-state-ref (graphics-state-spec-name spec)))
-;;         ...)
-;;     (let ((result (thunk)))
-;;       ;; Restore old values
-;;       (graphics-engine-state-set! (graphics-state-spec-name spec) spec) ...
-;;       result)))
-
 (define-syntax-rule (with-graphics-state! ((spec value) ...) body ...)
   (with-graphics-state ((spec value) ...)
     (graphics-engine-commit!)