From 09ceb7351e4f150a88c0b371696b01c77da3f0a2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 18 Oct 2009 13:44:24 -0500
Subject: [PATCH] gpu.shaders: carry over instances from old shader/program
 objects when GLSL-SHADER: or GLSL-PROGRAM: forms get reparsed

---
 extra/gpu/shaders/shaders.factor | 50 +++++++++++++++++++++-----------
 1 file changed, 33 insertions(+), 17 deletions(-)

diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor
index 0af5e9ac57..aece1b40d6 100755
--- a/extra/gpu/shaders/shaders.factor
+++ b/extra/gpu/shaders/shaders.factor
@@ -432,33 +432,49 @@ PRIVATE>
 : <program-instance> ( program -- instance )
     [ find-program-instance dup world get ] keep instances>> set-at ;
 
+<PRIVATE
+
+: old-instances ( name -- instances )
+    dup constant? [
+        execute( -- s/p ) dup { [ shader? ] [ program? ] } 1||
+        [ instances>> ] [ drop H{ } clone ] if
+    ] [ drop H{ } clone ] if ;
+
+PRIVATE>
+
 SYNTAX: GLSL-SHADER:
-    CREATE-WORD dup
-    scan-word
-    f
-    lexer get line>>
-    parse-here
-    H{ } clone
+    CREATE dup
+    dup old-instances [
+        scan-word
+        f
+        lexer get line>>
+        parse-here
+    ] dip
     shader boa
+    over reset-generic
     define-constant ;
 
 SYNTAX: GLSL-SHADER-FILE:
-    CREATE-WORD dup
-    scan-word execute( -- kind )
-    scan-object in-word's-path
-    0
-    over ascii file-contents 
-    H{ } clone
+    CREATE dup
+    dup old-instances [
+        scan-word execute( -- kind )
+        scan-object in-word's-path
+        0
+        over ascii file-contents 
+    ] dip
     shader boa
+    over reset-generic
     define-constant ;
 
 SYNTAX: GLSL-PROGRAM:
-    CREATE-WORD dup
-    f
-    lexer get line>>
-    \ ; parse-until >array shaders-and-feedback-format
-    H{ } clone
+    CREATE dup
+    dup old-instances [
+        f
+        lexer get line>>
+        \ ; parse-until >array shaders-and-feedback-format
+    ] dip
     program boa
+    over reset-generic
     define-constant ;
 
 M: shader-instance dispose