From ff224b791ef11418e2da35efc1f2431bb8ac6fa8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Jan 2008 09:23:33 -0800
Subject: [PATCH 01/10] Fix typo in 3keep documentation

---
 core/kernel/kernel-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 8f0e4efbd9..47f98a2eb8 100755
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -372,7 +372,7 @@ HELP: 2keep
 { $description "Call a quotation with two values on the stack, restoring the values when the quotation returns." } ;
 
 HELP: 3keep
-{ $values { "quot" "a quotation with stack effect " { $snippet "( x y -- )" } } { "x" object } { "y" object } { "z" object } }
+{ $values { "quot" "a quotation with stack effect " { $snippet "( x y z -- )" } } { "x" object } { "y" object } { "z" object } }
 { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ;
 
 HELP: 2apply

From 5e48afda60880cd9835edf6a2a86e612a5fdabb1 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Jan 2008 09:25:49 -0800
Subject: [PATCH 02/10] Add roll and -roll to the set of highlighted shuffle
 words in the TextMate bundle

---
 misc/Factor.tmbundle/Syntaxes/Factor.tmLanguage | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/misc/Factor.tmbundle/Syntaxes/Factor.tmLanguage b/misc/Factor.tmbundle/Syntaxes/Factor.tmLanguage
index 8df0179fd1..199185c93d 100644
--- a/misc/Factor.tmbundle/Syntaxes/Factor.tmLanguage
+++ b/misc/Factor.tmbundle/Syntaxes/Factor.tmLanguage
@@ -139,7 +139,7 @@
 		</dict>
 		<dict>
 			<key>match</key>
-			<string>(^|(?&lt;=\s))(drop|2drop|3drop|keep|2keep|3keep|nip|2nip|dup|2dup|3dup|dupd|over|pick|tuck|swap|rot|-rot|slip|2swap|swapd|&gt;r|r&gt;)(\s|$)</string>
+			<string>(^|(?&lt;=\s))(drop|2drop|3drop|keep|2keep|3keep|nip|2nip|dup|2dup|3dup|dupd|over|pick|tuck|swap|rot|-rot|roll|-roll|slip|2swap|swapd|&gt;r|r&gt;)(\s|$)</string>
 			<key>name</key>
 			<string>keyword.control.stack.factor</string>
 		</dict>

From c5f0829b095c37385ae16b242db0d1e80d40487c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 20 Jan 2008 10:08:36 -0800
Subject: [PATCH 03/10] Add call-with and call-with2 to combinators.lib, which
 act like map-call-with except they do not collect the results into an array

---
 extra/combinators/lib/lib.factor | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 9356d6c9b5..0882f3d810 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -173,14 +173,24 @@ MACRO: parallel-call ( quots -- )
 ! map-call and friends
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: (make-call-with) ( quots -- quot ) 
+  [ [ keep ] curry ] map concat [ drop ] append ;
+
+MACRO: call-with ( quots -- )
+  (make-call-with) ;
+
 MACRO: map-call-with ( quots -- )
-  [ [ [ keep ] curry ] map concat ] keep length [ nip narray ] curry compose ;
+  [ (make-call-with) ] keep length [ narray ] curry compose ;
+
+: (make-call-with2) ( quots -- quot )
+  [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
+  [ 2drop ] append ;
+
+MACRO: call-with2 ( quots -- )
+  (make-call-with2) ;
 
 MACRO: map-call-with2 ( quots -- )
-  dup >r
-  [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
-  [ 2drop ] append
-  r> length [ narray ] curry append ;
+  dup >r (make-call-with2) r> length [ narray ] curry append ;
 
 MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ;
 

From 3c50cab4c852b4a3456256e64c44eb501ce464aa Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 24 Jan 2008 22:06:36 -0800
Subject: [PATCH 04/10] Have the "Help for Word" command in the TextMate bundle
 use help-window rather than help

---
 misc/Factor.tmbundle/Commands/Help for Word.tmCommand | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/misc/Factor.tmbundle/Commands/Help for Word.tmCommand b/misc/Factor.tmbundle/Commands/Help for Word.tmCommand
index 350c01d344..0ff133c891 100644
--- a/misc/Factor.tmbundle/Commands/Help for Word.tmCommand	
+++ b/misc/Factor.tmbundle/Commands/Help for Word.tmCommand	
@@ -11,7 +11,7 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
 
 doc = STDIN.read
 word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-factor_run(%Q(#{doc_using_statements(doc)} USE: help\n \\ #{word} help))</string>
+factor_run(%Q(#{doc_using_statements(doc)} USE: ui.tools.workspace\n \\ #{word} help-window))</string>
 	<key>fallbackInput</key>
 	<string>word</string>
 	<key>input</key>

From 3a0540555ec05c3b44733813e5d8b986db49852b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 24 Jan 2008 22:16:36 -0800
Subject: [PATCH 05/10] Add framebuffer helper words to opengl vocabulary. Add
 a new "line-art" demo demonstrating OpenGL GLSL and framebuffer rendering.
 Push code common to line-art and cel-shading into an opengl-demo-support
 vocab

---
 extra/cel-shading/cel-shading.factor          |  98 ++------
 extra/line-art/authors.txt                    |   1 +
 extra/line-art/line-art.factor                | 229 ++++++++++++++++++
 extra/line-art/summary.txt                    |   1 +
 extra/line-art/tags.txt                       |   3 +
 extra/opengl-demo-support/authors.txt         |   1 +
 .../opengl-demo-support.factor                |  74 ++++++
 extra/opengl-demo-support/summary.txt         |   1 +
 extra/opengl-demo-support/tags.txt            |   1 +
 extra/opengl/opengl.factor                    |  78 +++++-
 10 files changed, 400 insertions(+), 87 deletions(-)
 create mode 100644 extra/line-art/authors.txt
 create mode 100644 extra/line-art/line-art.factor
 create mode 100644 extra/line-art/summary.txt
 create mode 100644 extra/line-art/tags.txt
 create mode 100644 extra/opengl-demo-support/authors.txt
 create mode 100644 extra/opengl-demo-support/opengl-demo-support.factor
 create mode 100644 extra/opengl-demo-support/summary.txt
 create mode 100644 extra/opengl-demo-support/tags.txt

diff --git a/extra/cel-shading/cel-shading.factor b/extra/cel-shading/cel-shading.factor
index 20b392195a..54664fc011 100644
--- a/extra/cel-shading/cel-shading.factor
+++ b/extra/cel-shading/cel-shading.factor
@@ -1,51 +1,15 @@
-USING: arrays bunny io io.files kernel
-       math math.functions math.vectors multiline
-       namespaces
-       opengl opengl.gl
-       prettyprint
-       sequences ui ui.gadgets ui.gestures ui.render ;
+USING: arrays bunny combinators.lib io io.files kernel
+       math math.functions multiline
+       opengl opengl.gl opengl-demo-support
+       sequences ui ui.gadgets ui.render ;
 IN: cel-shading
 
-: NEAR-PLANE 1.0 64.0 / ; inline
-: FAR-PLANE 4.0 ; inline
-: FOV 2.0 sqrt 1+ ; inline
-: MOUSE-MOTION-SCALE 0.5 ; inline
-: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline
-: KEY-ROTATE-STEP 1.0 ; inline
-: KEY-DISTANCE-STEP 1.0 64.0 / ; inline
-: DIMS { 640 480 } ; inline
-
-: FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ;
-
-SYMBOL: last-drag-loc
-
-TUPLE: cel-shading-gadget yaw pitch distance model program ;
+TUPLE: cel-shading-gadget model program ;
 
 : <cel-shading-gadget> ( -- cel-shading-gadget )
-    cel-shading-gadget construct-gadget
-    0.0 over set-cel-shading-gadget-yaw
-    0.0 over set-cel-shading-gadget-pitch
-    0.375 over set-cel-shading-gadget-distance
-    maybe-download read-model over set-cel-shading-gadget-model ;
-
-: yaw-cel-shading-gadget ( yaw gadget -- )
-    [ [ cel-shading-gadget-yaw + ] keep set-cel-shading-gadget-yaw ] keep relayout-1 ;
-
-: pitch-cel-shading-gadget ( pitch gadget -- )
-    [ [ cel-shading-gadget-pitch + ] keep set-cel-shading-gadget-pitch ] keep relayout-1 ;
-
-: zoom-cel-shading-gadget ( distance gadget -- )
-    [ [ cel-shading-gadget-distance + ] keep set-cel-shading-gadget-distance ] keep relayout-1 ;
-
-M: cel-shading-gadget pref-dim* ( gadget -- dim )
-    drop DIMS ;
-
-: -+ ( x -- -x x )
-    dup neg swap ;
-
-: cel-shading-frustum ( -- -x x -y y near far )
-    FOV-RATIO NEAR-PLANE FOV / v*n
-    first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ;
+    0.0 0.0 0.375 <demo-gadget>
+    maybe-download read-model
+    { set-delegate set-cel-shading-gadget-model } cel-shading-gadget construct ;
 
 STRING: cel-shading-vertex-shader-source
 varying vec3 position, normal;
@@ -90,9 +54,8 @@ main()
 ;
 
 : cel-shading-program ( -- program )
-    cel-shading-vertex-shader-source <vertex-shader> check-gl-shader
-    cel-shading-fragment-shader-source <fragment-shader> check-gl-shader
-    2array <gl-program> check-gl-program ;
+    cel-shading-vertex-shader-source cel-shading-fragment-shader-source
+    <simple-gl-program> ;
 
 M: cel-shading-gadget graft* ( gadget -- )
     0.0 0.0 0.0 1.0 glClearColor
@@ -104,19 +67,13 @@ M: cel-shading-gadget ungraft* ( gadget -- )
     cel-shading-gadget-program delete-gl-program ;
 
 : cel-shading-draw-setup ( gadget -- gadget )
-    GL_PROJECTION glMatrixMode
-    glLoadIdentity
-    cel-shading-frustum glFrustum
-    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
-    GL_MODELVIEW glMatrixMode
-    glLoadIdentity
-    [ >r 0.0 0.0 r> cel-shading-gadget-distance neg glTranslatef ] keep
-    [ cel-shading-gadget-pitch 1.0 0.0 0.0 glRotatef ] keep
-    [ cel-shading-gadget-yaw   0.0 1.0 0.0 glRotatef ] keep
-    [ cel-shading-gadget-program [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ] keep
-                                   [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] keep
-                                   [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] keep
-                                   "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] keep ;
+    [ demo-gadget-set-matrices ] keep
+    [ cel-shading-gadget-program
+        { [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ]
+          [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ]
+          [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ]
+          [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] } call-with
+    ] keep ;
 
 M: cel-shading-gadget draw-gadget* ( gadget -- )
     dup cel-shading-gadget-program [
@@ -125,27 +82,6 @@ M: cel-shading-gadget draw-gadget* ( gadget -- )
         cel-shading-gadget-model first3 draw-bunny
     ] with-gl-program ;
 
-: reset-last-drag-rel ( -- )
-    { 0 0 } last-drag-loc set ;
-: last-drag-rel ( -- rel )
-    drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ;
-
-: drag-yaw-pitch ( -- yaw pitch )
-    last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
-
-cel-shading-gadget H{
-    { T{ key-down f f "LEFT"  } [ KEY-ROTATE-STEP neg swap yaw-cel-shading-gadget ] }
-    { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP     swap yaw-cel-shading-gadget ] }
-    { T{ key-down f f "DOWN"  } [ KEY-ROTATE-STEP neg swap pitch-cel-shading-gadget ] }
-    { T{ key-down f f "UP"    } [ KEY-ROTATE-STEP     swap pitch-cel-shading-gadget ] }
-    { T{ key-down f f "="     } [ KEY-DISTANCE-STEP neg swap zoom-cel-shading-gadget ] }
-    { T{ key-down f f "-"     } [ KEY-DISTANCE-STEP     swap zoom-cel-shading-gadget ] }
-    
-    { T{ button-down f f 1 }    [ drop reset-last-drag-rel ] }
-    { T{ drag f 1 }             [ drag-yaw-pitch rot [ pitch-cel-shading-gadget ] keep yaw-cel-shading-gadget ] }
-    { T{ mouse-scroll }         [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-cel-shading-gadget ] }
-} set-gestures
-
 : cel-shading-window ( -- )
     [ <cel-shading-gadget> "Cel Shading" open-window ] with-ui ;
     
diff --git a/extra/line-art/authors.txt b/extra/line-art/authors.txt
new file mode 100644
index 0000000000..6a0dc7293a
--- /dev/null
+++ b/extra/line-art/authors.txt
@@ -0,0 +1 @@
+Joe Groff
\ No newline at end of file
diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor
new file mode 100644
index 0000000000..0fdbdd1321
--- /dev/null
+++ b/extra/line-art/line-art.factor
@@ -0,0 +1,229 @@
+USING: arrays bunny combinators.lib continuations io io.files kernel
+       math math.functions math.vectors multiline
+       namespaces
+       opengl opengl.gl opengl-demo-support
+       prettyprint
+       sequences ui ui.gadgets ui.gestures ui.render ;
+IN: line-art
+
+TUPLE: line-art-gadget
+    model step1-program step2-program
+    framebuffer color-texture normal-texture depth-texture framebuffer-dim ;
+
+: <line-art-gadget> ( -- line-art-gadget )
+    0.0 0.0 0.375 <demo-gadget>
+    maybe-download read-model
+    { set-delegate set-line-art-gadget-model } line-art-gadget construct ;
+
+STRING: line-art-step1-vertex-shader-source
+varying vec3 normal;
+
+void
+main()
+{
+    gl_Position = ftransform();
+    normal = gl_Normal;
+}
+
+;
+
+STRING: line-art-step1-fragment-shader-source
+varying vec3 normal;
+uniform vec4 color;
+
+void
+main()
+{
+    gl_FragData[0] = color;
+    gl_FragData[1] = vec4(normal, 1);
+}
+
+;
+
+STRING: line-art-step2-vertex-shader-source
+varying vec2 coord;
+
+void
+main()
+{
+    gl_Position = ftransform();
+    coord = (gl_Vertex * vec4(0.5) + vec4(0.5)).xy;
+}
+
+;
+
+STRING: line-art-step2-fragment-shader-source
+uniform sampler2D colormap, normalmap, depthmap;
+uniform vec4 line_color;
+varying vec2 coord;
+
+const float DEPTH_RATIO_THRESHOLD = 2.0, NORMAL_DOT_THRESHOLD = 0.95, SAMPLE_SPREAD = 1.0/1024.0;
+
+bool
+is_normal_border(vec3 norm1, vec3 norm2)
+{
+    return dot(norm1, norm2) < NORMAL_DOT_THRESHOLD;
+}
+bool
+is_depth_border(float depth1, float depth2)
+{
+    float ratio = depth1/depth2;
+    return 1.0/DEPTH_RATIO_THRESHOLD > ratio || ratio > DEPTH_RATIO_THRESHOLD;
+}
+
+bool
+is_border(vec2 coord)
+{
+    vec2 coord1 = coord + vec2(-SAMPLE_SPREAD, -SAMPLE_SPREAD),
+         coord2 = coord + vec2( SAMPLE_SPREAD, -SAMPLE_SPREAD),
+         coord3 = coord + vec2(-SAMPLE_SPREAD,  SAMPLE_SPREAD),
+         coord4 = coord + vec2( SAMPLE_SPREAD,  SAMPLE_SPREAD);
+    
+    /* This border checking code is meant to be easy to follow rather than blazingly fast.
+     * The normal/depth checks could be easily parallelized into matrix or vector operations to
+     * improve performance. */
+    vec3 normal1 = texture2D(normalmap, coord1).xyz,
+         normal2 = texture2D(normalmap, coord2).xyz,
+         normal3 = texture2D(normalmap, coord3).xyz,
+         normal4 = texture2D(normalmap, coord4).xyz;
+    float depth1 = texture2D(depthmap, coord1).x,
+          depth2 = texture2D(depthmap, coord2).x,
+          depth3 = texture2D(depthmap, coord3).x,
+          depth4 = texture2D(depthmap, coord4).x;
+    
+    return (depth1 < 1.0 || depth2 < 1.0 || depth3 < 1.0 || depth4 < 1.0)
+        && (is_normal_border(normal1, normal2)
+            || is_normal_border(normal1, normal3)
+            || is_normal_border(normal1, normal4)
+            || is_normal_border(normal2, normal3)
+            || is_normal_border(normal2, normal4)
+            || is_normal_border(normal3, normal4)
+            /* || is_depth_border(depth1, depth2)
+            || is_depth_border(depth1, depth3)
+            || is_depth_border(depth1, depth4)
+            || is_depth_border(depth2, depth3)
+            || is_depth_border(depth2, depth4)
+            || is_depth_border(depth3, depth4) */
+        );
+}
+
+void
+main()
+{
+    gl_FragColor = is_border(coord)
+        ? line_color
+        : texture2D(colormap, coord);
+}
+
+;
+
+: (line-art-step1-program) ( -- step1 )
+    line-art-step1-vertex-shader-source line-art-step1-fragment-shader-source
+    <simple-gl-program> ;
+: (line-art-step2-program) ( -- step2 )
+    line-art-step2-vertex-shader-source line-art-step2-fragment-shader-source
+    <simple-gl-program> ;
+
+: (line-art-framebuffer-texture) ( dim iformat xformat -- texture )
+    swapd >r >r >r
+    GL_TEXTURE0 glActiveTexture
+    gen-texture GL_TEXTURE_2D over glBindTexture
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri
+    GL_TEXTURE_2D 0 r> r> first2 0 r> GL_UNSIGNED_BYTE f glTexImage2D ;
+
+: (line-art-color-texture) ( dim -- texture )
+    GL_RGBA16F_ARB GL_RGBA (line-art-framebuffer-texture) ;
+
+: (line-art-normal-texture) ( dim -- texture )
+    GL_RGBA16F_ARB GL_RGBA (line-art-framebuffer-texture) ;
+
+: (line-art-depth-texture) ( dim -- texture )
+    GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (line-art-framebuffer-texture) ;
+
+: (attach-framebuffer-texture) ( texture attachment -- )
+    swap >r >r GL_FRAMEBUFFER_EXT r> GL_TEXTURE_2D r> 0 glFramebufferTexture2DEXT gl-error ;
+
+: (line-art-framebuffer) ( color-texture normal-texture depth-texture -- framebuffer )
+    3array gen-framebuffer dup [
+        swap GL_COLOR_ATTACHMENT0_EXT
+             GL_COLOR_ATTACHMENT1_EXT
+             GL_DEPTH_ATTACHMENT_EXT 3array [ (attach-framebuffer-texture) ] 2each
+        check-framebuffer
+    ] with-framebuffer ;
+    
+: line-art-remake-framebuffer-if-needed ( gadget -- )
+    dup { rect-dim rect-dim line-art-gadget-framebuffer-dim } get-slots = [ 2drop ] [
+        swap >r
+        dup (line-art-color-texture) gl-error
+        swap dup (line-art-normal-texture) gl-error
+        swap dup (line-art-depth-texture) gl-error
+        swap >r
+        [ (line-art-framebuffer) ] 3keep
+        r> r> { set-line-art-gadget-framebuffer
+                set-line-art-gadget-color-texture
+                set-line-art-gadget-normal-texture
+                set-line-art-gadget-depth-texture
+                set-line-art-gadget-framebuffer-dim } set-slots
+    ] if ;
+    
+M: line-art-gadget graft* ( gadget -- )
+    GL_CULL_FACE glEnable
+    GL_DEPTH_TEST glEnable
+    (line-art-step1-program) over set-line-art-gadget-step1-program
+    (line-art-step2-program) swap set-line-art-gadget-step2-program ;
+
+M: line-art-gadget ungraft* ( gadget -- )
+    dup line-art-gadget-framebuffer [
+        { [ line-art-gadget-step1-program delete-gl-program ]
+          [ line-art-gadget-step2-program delete-gl-program ]
+          [ line-art-gadget-framebuffer delete-framebuffer ]
+          [ line-art-gadget-color-texture delete-texture ]
+          [ line-art-gadget-normal-texture delete-texture ]
+          [ line-art-gadget-depth-texture delete-texture ]
+          [ f swap set-line-art-gadget-framebuffer-dim ]
+          [ f swap set-line-art-gadget-framebuffer ] } call-with
+    ] [ drop ] if ;
+
+: line-art-draw-setup ( gadget -- gadget )
+    0.0 0.0 0.0 1.0 glClearColor
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    dup demo-gadget-set-matrices
+    dup line-art-remake-framebuffer-if-needed gl-error ;
+
+: line-art-clear-framebuffer ( -- )
+    GL_COLOR_ATTACHMENT0_EXT glDrawBuffer
+    0.2 0.2 0.2 1.0 glClearColor
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    GL_COLOR_ATTACHMENT1_EXT glDrawBuffer
+    0.0 0.0 0.0 0.0 glClearColor
+    GL_COLOR_BUFFER_BIT glClear ;
+
+M: line-art-gadget draw-gadget* ( gadget -- )
+    line-art-draw-setup
+    dup line-art-gadget-framebuffer [
+        line-art-clear-framebuffer
+        GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT 2array set-draw-buffers
+        dup line-art-gadget-step1-program dup [
+            "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f
+            0.0 -0.12 0.0 glTranslatef
+            dup line-art-gadget-model first3 draw-bunny
+        ] with-gl-program
+    ] with-framebuffer
+    init-matrices
+    dup line-art-gadget-color-texture GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit
+    dup line-art-gadget-normal-texture GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit
+    dup line-art-gadget-depth-texture GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit
+    line-art-gadget-step2-program dup [
+        { [ "colormap"  glGetUniformLocation 0 glUniform1i ]
+          [ "normalmap" glGetUniformLocation 1 glUniform1i ]
+          [ "depthmap"  glGetUniformLocation 2 glUniform1i ] } call-with
+        { -1.0 -1.0 } { 1.0 1.0 } draw-rectangle
+    ] with-gl-program ;
+
+: line-art-window ( -- )
+    [ <line-art-gadget> "Line Art" open-window ] with-ui ;
+    
+MAIN: line-art-window
diff --git a/extra/line-art/summary.txt b/extra/line-art/summary.txt
new file mode 100644
index 0000000000..06d16da2bf
--- /dev/null
+++ b/extra/line-art/summary.txt
@@ -0,0 +1 @@
+Stanford Bunny rendered with cartoon-style lines instead of shading
\ No newline at end of file
diff --git a/extra/line-art/tags.txt b/extra/line-art/tags.txt
new file mode 100644
index 0000000000..0db7e8e629
--- /dev/null
+++ b/extra/line-art/tags.txt
@@ -0,0 +1,3 @@
+demos
+opengl
+glsl
\ No newline at end of file
diff --git a/extra/opengl-demo-support/authors.txt b/extra/opengl-demo-support/authors.txt
new file mode 100644
index 0000000000..6a0dc7293a
--- /dev/null
+++ b/extra/opengl-demo-support/authors.txt
@@ -0,0 +1 @@
+Joe Groff
\ No newline at end of file
diff --git a/extra/opengl-demo-support/opengl-demo-support.factor b/extra/opengl-demo-support/opengl-demo-support.factor
new file mode 100644
index 0000000000..ecc6458d41
--- /dev/null
+++ b/extra/opengl-demo-support/opengl-demo-support.factor
@@ -0,0 +1,74 @@
+USING: arrays combinators.lib kernel math math.functions math.vectors namespaces
+       opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render ;
+IN: opengl-demo-support
+
+: NEAR-PLANE 1.0 64.0 / ; inline
+: FAR-PLANE 4.0 ; inline
+: FOV 2.0 sqrt 1+ ; inline
+: MOUSE-MOTION-SCALE 0.5 ; inline
+: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline
+: KEY-ROTATE-STEP 1.0 ; inline
+: KEY-DISTANCE-STEP 1.0 64.0 / ; inline
+: DIMS { 640 480 } ; inline
+
+: FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ;
+
+SYMBOL: last-drag-loc
+
+TUPLE: demo-gadget yaw pitch distance ;
+
+: <demo-gadget> ( yaw pitch distance -- gadget )
+    demo-gadget construct-gadget 
+    [ { set-demo-gadget-yaw set-demo-gadget-pitch set-demo-gadget-distance } set-slots ] keep ;
+
+: yaw-demo-gadget ( yaw gadget -- )
+    [ [ demo-gadget-yaw + ] keep set-demo-gadget-yaw ] keep relayout-1 ;
+
+: pitch-demo-gadget ( pitch gadget -- )
+    [ [ demo-gadget-pitch + ] keep set-demo-gadget-pitch ] keep relayout-1 ;
+
+: zoom-demo-gadget ( distance gadget -- )
+    [ [ demo-gadget-distance + ] keep set-demo-gadget-distance ] keep relayout-1 ;
+
+M: demo-gadget pref-dim* ( gadget -- dim )
+    drop DIMS ;
+
+: -+ ( x -- -x x )
+    dup neg swap ;
+
+: demo-gadget-frustum ( -- -x x -y y near far )
+    FOV-RATIO NEAR-PLANE FOV / v*n
+    first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ;
+
+: demo-gadget-set-matrices ( gadget -- )
+    GL_PROJECTION glMatrixMode
+    glLoadIdentity
+    demo-gadget-frustum glFrustum
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    GL_MODELVIEW glMatrixMode
+    glLoadIdentity
+    { [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ]
+      [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ]
+      [ demo-gadget-yaw   0.0 1.0 0.0 glRotatef ] } call-with ;
+
+: reset-last-drag-rel ( -- )
+    { 0 0 } last-drag-loc set ;
+: last-drag-rel ( -- rel )
+    drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ;
+
+: drag-yaw-pitch ( -- yaw pitch )
+    last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
+
+demo-gadget H{
+    { T{ key-down f f "LEFT"  } [ KEY-ROTATE-STEP neg swap yaw-demo-gadget ] }
+    { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP     swap yaw-demo-gadget ] }
+    { T{ key-down f f "DOWN"  } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] }
+    { T{ key-down f f "UP"    } [ KEY-ROTATE-STEP     swap pitch-demo-gadget ] }
+    { T{ key-down f f "="     } [ KEY-DISTANCE-STEP neg swap zoom-demo-gadget ] }
+    { T{ key-down f f "-"     } [ KEY-DISTANCE-STEP     swap zoom-demo-gadget ] }
+    
+    { T{ button-down f f 1 }    [ drop reset-last-drag-rel ] }
+    { T{ drag f 1 }             [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
+    { T{ mouse-scroll }         [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-demo-gadget ] }
+} set-gestures
+
diff --git a/extra/opengl-demo-support/summary.txt b/extra/opengl-demo-support/summary.txt
new file mode 100644
index 0000000000..eca681450f
--- /dev/null
+++ b/extra/opengl-demo-support/summary.txt
@@ -0,0 +1 @@
+Common support for OpenGL demos
\ No newline at end of file
diff --git a/extra/opengl-demo-support/tags.txt b/extra/opengl-demo-support/tags.txt
new file mode 100644
index 0000000000..a6797bf627
--- /dev/null
+++ b/extra/opengl-demo-support/tags.txt
@@ -0,0 +1 @@
+opengl
diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor
index 80c9b80ea7..9566ffd1e6 100644
--- a/extra/opengl/opengl.factor
+++ b/extra/opengl/opengl.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! Portions copyright (C) 2007 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types kernel libc math namespaces sequences
+USING: alien alien.c-types continuations kernel libc math namespaces sequences
 math.vectors math.constants math.functions opengl.gl opengl.glu
 combinators arrays ;
 IN: opengl
@@ -93,8 +93,60 @@ IN: opengl
         ] 2each 2drop
     ] do-state ;
 
+: (gen-gl-object) ( quot -- id )
+    >r 1 0 <uint> r> keep *uint ; inline
 : gen-texture ( -- id )
-    1 0 <uint> [ glGenTextures ] keep *uint ;
+    [ glGenTextures ] (gen-gl-object) ;
+: gen-framebuffer ( -- id )
+    [ glGenFramebuffersEXT ] (gen-gl-object) ;
+: gen-renderbuffer ( -- id )
+    [ glGenRenderbuffersEXT ] (gen-gl-object) ;
+: gen-buffer ( -- id )
+    [ glGenBuffers ] (gen-gl-object) ;
+
+: (delete-gl-object) ( id quot -- )
+    >r 1 swap <uint> r> call ; inline
+: delete-texture ( id -- )
+    [ glDeleteTextures ] (delete-gl-object) ;
+: delete-framebuffer ( id -- )
+    [ glDeleteFramebuffersEXT ] (delete-gl-object) ;
+: delete-renderbuffer ( id -- )
+    [ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
+: delete-buffer ( id -- )
+    [ glDeleteBuffers ] (delete-gl-object) ;
+
+: framebuffer-incomplete? ( -- ? )
+    GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
+    dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
+
+: framebuffer-error ( status -- * )
+    { { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] }
+      { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
+      { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] }
+      [ drop gl-error "unknown framebuffer error" ] } case throw ;
+
+: check-framebuffer ( -- )
+    framebuffer-incomplete? [ framebuffer-error ] when* ;
+
+: with-framebuffer ( id quot -- )
+    GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT
+    call
+    GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ; inline
+
+: bind-texture-unit ( id target unit -- )
+    glActiveTexture swap glBindTexture gl-error ;
+
+: framebuffer-attachment ( attachment -- id )
+    GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
+    0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;
+    
+: set-draw-buffers ( buffers -- )
+    dup length swap >c-uint-array glDrawBuffers ;
 
 : do-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
@@ -120,7 +172,7 @@ TUPLE: sprite loc dim dim2 dlist texture ;
             GL_UNSIGNED_BYTE r> glTexImage2D
         ] do-attribs
     ] keep ;
-
+    
 : gen-dlist ( -- id ) 1 glGenLists ;
 
 : make-dlist ( type quot -- id )
@@ -154,6 +206,14 @@ TUPLE: sprite loc dim dim2 dlist texture ;
     swap sprite-loc v- gl-translate
     GL_TEXTURE_2D 0 glBindTexture ;
 
+: draw-rectangle ( lower-left upper-right -- )
+    GL_QUADS [
+        over first2 glVertex2d
+        dup first pick second glVertex2d
+        dup first2 glVertex2d
+        swap first swap second glVertex2d
+    ] do-state ;
+
 : make-sprite-dlist ( sprite -- id )
     GL_MODELVIEW [
         GL_COMPILE [ draw-sprite ] make-dlist
@@ -167,7 +227,7 @@ TUPLE: sprite loc dim dim2 dlist texture ;
 
 : free-sprite ( sprite -- )
     dup sprite-dlist delete-dlist
-    sprite-texture <uint> 1 swap glDeleteTextures ;
+    sprite-texture delete-texture ;
 
 : free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ;
 
@@ -241,7 +301,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
     [ dupd glAttachShader ] each
     [ glLinkProgram ] keep
     gl-error ;
-
+    
 : (gl-program?) ( object -- ? )
     dup integer? [ glIsProgram c-true? ] [ drop f ] if ;
 
@@ -279,6 +339,12 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
     delete-gl-program-only ;
 
 : with-gl-program ( program quot -- )
-    swap glUseProgram call 0 glUseProgram ; inline
+    swap glUseProgram [ call ] [ 0 glUseProgram ] [ ] cleanup ; inline
 
 PREDICATE: integer gl-program (gl-program?) ;
+
+: <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
+    >r <vertex-shader> check-gl-shader
+    r> <fragment-shader> check-gl-shader
+    2array <gl-program> check-gl-program ;
+

From ca6247f3b3e7956bb8e76773bf7534654730e333 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 26 Jan 2008 16:59:53 -0800
Subject: [PATCH 06/10] Catch exceptions thrown by graft* and ungraft* in the
 notify loop so that the gadgets' graft states remain consistent

---
 extra/ui/ui.factor | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor
index febb56e10f..4daadd2765 100755
--- a/extra/ui/ui.factor
+++ b/extra/ui/ui.factor
@@ -120,12 +120,12 @@ SYMBOL: ui-hook
     [ dup update-hand draw-world ] each ;
 
 : notify ( gadget -- )
-    dup gadget-graft-state {
-        { { f t } [ dup activate-control dup graft* ] }
-        { { t f } [ dup activate-control dup ungraft* ] }
-    } case
-    dup gadget-graft-state first { f f } { t t } ?
-    swap set-gadget-graft-state ;
+    dup gadget-graft-state [ dup {
+        { { f t } [ over activate-control over graft* ] }
+        { { t f } [ over activate-control over ungraft* ] }
+    } case ]
+    [ first { f f } { t t } ?
+      swap set-gadget-graft-state ] [ ] cleanup ;
 
 : notify-queued ( -- )
     graft-queue [ notify ] dlist-slurp ;

From 1dbc1c1f9bfee0ef016bbe28f381d388cc099f91 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 26 Jan 2008 17:15:09 -0800
Subject: [PATCH 07/10] Improve the line-art demo. Put cleanup guards on
 libc:with-malloc and opengl:with-framebuffer .

---
 core/libc/libc.factor          |   4 +-
 extra/line-art/line-art.factor | 103 +++++++++++++++++++--------------
 extra/opengl/opengl.factor     |   4 +-
 3 files changed, 65 insertions(+), 46 deletions(-)

diff --git a/core/libc/libc.factor b/core/libc/libc.factor
index 88c5070d1f..2006850839 100644
--- a/core/libc/libc.factor
+++ b/core/libc/libc.factor
@@ -2,7 +2,7 @@
 ! Copyright (C) 2007 Slava Pestov
 ! Copyright (C) 2007 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs init inspector kernel namespaces ;
+USING: alien assocs continuations init inspector kernel namespaces ;
 IN: libc
 
 <PRIVATE
@@ -84,4 +84,4 @@ PRIVATE>
     "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
 
 : with-malloc ( size quot -- )
-    swap 1 calloc swap keep free ; inline
+    swap 1 calloc [ swap keep ] [ free ] [ ] cleanup ; inline
diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor
index 0fdbdd1321..83f2a6a975 100644
--- a/extra/line-art/line-art.factor
+++ b/extra/line-art/line-art.factor
@@ -11,7 +11,7 @@ TUPLE: line-art-gadget
     framebuffer color-texture normal-texture depth-texture framebuffer-dim ;
 
 : <line-art-gadget> ( -- line-art-gadget )
-    0.0 0.0 0.375 <demo-gadget>
+    40.0 -5.0 0.275 <demo-gadget>
     maybe-download read-model
     { set-delegate set-line-art-gadget-model } line-art-gadget construct ;
 
@@ -57,62 +57,79 @@ uniform sampler2D colormap, normalmap, depthmap;
 uniform vec4 line_color;
 varying vec2 coord;
 
-const float DEPTH_RATIO_THRESHOLD = 2.0, NORMAL_DOT_THRESHOLD = 0.95, SAMPLE_SPREAD = 1.0/1024.0;
+const float DEPTH_RATIO_THRESHOLD = 1.001, NORMAL_DOT_THRESHOLD = 1.0, SAMPLE_SPREAD = 1.0/512.0;
 
 bool
 is_normal_border(vec3 norm1, vec3 norm2)
 {
     return dot(norm1, norm2) < NORMAL_DOT_THRESHOLD;
 }
-bool
-is_depth_border(float depth1, float depth2)
+
+float
+depth_sample(vec2 c)
 {
-    float ratio = depth1/depth2;
-    return 1.0/DEPTH_RATIO_THRESHOLD > ratio || ratio > DEPTH_RATIO_THRESHOLD;
+    return texture2D(depthmap, c).x;
+}
+bool
+are_depths_border(vec3 depths)
+{
+    return any(lessThan(depths, vec3(1.0/DEPTH_RATIO_THRESHOLD)))
+        || any(greaterThan(depths, vec3(DEPTH_RATIO_THRESHOLD)));
 }
 
-bool
-is_border(vec2 coord)
+vec3
+normal_sample(vec2 c)
 {
-    vec2 coord1 = coord + vec2(-SAMPLE_SPREAD, -SAMPLE_SPREAD),
-         coord2 = coord + vec2( SAMPLE_SPREAD, -SAMPLE_SPREAD),
-         coord3 = coord + vec2(-SAMPLE_SPREAD,  SAMPLE_SPREAD),
-         coord4 = coord + vec2( SAMPLE_SPREAD,  SAMPLE_SPREAD);
+    return texture2D(normalmap, c).xyz;
+}
+
+float
+min6(float a, float b, float c, float d, float e, float f)
+{
+    return min(min(min(min(min(a, b), c), d), e), f);
+}
+
+float
+border_factor(vec2 c)
+{
+    vec2 coord1 = c + vec2(-SAMPLE_SPREAD, -SAMPLE_SPREAD),
+         coord2 = c + vec2( SAMPLE_SPREAD, -SAMPLE_SPREAD),
+         coord3 = c + vec2(-SAMPLE_SPREAD,  SAMPLE_SPREAD),
+         coord4 = c + vec2( SAMPLE_SPREAD,  SAMPLE_SPREAD);
     
-    /* This border checking code is meant to be easy to follow rather than blazingly fast.
-     * The normal/depth checks could be easily parallelized into matrix or vector operations to
-     * improve performance. */
-    vec3 normal1 = texture2D(normalmap, coord1).xyz,
-         normal2 = texture2D(normalmap, coord2).xyz,
-         normal3 = texture2D(normalmap, coord3).xyz,
-         normal4 = texture2D(normalmap, coord4).xyz;
-    float depth1 = texture2D(depthmap, coord1).x,
-          depth2 = texture2D(depthmap, coord2).x,
-          depth3 = texture2D(depthmap, coord3).x,
-          depth4 = texture2D(depthmap, coord4).x;
+    vec4 depths = vec4(depth_sample(coord1),
+                       depth_sample(coord2),
+                       depth_sample(coord3),
+                       depth_sample(coord4));
+    if (depths == vec4(1, 1, 1, 1))
+        return 0.0;
     
-    return (depth1 < 1.0 || depth2 < 1.0 || depth3 < 1.0 || depth4 < 1.0)
-        && (is_normal_border(normal1, normal2)
-            || is_normal_border(normal1, normal3)
-            || is_normal_border(normal1, normal4)
-            || is_normal_border(normal2, normal3)
-            || is_normal_border(normal2, normal4)
-            || is_normal_border(normal3, normal4)
-            /* || is_depth_border(depth1, depth2)
-            || is_depth_border(depth1, depth3)
-            || is_depth_border(depth1, depth4)
-            || is_depth_border(depth2, depth3)
-            || is_depth_border(depth2, depth4)
-            || is_depth_border(depth3, depth4) */
-        );
+    vec3 ratios1 = depths.xxx/depths.yzw, ratios2 = depths.yyz/depths.zww;
+    
+    if (are_depths_border(ratios1) || are_depths_border(ratios2))
+        return 1.0;
+    
+    vec3 normal1 = normal_sample(coord1),
+         normal2 = normal_sample(coord2),
+         normal3 = normal_sample(coord3),
+         normal4 = normal_sample(coord4);
+    
+    float normal_border = 1.0 - min6(
+        dot(normal1, normal2),
+        dot(normal1, normal3),
+        dot(normal1, normal4),
+        dot(normal2, normal3),
+        dot(normal2, normal4),
+        dot(normal3, normal4)
+    );
+    
+    return normal_border;
 }
 
 void
 main()
 {
-    gl_FragColor = is_border(coord)
-        ? line_color
-        : texture2D(colormap, coord);
+    gl_FragColor = mix(texture2D(colormap, coord), line_color, border_factor(coord));
 }
 
 ;
@@ -191,7 +208,8 @@ M: line-art-gadget ungraft* ( gadget -- )
     0.0 0.0 0.0 1.0 glClearColor
     GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
     dup demo-gadget-set-matrices
-    dup line-art-remake-framebuffer-if-needed gl-error ;
+    dup line-art-remake-framebuffer-if-needed
+    gl-error ;
 
 : line-art-clear-framebuffer ( -- )
     GL_COLOR_ATTACHMENT0_EXT glDrawBuffer
@@ -219,7 +237,8 @@ M: line-art-gadget draw-gadget* ( gadget -- )
     line-art-gadget-step2-program dup [
         { [ "colormap"  glGetUniformLocation 0 glUniform1i ]
           [ "normalmap" glGetUniformLocation 1 glUniform1i ]
-          [ "depthmap"  glGetUniformLocation 2 glUniform1i ] } call-with
+          [ "depthmap"  glGetUniformLocation 2 glUniform1i ]
+          [ "line_color" glGetUniformLocation 0.2 0.0 0.0 1.0 glUniform4f ] } call-with
         { -1.0 -1.0 } { 1.0 1.0 } draw-rectangle
     ] with-gl-program ;
 
diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor
index 9566ffd1e6..737303c16d 100644
--- a/extra/opengl/opengl.factor
+++ b/extra/opengl/opengl.factor
@@ -135,8 +135,8 @@ IN: opengl
 
 : with-framebuffer ( id quot -- )
     GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT
-    call
-    GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ; inline
+    [ call ]
+    [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline
 
 : bind-texture-unit ( id target unit -- )
     glActiveTexture swap glBindTexture gl-error ;

From e396023d517f1f00c2205886c7ce94fd4c0d854b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 26 Jan 2008 17:32:12 -0800
Subject: [PATCH 08/10] Use [NSString UTF8String] instead of [NSString cString]
 in os-macosx.m to suppress deprecation warnings

---
 vm/os-macosx.m | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/vm/os-macosx.m b/vm/os-macosx.m
index 07695b77fb..d14e6ceb23 100644
--- a/vm/os-macosx.m
+++ b/vm/os-macosx.m
@@ -30,7 +30,7 @@ void early_init(void)
 
 const char *vm_executable_path(void)
 {
-	return [[[NSBundle mainBundle] executablePath] cString];
+	return [[[NSBundle mainBundle] executablePath] UTF8String];
 }
 
 const char *default_image_path(void)
@@ -55,7 +55,7 @@ const char *default_image_path(void)
 	else
 		returnVal = [path stringByAppendingPathComponent:image];
 
-	return [returnVal cString];
+	return [returnVal UTF8String];
 }
 
 void init_signals(void)

From 11eca5b38a499e0cf8e21ff3a6f5dcdcd13a89ad Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 26 Jan 2008 22:37:28 -0800
Subject: [PATCH 09/10] Documentation for new words in opengl vocab

---
 extra/line-art/line-art.factor  |  4 +-
 extra/opengl/opengl-docs.factor | 70 ++++++++++++++++++++++++++++++++-
 extra/opengl/opengl.factor      | 15 ++++---
 3 files changed, 79 insertions(+), 10 deletions(-)

diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor
index 83f2a6a975..921c9e16d5 100644
--- a/extra/line-art/line-art.factor
+++ b/extra/line-art/line-art.factor
@@ -223,7 +223,7 @@ M: line-art-gadget draw-gadget* ( gadget -- )
     line-art-draw-setup
     dup line-art-gadget-framebuffer [
         line-art-clear-framebuffer
-        GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT 2array set-draw-buffers
+        { GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT } set-draw-buffers
         dup line-art-gadget-step1-program dup [
             "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f
             0.0 -0.12 0.0 glTranslatef
@@ -239,7 +239,7 @@ M: line-art-gadget draw-gadget* ( gadget -- )
           [ "normalmap" glGetUniformLocation 1 glUniform1i ]
           [ "depthmap"  glGetUniformLocation 2 glUniform1i ]
           [ "line_color" glGetUniformLocation 0.2 0.0 0.0 1.0 glUniform4f ] } call-with
-        { -1.0 -1.0 } { 1.0 1.0 } draw-rectangle
+        { -1.0 -1.0 } { 1.0 1.0 } rect-vertices
     ] with-gl-program ;
 
 : line-art-window ( -- )
diff --git a/extra/opengl/opengl-docs.factor b/extra/opengl/opengl-docs.factor
index 58b86f09b3..756507dace 100644
--- a/extra/opengl/opengl-docs.factor
+++ b/extra/opengl/opengl-docs.factor
@@ -37,6 +37,10 @@ HELP: gl-rect
 { $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } }
 { $description "Draws the outline of a rectangle with top-left corner " { $snippet "loc" } " and bottom-right corner " { $snippet "ext" } "." } ;
 
+HELP: rect-vertices
+{ $values { "lower-left" "A pair of numbers indicating the lower-left coordinates of the rectangle." } { "upper-right" "The upper-right coordinates of the rectangle." } }
+{ $description "Emits" { $link glVertex2d } " calls outlining the axis-aligned rectangle from " { $snippet "lower-left" } to { $snippet "upper-right" } " on the z=0 plane in counterclockwise order." } ;
+
 HELP: gl-fill-poly
 { $values { "points" "a sequence of pairs of integers" } }
 { $description "Draws a filled polygon." } ;
@@ -53,6 +57,58 @@ HELP: gen-texture
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
 
+HELP: gen-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
+
+HELP: gen-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
+
+HELP: gen-buffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ;
+
+HELP: delete-texture
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
+
+HELP: delete-framebuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
+
+HELP: delete-renderbuffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
+
+HELP: delete-buffer
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ;
+
+{ gen-texture delete-texture } related-words
+{ gen-framebuffer delete-framebuffer } related-words
+{ gen-renderbuffer delete-renderbuffer } related-words
+{ gen-buffer delete-buffer } related-words
+
+HELP: framebuffer-incomplete?
+{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
+
+HELP: check-framebuffer
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
+
+HELP: with-framebuffer
+{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
+{ $description "Binds framebuffer " { $snippet "id" } " while calling " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
+
+HELP: bind-texture-unit
+{ $values { "id" "The id of a texture object." } { "target" "The texture target (e.g., " { $snippet "GL_TEXTURE_2D" } ")" } { "unit" "The texture unit to bind (e.g., " { $snippet "GL_TEXTURE0" } ")" } }
+{ $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ;
+
+HELP: set-draw-buffers
+{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet GL_BACK } ", " { $snippet GL_COLOR_ATTACHMENT0_EXT } ")"} }
+{ $description "Wrapper for " { $link glDrawBuffers } ". Sets up the buffers named in the sequence for simultaneous drawing." } ;
+
 HELP: do-attribs
 { $values { "bits" integer } { "quot" quotation } }
 { $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
@@ -148,11 +204,11 @@ HELP: gl-shader-info-log
 HELP: gl-program
 { $class-description { $snippet "gl-program" } " is a predicate class comprising values returned by OpenGL to represent proram objects. The following words are provided for creating and manipulating these objects:"
     { $list
-        { { $link <gl-program> } " - Link a set of shaders into a GLSL program" }
+        { { $link <gl-program> } ", " { $link <simple-gl-program> } " - Link a set of shaders into a GLSL program" }
         { { $link gl-program-ok? } " - Check whether a program object linked successfully" }
         { { $link check-gl-program } " - Throw an error unless a program object linked successfully" }
         { { $link gl-program-info-log } " - Retrieve the info log of messages generated by the GLSL linker" }
-        { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL linker" }
+        { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL program" }
         { { $link delete-gl-program } " - Invalidate a program object and all its attached shaders" }
         { { $link with-gl-program } " - Use a program object" }
     }
@@ -162,6 +218,12 @@ HELP: <gl-program>
 { $values { "shaders" "A sequence of " { $link gl-shader } " objects." } }
 { $description "Creates a new GLSL program object, attaches all the shader objects in the " { $snippet "shaders" } " sequence, and attempts to link them. The returned object can be checked for validity by " { $link check-gl-program } " or " { $link gl-program-ok? } ". Errors and warnings generated by the GLSL linker will be collected in the info log, available from " { $link gl-program-info-log } ".\n\nWhen the program object and its attached shaders are no longer needed, it should be deleted using " { $link delete-gl-program } "." } ;
 
+HELP: <simple-gl-program>
+{ $values { "vertex-shader-source" "A string containing GLSL vertex shader source" } { "fragment-shader-source" "A string containing GLSL fragment shader source" } }
+{ $description "Wrapper for " { $link <gl-program> } " for the simple case of compiling a single vertex shader and fragment shader and linking them into a GLSL program. Throws an exception if compiling or linking fails." } ;
+
+{ <gl-program> <simple-gl-program> } related-words
+
 HELP: gl-program-ok?
 { $values { "program" "A " { $link gl-program } " object" } }
 { $description "Returns a boolean value indicating whether the given program object linked successfully. Link errors and warnings are available in the program's info log, which can be gotten using " { $link gl-program-info-log } "." } ;
@@ -189,12 +251,16 @@ $nl
 { $subsection gl-color }
 { $subsection gl-vertex }
 { $subsection gl-translate }
+{ $subsection gen-texture }
+{ $subsection bind-texture-unit }
 "Combinators:"
 { $subsection do-state }
 { $subsection do-enabled }
 { $subsection do-attribs }
 { $subsection do-matrix }
 { $subsection with-translation }
+{ $subsection with-framebuffer }
+{ $subsection with-gl-program }
 { $subsection make-dlist }
 "Rendering geometric shapes:"
 { $subsection gl-line }
diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor
index 737303c16d..63a7370238 100644
--- a/extra/opengl/opengl.factor
+++ b/extra/opengl/opengl.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! Portions copyright (C) 2007 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types continuations kernel libc math namespaces sequences
-math.vectors math.constants math.functions opengl.gl opengl.glu
-combinators arrays ;
+USING: alien alien.c-types continuations kernel libc math macros namespaces
+math.vectors math.constants math.functions opengl.gl opengl.glu words
+combinators arrays sequences ;
 IN: opengl
 
 : coordinates [ first2 ] 2apply ;
@@ -115,7 +115,7 @@ IN: opengl
 : delete-buffer ( id -- )
     [ glDeleteBuffers ] (delete-gl-object) ;
 
-: framebuffer-incomplete? ( -- ? )
+: framebuffer-incomplete? ( -- status/f )
     GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
     dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
 
@@ -145,9 +145,12 @@ IN: opengl
     GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
     0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;
     
-: set-draw-buffers ( buffers -- )
+: (set-draw-buffers) ( buffers -- )
     dup length swap >c-uint-array glDrawBuffers ;
 
+MACRO: set-draw-buffers ( buffers -- )
+    [ dup word? [ execute ] [ ] if ] map [ (set-draw-buffers) ] curry ;
+
 : do-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
 
@@ -206,7 +209,7 @@ TUPLE: sprite loc dim dim2 dlist texture ;
     swap sprite-loc v- gl-translate
     GL_TEXTURE_2D 0 glBindTexture ;
 
-: draw-rectangle ( lower-left upper-right -- )
+: rect-vertices ( lower-left upper-right -- )
     GL_QUADS [
         over first2 glVertex2d
         dup first pick second glVertex2d

From 1d7ba3363eb9cbb5110084995bd26c1160e55304 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 27 Jan 2008 19:32:23 -0800
Subject: [PATCH 10/10] OpenGL capability checking words (require-gl-version,
 require-gl-extensions, and friends)

---
 extra/cel-shading/cel-shading.factor |  1 +
 extra/line-art/line-art.factor       |  3 ++
 extra/opengl/opengl-docs.factor      | 63 ++++++++++++++++++++++++++--
 extra/opengl/opengl.factor           | 62 ++++++++++++++++++++++++++-
 4 files changed, 123 insertions(+), 6 deletions(-)

diff --git a/extra/cel-shading/cel-shading.factor b/extra/cel-shading/cel-shading.factor
index 54664fc011..c89fd0e244 100644
--- a/extra/cel-shading/cel-shading.factor
+++ b/extra/cel-shading/cel-shading.factor
@@ -58,6 +58,7 @@ main()
     <simple-gl-program> ;
 
 M: cel-shading-gadget graft* ( gadget -- )
+    "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
     0.0 0.0 0.0 1.0 glClearColor
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor
index 921c9e16d5..054f07f63f 100644
--- a/extra/line-art/line-art.factor
+++ b/extra/line-art/line-art.factor
@@ -187,6 +187,9 @@ main()
     ] if ;
     
 M: line-art-gadget graft* ( gadget -- )
+    "2.0" { "GL_ARB_draw_buffers" "GL_ARB_shader_objects" "GL_ARB_multitexture" }
+    require-gl-version-or-extensions
+    { "GL_EXT_framebuffer_object" } require-gl-extensions
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
     (line-art-step1-program) over set-line-art-gadget-step1-program
diff --git a/extra/opengl/opengl-docs.factor b/extra/opengl/opengl-docs.factor
index 756507dace..cc8221baa1 100644
--- a/extra/opengl/opengl-docs.factor
+++ b/extra/opengl/opengl-docs.factor
@@ -39,7 +39,7 @@ HELP: gl-rect
 
 HELP: rect-vertices
 { $values { "lower-left" "A pair of numbers indicating the lower-left coordinates of the rectangle." } { "upper-right" "The upper-right coordinates of the rectangle." } }
-{ $description "Emits" { $link glVertex2d } " calls outlining the axis-aligned rectangle from " { $snippet "lower-left" } to { $snippet "upper-right" } " on the z=0 plane in counterclockwise order." } ;
+{ $description "Emits" { $link glVertex2d } " calls outlining the axis-aligned rectangle from " { $snippet "lower-left" } " to " { $snippet "upper-right" } " on the z=0 plane in counterclockwise order." } ;
 
 HELP: gl-fill-poly
 { $values { "points" "a sequence of pairs of integers" } }
@@ -99,14 +99,14 @@ HELP: check-framebuffer
 
 HELP: with-framebuffer
 { $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
-{ $description "Binds framebuffer " { $snippet "id" } " while calling " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
+{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
 
 HELP: bind-texture-unit
 { $values { "id" "The id of a texture object." } { "target" "The texture target (e.g., " { $snippet "GL_TEXTURE_2D" } ")" } { "unit" "The texture unit to bind (e.g., " { $snippet "GL_TEXTURE0" } ")" } }
 { $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ;
 
 HELP: set-draw-buffers
-{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet GL_BACK } ", " { $snippet GL_COLOR_ATTACHMENT0_EXT } ")"} }
+{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0_EXT" } ")"} }
 { $description "Wrapper for " { $link glDrawBuffers } ". Sets up the buffers named in the sequence for simultaneous drawing." } ;
 
 HELP: do-attribs
@@ -242,11 +242,66 @@ HELP: delete-gl-program
 
 HELP: with-gl-program
 { $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation" } }
-{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
+{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
+
+HELP: gl-version
+{ $values { "version" "The version string from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
+
+HELP: gl-vendor-version
+{ $values { "version" "The vendor-specific version information from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
+
+HELP: has-gl-version?
+{ $values { "version" "A version string" } { "?" "A boolean value" } }
+{ $description "Compares the version string returned by " { $link gl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
+
+HELP: require-gl-version
+{ $values { "version" "A version string" } }
+{ $description "Throws an exception if " { $link has-gl-version? } " returns false for " { $snippet "version" } "." } ;
+
+HELP: glsl-version
+{ $values { "version" "The GLSL version string from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ;
+
+HELP: glsl-vendor-version
+{ $values { "version" "The vendor-specific GLSL version information from the OpenGL implementation" } }
+{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ;
+
+HELP: has-glsl-version?
+{ $values { "version" "A version string" } { "?" "A boolean value" } }
+{ $description "Compares the version string returned by " { $link glsl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ;
+
+HELP: require-glsl-version
+{ $values { "version" "A version string" } }
+{ $description "Throws an exception if " { $link has-glsl-version? } " returns false for " { $snippet "version" } "." } ;
+
+HELP: gl-extensions
+{ $values { "seq" "A sequence of strings naming the implementation-supported OpenGL extensions" } }
+{ $description "Wrapper for " { $snippet "GL_EXTENSIONS glGetString" } " that returns a sequence of extension names supported by the OpenGL implementation." } ;
+
+HELP: has-gl-extensions?
+{ $values { "extensions" "A sequence of extension name strings" } { "?" "A boolean value" } }
+{ $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } "." } ;
+
+HELP: require-gl-extensions
+{ $values { "extensions" "A sequence of extension name strings" } }
+{ $description "Throws an exception if " { $link has-gl-extensions? } " returns false for " { $snippet "extensions" } "." } ;
+
+HELP: require-gl-version-or-extensions
+{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } }
+{ $description "Throws an exception if neither " { $link has-gl-version? } " nor " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version, or a set of equivalent extensions." } ;
+
+{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? gl-version glsl-version gl-extensions } related-words
 
 ARTICLE: "gl-utilities" "OpenGL utility words"
 "In addition to the full OpenGL API, the " { $vocab-link "opengl" } " vocabulary includes some utility words to give OpenGL a more Factor-like feel."
 $nl
+"Checking implementation capabilities:"
+{ $subsection require-gl-version }
+{ $subsection require-gl-extensions }
+{ $subsection require-glsl-version }
+{ $subsection require-gl-version-or-extensions }
 "Wrappers:"
 { $subsection gl-color }
 { $subsection gl-vertex }
diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor
index 63a7370238..2f3b87827a 100644
--- a/extra/opengl/opengl.factor
+++ b/extra/opengl/opengl.factor
@@ -2,8 +2,8 @@
 ! Portions copyright (C) 2007 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types continuations kernel libc math macros namespaces
-math.vectors math.constants math.functions opengl.gl opengl.glu words
-combinators arrays sequences ;
+math.vectors math.constants math.functions math.parser opengl.gl opengl.glu
+combinators arrays sequences splitting words ;
 IN: opengl
 
 : coordinates [ first2 ] 2apply ;
@@ -351,3 +351,61 @@ PREDICATE: integer gl-program (gl-program?) ;
     r> <fragment-shader> check-gl-shader
     2array <gl-program> check-gl-program ;
 
+: (require-gl) ( thing require-quot make-error-quot -- )
+    >r dupd call
+    [ r> 2drop ]
+    [ r> " " make throw ]
+    if ; inline
+
+: gl-extensions ( -- seq )
+    GL_EXTENSIONS glGetString " " split ;
+: has-gl-extensions? ( extensions -- ? )
+    gl-extensions subseq? ;
+: (make-gl-extensions-error) ( required-extensions -- )
+    gl-extensions swap seq-diff
+    "Required OpenGL extensions not supported:\n" %
+    [ "    " % % "\n" % ] each ;
+: require-gl-extensions ( extensions -- )
+    [ has-gl-extensions? ]
+    [ (make-gl-extensions-error) ]
+    (require-gl) ;
+
+: version-seq ( version-string -- version-seq )
+    "." split [ string>number ] map ;
+
+: version<=> ( version1 version2 -- n )
+    swap version-seq swap version-seq <=> ;
+
+: (gl-version) ( -- version vendor )
+    GL_VERSION glGetString " " split1 ;
+: gl-version ( -- version )
+    (gl-version) drop ;
+: gl-vendor-version ( -- version )
+    (gl-version) nip ;
+: has-gl-version? ( version -- ? )
+    gl-version version<=> 0 <= ;
+: (make-gl-version-error) ( required-version -- )
+    "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
+: require-gl-version ( version -- )
+    [ has-gl-version? ]
+    [ (make-gl-version-error) ]
+    (require-gl) ;
+
+: (glsl-version) ( -- version vendor )
+    GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
+: glsl-version ( -- version )
+    (glsl-version) drop ;
+: glsl-vendor-version ( -- version )
+    (glsl-version) nip ;
+: has-glsl-version? ( version -- ? )
+    glsl-version version<=> 0 <= ;
+: require-glsl-version ( version -- )
+    [ has-glsl-version? ]
+    [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
+    (require-gl) ;
+
+: require-gl-version-or-extensions ( version extensions -- )
+    2array [ first2 has-gl-extensions? swap has-gl-version? or ]
+    [ dup first (make-gl-version-error) "\n" %
+      second (make-gl-extensions-error) "\n" % ]
+    (require-gl) ;