factor: trim using lists

[factor.git] / extra / gpu / shaders / shaders.factor

diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor
old mode 100755 (executable)
new mode 100644 (file)
index 108bfa1..33b62f5
--- a/extra/gpu/shaders/shaders.factor
+++ b/extra/gpu/shaders/shaders.factor
@@ -1,14 +1,15 @@
-! (c)2009 Joe Groff bsd license
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.strings
 arrays assocs byte-arrays classes.mixin classes.parser
-classes.singleton classes.struct combinators combinators.short-circuit
-definitions destructors fry generic.parser gpu gpu.buffers gpu.private
-gpu.state hashtables images io.encodings.ascii io.files io.pathnames
-kernel lexer literals locals math math.parser memoize multiline namespaces
+classes.singleton classes.struct combinators
+combinators.short-circuit definitions destructors generic.parser
+gpu gpu.buffers gpu.private gpu.state hashtables images
+io.encodings.ascii io.files io.pathnames kernel lexer literals
+math math.floats.half math.parser memoize multiline namespaces
 opengl opengl.gl opengl.shaders parser quotations sequences
-specialized-arrays splitting strings tr ui.gadgets.worlds
-variants vectors vocabs vocabs.loader vocabs.parser words
-words.constant math.floats.half typed ;
+specialized-arrays splitting strings tr typed ui.gadgets.worlds
+variants vocabs.loader words words.constant ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: void*
@@ -310,7 +311,7 @@ SYMBOL: padding-no
     { } <struct-slot-spec> ;
 
 : shader-filename ( shader/program -- filename )
-    dup filename>> [ nip ] [ name>> where first ] if* file-name ;
+    dup filename>> [ ] [ name>> where first ] ?if file-name ;
 
 : numbered-log-line? ( log-line-components -- ? )
     {
@@ -329,9 +330,9 @@ SYMBOL: padding-no
     ] [ nip ] if ":" join ;
 
 : replace-log-line-numbers ( object log -- log' )
-    "\n" split harvest
+    split-lines harvest
     [ replace-log-line-number ] with map
-    "\n" join ;
+    join-lines ;
 
 : gl-shader-kind ( shader-kind -- shader-kind )
     {
@@ -392,7 +393,7 @@ M: vertex-array-object dispose
     '[ _ swap first2 bind-vertex-format ] each ; inline
 
 : (reset-vertex-array) ( -- )
-    GL_MAX_VERTEX_ATTRIBS get-gl-int iota [ glDisableVertexAttribArray ] each ; inline
+    GL_MAX_VERTEX_ATTRIBS get-gl-int <iota> [ glDisableVertexAttribArray ] each ; inline
 
 :: <multi-vertex-array-object> ( vertex-formats program-instance -- vertex-array )
     gen-vertex-array :> handle
@@ -455,7 +456,7 @@ TUPLE: compile-shader-error shader log ;
 TUPLE: link-program-error program log ;
 
 : throw-compile-shader-error ( shader instance -- * )
-    [ dup ] dip [ gl-shader-info-log ] [ delete-gl-shader ] bi
+    [ dup ] dip [ gl-shader-info-log ] [ glDeleteShader ] bi
     replace-log-line-numbers compile-shader-error boa throw ;
 
 : throw-link-program-error ( program instance -- * )
@@ -473,7 +474,7 @@ DEFER: <shader-instance>
     [ ] [ source>> ] [ kind>> gl-shader-kind ] tri <gl-shader>
     dup gl-shader-ok?
     [ swap world get \ shader-instance boa window-resource ]
-    [ compile-shader-error ] if ;
+    [ throw-compile-shader-error ] if ;
 
 : (link-program) ( program shader-instances -- program-instance )
     '[ _ [ handle>> ] map ]
@@ -488,16 +489,19 @@ DEFER: <shader-instance>
     dup gl-program-ok?  [
         [ swap world get \ program-instance boa |dispose dup verify-feedback-format ]
         with-destructors window-resource
-    ] [ link-program-error ] if ;
+    ] [ throw-link-program-error ] if ;
 
 : link-program ( program -- program-instance )
     dup shaders>> [ <shader-instance> ] map (link-program) ;
 
+: word-directory ( word -- directory )
+    where first parent-directory ;
+
 : in-word's-path ( word kind filename -- word kind filename' )
-    [ over ] dip [ where first parent-directory ] dip append-path ;
+    pick word-directory prepend-path ;
 
 : become-shader-instance ( shader-instance new-shader-instance -- )
-    handle>> [ swap delete-gl-shader ] curry change-handle drop ;
+    handle>> [ swap glDeleteShader ] curry change-handle drop ;
 
 : refresh-shader-source ( shader -- )
     dup filename>>
@@ -505,7 +509,7 @@ DEFER: <shader-instance>
     [ drop ] if* ;
 
 : become-program-instance ( program-instance new-program-instance -- )
-    handle>> [ swap delete-gl-program-only ] curry change-handle drop ;
+    handle>> [ swap glDeleteProgram ] curry change-handle drop ;
 
 : reset-memos ( -- )
     \ uniform-index reset-memoized
@@ -614,18 +618,18 @@ SYNTAX: GLSL-PROGRAM:
     dup old-instances [
         f
         lexer get line>>
-        \ ; parse-until >array shaders-and-formats
+        parse-array-def shaders-and-formats
     ] dip
     program boa
     over reset-generic
     define-constant ;
 
 M: shader-instance dispose
-    [ dup valid-handle? [ delete-gl-shader ] [ drop ] if f ] change-handle
+    [ dup valid-handle? [ glDeleteShader ] [ drop ] if f ] change-handle
     [ world>> ] [ shader>> instances>> ] [ ] tri ?delete-at ;
 
 M: program-instance dispose
-    [ dup valid-handle? [ delete-gl-program-only ] [ drop ] if f ] change-handle
+    [ dup valid-handle? [ glDeleteProgram ] [ drop ] if f ] change-handle
     [ world>> ] [ program>> instances>> ] [ ] tri ?delete-at
     reset-memos ;