From 3a0540555ec05c3b44733813e5d8b986db49852b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 24 Jan 2008 22:16:36 -0800 Subject: [PATCH] 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 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 + 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 check-gl-shader - cel-shading-fragment-shader-source check-gl-shader - 2array check-gl-program ; + cel-shading-vertex-shader-source cel-shading-fragment-shader-source + ; 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" 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 ) + 0.0 0.0 0.375 + 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 + ; +: (line-art-step2-program) ( -- step2 ) + line-art-step2-vertex-shader-source line-art-step2-fragment-shader-source + ; + +: (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" 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 ; + +: ( 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 r> keep *uint ; inline : gen-texture ( -- id ) - 1 0 [ 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 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 [ 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 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?) ; + +: ( vertex-shader-source fragment-shader-source -- program ) + >r check-gl-shader + r> check-gl-shader + 2array check-gl-program ; +