diff --git a/core/alien/c-types/c-types-docs.factor b/core/alien/c-types/c-types-docs.factor index f6418295f7..f4aa297a3a 100755 --- a/core/alien/c-types/c-types-docs.factor +++ b/core/alien/c-types/c-types-docs.factor @@ -34,6 +34,10 @@ HELP: stack-size { $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." } { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; +HELP: byte-length +{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } } +{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ; + HELP: c-getter { $values { "name" string } { "quot" "a quotation with stack effect " { $snippet "( c-ptr n -- obj )" } } } { $description "Outputs a quotation which reads values of this C type from a C structure." } diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 88df823e5b..8ab703eb7e 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays arrays generator.registers assocs +USING: byte-arrays float-arrays arrays generator.registers assocs kernel kernel.private libc math namespaces parser sequences strings words assocs splitting math.parser cpu.architecture alien alien.accessors quotations system compiler.units ; @@ -107,6 +107,12 @@ M: string stack-size c-type stack-size ; M: c-type stack-size c-type-size ; +GENERIC: byte-length ( seq -- n ) flushable + +M: float-array byte-length length "double" heap-size * ; + +M: byte-array byte-length length ; + : c-getter ( name -- quot ) c-type c-type-getter [ [ "Cannot read struct fields with type" throw ] diff --git a/core/float-arrays/float-arrays-docs.factor b/core/float-arrays/float-arrays-docs.factor index 70bbfe296f..cb36aade6b 100644 --- a/core/float-arrays/float-arrays-docs.factor +++ b/core/float-arrays/float-arrays-docs.factor @@ -32,7 +32,7 @@ HELP: ( n initial -- float-array ) HELP: >float-array { $values { "seq" "a sequence" } { "float-array" float-array } } -{ $description "Outputs a freshly-allocated float array whose elements have the same boolean values as a given sequence." } +{ $description "Outputs a freshly-allocated float array whose elements have the same floating-point values as a given sequence." } { $errors "Throws an error if the sequence contains elements other than real numbers." } ; HELP: 1float-array diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index 550eb50e0a..38f8e32fb6 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -1,112 +1,69 @@ -! From http://www.ffconsultancy.com/ocaml/bunny/index.html USING: alien alien.c-types arrays sequences math math.vectors math.matrices math.parser io io.files kernel opengl opengl.gl opengl.glu shuffle http.client vectors timers namespaces ui.gadgets ui.gadgets.canvas ui.render ui splitting -combinators tools.time system combinators.lib ; +combinators tools.time system combinators.lib combinators.cleave +float-arrays continuations opengl.demo-support multiline +ui.gestures +bunny.fixed-pipeline bunny.cel-shaded bunny.outlined bunny.model ; IN: bunny -: numbers ( str -- seq ) - " " split [ string>number ] map [ ] subset ; +TUPLE: bunny-gadget model geom draw-seq draw-n ; -: (parse-model) ( vs is -- vs is ) - readln [ - numbers { - { [ dup length 5 = ] [ 3 head pick push ] } - { [ dup first 3 = ] [ 1 tail over push ] } - { [ t ] [ drop ] } - } cond (parse-model) - ] when* ; +: ( -- bunny-gadget ) + 0.0 0.0 0.375 + maybe-download read-model { + set-delegate + set-bunny-gadget-model + } bunny-gadget construct ; -: parse-model ( stream -- vs is ) - [ - 100000 100000 (parse-model) - ] with-stream - [ - over length # " vertices, " % - dup length # " triangles" % - ] "" make print ; +: bunny-gadget-draw ( gadget -- draw ) + { bunny-gadget-draw-n bunny-gadget-draw-seq } + get-slots nth ; -: n ( vs triple -- n ) - swap [ nth ] curry map - dup third over first v- >r dup second swap first v- r> cross - vneg normalize ; +: bunny-gadget-next-draw ( gadget -- ) + dup { bunny-gadget-draw-seq bunny-gadget-draw-n } + get-slots + 1+ swap length mod + swap [ set-bunny-gadget-draw-n ] keep relayout-1 ; -: normal ( ns vs triple -- ) - [ n ] keep [ rot [ v+ ] change-nth ] each-with2 ; - -: normals ( vs is -- ns ) - over length { 0.0 0.0 0.0 } -rot - [ >r 2dup r> normal ] each drop - [ normalize ] map ; - -: read-model ( stream -- model ) - "Reading model" print flush [ - parse-model [ normals ] 2keep 3array - ] time ; - -: model-path "bun_zipper.ply" ; - -: model-url "http://factorcode.org/bun_zipper.ply" ; - -: maybe-download ( -- path ) - model-path resource-path dup exists? [ - "Downloading bunny from " write - model-url dup print flush - over download-to - ] unless ; - -: draw-triangle ( ns vs triple -- ) - [ dup roll nth gl-normal swap nth gl-vertex ] each-with2 ; - -: draw-bunny ( ns vs is -- ) - GL_TRIANGLES [ [ draw-triangle ] each-with2 ] do-state ; - -TUPLE: bunny-gadget model ; - -: ( model -- gadget ) - - { set-bunny-gadget-model set-delegate } - bunny-gadget construct ; - -M: bunny-gadget graft* 10 10 add-timer ; - -M: bunny-gadget ungraft* dup delegate ungraft* remove-timer ; - -M: bunny-gadget tick relayout-1 ; - -: aspect ( gadget -- x ) rect-dim first2 /f ; - -M: bunny-gadget draw-gadget* +M: bunny-gadget graft* ( gadget -- ) GL_DEPTH_TEST glEnable - GL_SCISSOR_TEST glDisable - 1.0 glClearDepth - 0.0 0.0 0.0 1.0 glClearColor - GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear - GL_PROJECTION glMatrixMode - glLoadIdentity - 45.0 over aspect 0.1 1.0 gluPerspective - 0.0 0.12 -0.25 0.0 0.1 0.0 0.0 1.0 0.0 gluLookAt - GL_MODELVIEW glMatrixMode - glLoadIdentity - GL_LEQUAL glDepthFunc - GL_LIGHTING glEnable - GL_LIGHT0 glEnable - GL_COLOR_MATERIAL glEnable - GL_LIGHT0 GL_POSITION { 1.0 -1.0 1.0 1.0 } >c-float-array glLightfv - millis 24000 mod 0.015 * 0.0 1.0 0.0 glRotated - GL_FRONT_AND_BACK GL_SHININESS 100.0 glMaterialf - GL_FRONT_AND_BACK GL_SPECULAR glColorMaterial - GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glColorMaterial - 0.6 0.5 0.5 1.0 glColor4d - [ bunny-gadget-model first3 draw-bunny ] draw-canvas ; + dup bunny-gadget-model + over { + [ ] + [ ] + [ ] + } map-call-with [ ] subset + 0 + roll { + set-bunny-gadget-geom + set-bunny-gadget-draw-seq + set-bunny-gadget-draw-n + } set-slots ; -M: bunny-gadget pref-dim* drop { 400 300 } ; +M: bunny-gadget ungraft* ( gadget -- ) + { bunny-gadget-geom bunny-gadget-draw-seq } get-slots + [ [ dispose ] when* ] each + [ dispose ] when* ; + +M: bunny-gadget draw-gadget* ( gadget -- ) + 0.15 0.15 0.15 1.0 glClearColor + GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear + dup demo-gadget-set-matrices + GL_MODELVIEW glMatrixMode + 0.0 -0.12 0.0 glTranslatef + { bunny-gadget-geom bunny-gadget-draw } get-slots + draw-bunny ; + +M: bunny-gadget pref-dim* ( gadget -- dim ) + drop { 640 480 } ; + +bunny-gadget H{ + { T{ key-down f f "TAB" } [ bunny-gadget-next-draw ] } +} set-gestures : bunny-window ( -- ) - [ - maybe-download read-model - "Bunny" open-window - ] with-ui ; + [ "Bunny" open-window ] with-ui ; MAIN: bunny-window diff --git a/extra/bunny/cel-shaded/cel-shaded.factor b/extra/bunny/cel-shaded/cel-shaded.factor new file mode 100644 index 0000000000..fc42ca971e --- /dev/null +++ b/extra/bunny/cel-shaded/cel-shaded.factor @@ -0,0 +1,92 @@ +USING: arrays bunny.model combinators.lib continuations +kernel multiline opengl opengl.gl sequences ; +IN: bunny.cel-shaded + +STRING: vertex-shader-source +varying vec3 position, normal, viewer; + +void +main() +{ + gl_Position = ftransform(); + + position = gl_Vertex.xyz; + normal = gl_Normal; + viewer = vec3(0, 0, 1) * gl_NormalMatrix; +} + +; + +STRING: cel-shaded-fragment-shader-lib-source +varying vec3 position, normal, viewer; +uniform vec3 light_direction; +uniform vec4 color; +uniform vec4 ambient, diffuse; +uniform float shininess; + +float +modulate(vec3 direction, vec3 normal) +{ + return dot(direction, normal) * 0.5 + 0.5; +} + +float +cel(float m) +{ + return smoothstep(0.25, 0.255, m) * 0.4 + smoothstep(0.695, 0.70, m) * 0.5; +} + +vec4 +cel_light() +{ + vec3 direction = normalize(light_direction - position); + vec3 reflection = reflect(direction, normal); + vec4 ad = (ambient + diffuse * vec4(vec3(cel(modulate(direction, normal))), 1)); + float s = cel(pow(max(dot(-reflection, viewer), 0.0), shininess)); + return ad * color + vec4(vec3(s), 0); +} + +; + +STRING: cel-shaded-fragment-shader-main-source +vec4 cel_light(); + +void +main() +{ + gl_FragColor = cel_light(); +} + +; + +TUPLE: bunny-cel-shaded program ; + +: cel-shading-supported? ( -- ? ) + "2.0" { "GL_ARB_shader_objects" } + has-gl-version-or-extensions? ; + +: ( gadget -- draw ) + drop + cel-shading-supported? [ + vertex-shader-source check-gl-shader + cel-shaded-fragment-shader-lib-source check-gl-shader + cel-shaded-fragment-shader-main-source check-gl-shader + 3array check-gl-program + { set-bunny-cel-shaded-program } bunny-cel-shaded construct + ] [ f ] if ; + +: (draw-cel-shaded-bunny) ( geom program -- ) + { + { "light_direction" [ 1.0 -1.0 1.0 glUniform3f ] } + { "color" [ 0.6 0.5 0.5 1.0 glUniform4f ] } + { "ambient" [ 0.2 0.2 0.2 0.2 glUniform4f ] } + { "diffuse" [ 0.8 0.8 0.8 0.8 glUniform4f ] } + { "shininess" [ 100.0 glUniform1f ] } + } [ bunny-geom ] with-gl-program ; + +M: bunny-cel-shaded draw-bunny + bunny-cel-shaded-program (draw-cel-shaded-bunny) ; + +M: bunny-cel-shaded dispose + bunny-cel-shaded-program delete-gl-program ; + diff --git a/extra/bunny/fixed-pipeline/fixed-pipeline.factor b/extra/bunny/fixed-pipeline/fixed-pipeline.factor new file mode 100644 index 0000000000..f3fb68e515 --- /dev/null +++ b/extra/bunny/fixed-pipeline/fixed-pipeline.factor @@ -0,0 +1,25 @@ +USING: alien.c-types continuations kernel +opengl opengl.gl bunny.model ; +IN: bunny.fixed-pipeline + +TUPLE: bunny-fixed-pipeline ; + +: ( gadget -- draw ) + drop + { } bunny-fixed-pipeline construct ; + +M: bunny-fixed-pipeline draw-bunny + drop + GL_LIGHTING glEnable + GL_LIGHT0 glEnable + GL_COLOR_MATERIAL glEnable + GL_LIGHT0 GL_POSITION { 1.0 -1.0 1.0 1.0 } >c-float-array glLightfv + GL_FRONT_AND_BACK GL_SHININESS 100.0 glMaterialf + GL_FRONT_AND_BACK GL_SPECULAR glColorMaterial + GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glColorMaterial + 0.6 0.5 0.5 1.0 glColor4f + bunny-geom ; + +M: bunny-fixed-pipeline dispose + drop ; + diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor new file mode 100644 index 0000000000..e3df6bb26c --- /dev/null +++ b/extra/bunny/model/model.factor @@ -0,0 +1,113 @@ +USING: alien alien.c-types arrays sequences math +math.vectors math.matrices math.parser io io.files kernel opengl +opengl.gl opengl.glu shuffle http.client vectors splitting +tools.time system combinators combinators.lib combinators.cleave +float-arrays continuations namespaces ; +IN: bunny.model + +: numbers ( str -- seq ) + " " split [ string>number ] map [ ] subset ; + +: (parse-model) ( vs is -- vs is ) + readln [ + numbers { + { [ dup length 5 = ] [ 3 head pick push ] } + { [ dup first 3 = ] [ 1 tail over push ] } + { [ t ] [ drop ] } + } cond (parse-model) + ] when* ; + +: parse-model ( stream -- vs is ) + [ + 100000 100000 (parse-model) + ] with-stream + [ + over length # " vertices, " % + dup length # " triangles" % + ] "" make print ; + +: n ( vs triple -- n ) + swap [ nth ] curry map + dup third over first v- >r dup second swap first v- r> cross + vneg normalize ; + +: normal ( ns vs triple -- ) + [ n ] keep [ rot [ v+ ] change-nth ] each-with2 ; + +: normals ( vs is -- ns ) + over length { 0.0 0.0 0.0 } -rot + [ >r 2dup r> normal ] each drop + [ normalize ] map ; + +: read-model ( stream -- model ) + "Reading model" print flush [ + parse-model [ normals ] 2keep 3array + ] time ; + +: model-path "bun_zipper.ply" ; + +: model-url "http://factorcode.org/bun_zipper.ply" ; + +: maybe-download ( -- path ) + model-path resource-path dup exists? [ + "Downloading bunny from " write + model-url dup print flush + over download-to + ] unless ; + +: (draw-triangle) ( ns vs triple -- ) + [ dup roll nth gl-normal swap nth gl-vertex ] each-with2 ; + +: draw-triangles ( ns vs is -- ) + GL_TRIANGLES [ [ (draw-triangle) ] each-with2 ] do-state ; + +TUPLE: bunny-dlist list ; +TUPLE: bunny-buffers array element-array nv ni ; + +: ( model -- geom ) + GL_COMPILE [ first3 draw-triangles ] make-dlist + bunny-dlist construct-boa ; + +: ( model -- geom ) + [ + [ first concat ] [ second concat ] bi + append >float-array + GL_ARRAY_BUFFER swap GL_STATIC_DRAW + ] [ + third concat >c-uint-array + GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW + ] + [ first length 3 * ] [ third length 3 * ] tetra + bunny-buffers construct-boa ; + +GENERIC: bunny-geom ( geom -- ) +GENERIC: draw-bunny ( geom draw -- ) + +M: bunny-dlist bunny-geom + bunny-dlist-list glCallList ; + +M: bunny-buffers bunny-geom + dup { + bunny-buffers-array + bunny-buffers-element-array + } get-slots [ + GL_VERTEX_ARRAY GL_NORMAL_ARRAY 2array [ + GL_DOUBLE 0 0 buffer-offset glNormalPointer + dup bunny-buffers-nv "double" heap-size * buffer-offset + 3 GL_DOUBLE 0 roll glVertexPointer + bunny-buffers-ni + GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements + ] all-enabled-client-state + ] with-array-element-buffers ; + +M: bunny-dlist dispose + bunny-dlist-list delete-dlist ; + +M: bunny-buffers dispose + { bunny-buffers-array bunny-buffers-element-array } get-slots + delete-gl-buffer delete-gl-buffer ; + +: ( model -- geom ) + "1.5" { "GL_ARB_vertex_buffer_object" } + has-gl-version-or-extensions? + [ ] [ ] if ; diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor new file mode 100644 index 0000000000..9de341561c --- /dev/null +++ b/extra/bunny/outlined/outlined.factor @@ -0,0 +1,239 @@ +USING: arrays bunny.model bunny.cel-shaded +combinators.lib continuations kernel math multiline +opengl opengl.gl sequences ui.gadgets ; +IN: bunny.outlined + +STRING: outlined-pass1-fragment-shader-main-source +varying vec3 normal; +vec4 cel_light(); + +void +main() +{ + gl_FragData[0] = cel_light(); + gl_FragData[1] = vec4(normal, 1); +} + +; + +STRING: outlined-pass2-vertex-shader-source +varying vec2 coord; + +void +main() +{ + gl_Position = ftransform(); + coord = (gl_Vertex * vec4(0.5) + vec4(0.5)).xy; +} + +; + +STRING: outlined-pass2-fragment-shader-source +uniform sampler2D colormap, normalmap, depthmap; +uniform vec4 line_color; +varying vec2 coord; + +const float DEPTH_RATIO_THRESHOLD = 1.001, SAMPLE_SPREAD = 1.0/512.0; + +float +depth_sample(vec2 c) +{ + 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))); +} + +vec3 +normal_sample(vec2 c) +{ + 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); + + vec3 normal1 = normal_sample(coord1), + normal2 = normal_sample(coord2), + normal3 = normal_sample(coord3), + normal4 = normal_sample(coord4); + + if (dot(normal1, normal1) < 0.5 + && dot(normal2, normal2) < 0.5 + && dot(normal3, normal3) < 0.5 + && dot(normal4, normal4) < 0.5) { + return 0.0; + } else { + vec4 depths = vec4(depth_sample(coord1), + depth_sample(coord2), + depth_sample(coord3), + depth_sample(coord4)); + + vec3 ratios1 = depths.xxx/depths.yzw, ratios2 = depths.yyz/depths.zww; + + if (are_depths_border(ratios1) || are_depths_border(ratios2)) { + return 1.0; + } else { + 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 = mix(texture2D(colormap, coord), line_color, border_factor(coord)); +} + +; + +TUPLE: bunny-outlined + gadget + pass1-program pass2-program + color-texture normal-texture depth-texture + framebuffer framebuffer-dim ; + +: outlining-supported? ( -- ? ) + "2.0" { + "GL_ARB_shading_objects" + "GL_ARB_draw_buffers" + "GL_ARB_multitexture" + } has-gl-version-or-extensions? { + "GL_EXT_framebuffer_object" + "GL_ARB_texture_float" + } has-gl-extensions? and ; + +: pass1-program ( -- program ) + vertex-shader-source check-gl-shader + cel-shaded-fragment-shader-lib-source check-gl-shader + outlined-pass1-fragment-shader-main-source check-gl-shader + 3array check-gl-program ; + +: pass2-program ( -- program ) + outlined-pass2-vertex-shader-source + outlined-pass2-fragment-shader-source ; + +: ( gadget -- draw ) + outlining-supported? [ + pass1-program pass2-program { + set-bunny-outlined-gadget + set-bunny-outlined-pass1-program + set-bunny-outlined-pass2-program + } bunny-outlined construct + ] [ drop f ] if ; + +: (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 ; + +: (attach-framebuffer-texture) ( texture attachment -- ) + swap >r >r + GL_FRAMEBUFFER_EXT r> GL_TEXTURE_2D r> 0 glFramebufferTexture2DEXT + gl-error ; + +: (make-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 ; + +: dispose-framebuffer ( draw -- ) + dup bunny-outlined-framebuffer-dim [ + { + [ bunny-outlined-framebuffer [ delete-framebuffer ] when* ] + [ bunny-outlined-color-texture [ delete-texture ] when* ] + [ bunny-outlined-normal-texture [ delete-texture ] when* ] + [ bunny-outlined-depth-texture [ delete-texture ] when* ] + [ f swap set-bunny-outlined-framebuffer-dim ] + } call-with + ] [ drop ] if ; + +: remake-framebuffer-if-needed ( draw -- ) + dup bunny-outlined-gadget rect-dim + over bunny-outlined-framebuffer-dim + over = + [ 2drop ] + [ + swap dup dispose-framebuffer >r + dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) + swap dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) + swap dup GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (framebuffer-texture) + swap >r + [ (make-framebuffer) ] 3keep + r> r> { + set-bunny-outlined-framebuffer + set-bunny-outlined-color-texture + set-bunny-outlined-normal-texture + set-bunny-outlined-depth-texture + set-bunny-outlined-framebuffer-dim + } set-slots + ] if ; + +: clear-framebuffer ( -- ) + GL_COLOR_ATTACHMENT0_EXT glDrawBuffer + 0.15 0.15 0.15 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 ; + +: (pass1) ( geom draw -- ) + dup bunny-outlined-framebuffer [ + clear-framebuffer + { GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT } set-draw-buffers + bunny-outlined-pass1-program (draw-cel-shaded-bunny) + ] with-framebuffer ; + +: (pass2) ( draw -- ) + init-matrices + dup bunny-outlined-color-texture GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit + dup bunny-outlined-normal-texture GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit + dup bunny-outlined-depth-texture GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit + bunny-outlined-pass2-program { + { "colormap" [ 0 glUniform1i ] } + { "normalmap" [ 1 glUniform1i ] } + { "depthmap" [ 2 glUniform1i ] } + { "line_color" [ 0.1 0.0 0.1 1.0 glUniform4f ] } + } [ { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ] with-gl-program ; + +M: bunny-outlined draw-bunny + dup remake-framebuffer-if-needed + [ (pass1) ] keep (pass2) ; + +M: bunny-outlined dispose + { + [ bunny-outlined-pass1-program [ delete-gl-program ] when* ] + [ bunny-outlined-pass2-program [ delete-gl-program ] when* ] + [ dispose-framebuffer ] + } call-with ; diff --git a/extra/cel-shading/cel-shading.factor b/extra/cel-shading/cel-shading.factor deleted file mode 100644 index 64d23275e9..0000000000 --- a/extra/cel-shading/cel-shading.factor +++ /dev/null @@ -1,89 +0,0 @@ -USING: arrays bunny combinators.lib io io.files kernel - math math.functions multiline continuations debugger - opengl opengl.gl opengl-demo-support - sequences ui ui.gadgets ui.render ; -IN: cel-shading - -TUPLE: cel-shading-gadget model program ; - -: ( -- cel-shading-gadget ) - 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; - -void -main() -{ - gl_Position = ftransform(); - - position = gl_Vertex.xyz; - normal = gl_Normal; -} - -; - -STRING: cel-shading-fragment-shader-source -varying vec3 position, normal; -uniform vec3 light_direction; -uniform vec4 color; -uniform vec4 ambient, diffuse; - -float -smooth_modulate(vec3 direction, vec3 normal) -{ - return clamp(dot(direction, normal), 0.0, 1.0); -} - -float -modulate(vec3 direction, vec3 normal) -{ - float m = smooth_modulate(direction, normal); - return smoothstep(0.0, 0.01, m) * 0.4 + smoothstep(0.49, 0.5, m) * 0.5; -} - -void -main() -{ - vec3 direction = normalize(light_direction - position); - gl_FragColor = ambient + diffuse * color * vec4(vec3(modulate(direction, normal)), 1); -} - -; - -: cel-shading-program ( -- program ) - cel-shading-vertex-shader-source cel-shading-fragment-shader-source - ; - -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 - cel-shading-program swap set-cel-shading-gadget-program ] [ ] [ :c ] cleanup ; - -M: cel-shading-gadget ungraft* ( gadget -- ) - cel-shading-gadget-program [ delete-gl-program ] when* ; - -: cel-shading-draw-setup ( gadget -- gadget ) - [ 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 [ - cel-shading-draw-setup - 0.0 -0.12 0.0 glTranslatef - cel-shading-gadget-model first3 draw-bunny - ] with-gl-program ; - -: cel-shading-window ( -- ) - [ "Cel Shading" open-window ] with-ui ; - -MAIN: cel-shading-window diff --git a/extra/cocoa/views/views.factor b/extra/cocoa/views/views.factor index cc948df55f..7b8de9067c 100644 --- a/extra/cocoa/views/views.factor +++ b/extra/cocoa/views/views.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types arrays kernel math namespaces cocoa -cocoa.messages cocoa.classes cocoa.types sequences ; +cocoa.messages cocoa.classes cocoa.types sequences +continuations ; IN: cocoa.views : NSOpenGLPFAAllRenderers 1 ; @@ -35,11 +36,23 @@ IN: cocoa.views : NSOpenGLPFAPixelBuffer 90 ; : NSOpenGLPFAVirtualScreenCount 128 ; + + +: with-software-renderer ( quot -- ) + t +software-renderer+ set + [ f +software-renderer+ set ] + [ ] cleanup ; inline + : ( -- pixelfmt ) NSOpenGLPixelFormat -> alloc [ NSOpenGLPFAWindow , NSOpenGLPFADoubleBuffer , NSOpenGLPFADepthSize , 16 , + +software-renderer+ get [ NSOpenGLPFARobust , ] when 0 , ] { } make >c-int-array -> initWithAttributes: diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor deleted file mode 100644 index 1a0ae6993f..0000000000 --- a/extra/line-art/line-art.factor +++ /dev/null @@ -1,255 +0,0 @@ -USING: arrays bunny combinators.lib continuations io io.files kernel - math math.functions math.vectors multiline - namespaces debugger - 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 ) - 40.0 -5.0 0.275 - 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 = 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; -} - -float -depth_sample(vec2 c) -{ - 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))); -} - -vec3 -normal_sample(vec2 c) -{ - 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); - - 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; - - 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 = mix(texture2D(colormap, coord), line_color, border_factor(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 -- ) - [ "2.0" { "GL_ARB_draw_buffers" - "GL_ARB_shader_objects" - "GL_ARB_multitexture" - "GL_ARB_texture_float" } - 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 - (line-art-step2-program) swap set-line-art-gadget-step2-program - ] [ ] [ :c ] cleanup ; - -M: line-art-gadget ungraft* ( gadget -- ) - dup line-art-gadget-framebuffer [ - { [ line-art-gadget-step1-program [ delete-gl-program ] when* ] - [ line-art-gadget-step2-program [ delete-gl-program ] when* ] - [ line-art-gadget-framebuffer [ delete-framebuffer ] when* ] - [ line-art-gadget-color-texture [ delete-texture ] when* ] - [ line-art-gadget-normal-texture [ delete-texture ] when* ] - [ line-art-gadget-depth-texture [ delete-texture ] when* ] - [ 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 } 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 ] - [ "line_color" glGetUniformLocation 0.2 0.0 0.0 1.0 glUniform4f ] } call-with - { -1.0 -1.0 } { 1.0 1.0 } rect-vertices - ] with-gl-program ; - -: line-art-window ( -- ) - [ "Line Art" open-window ] with-ui ; - -MAIN: line-art-window diff --git a/extra/opengl-demo-support/authors.txt b/extra/opengl/demo-support/authors.txt similarity index 100% rename from extra/opengl-demo-support/authors.txt rename to extra/opengl/demo-support/authors.txt diff --git a/extra/opengl-demo-support/opengl-demo-support.factor b/extra/opengl/demo-support/demo-support.factor similarity index 99% rename from extra/opengl-demo-support/opengl-demo-support.factor rename to extra/opengl/demo-support/demo-support.factor index ecc6458d41..59b7a3bcc3 100644 --- a/extra/opengl-demo-support/opengl-demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -1,6 +1,6 @@ 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 +IN: opengl.demo-support : NEAR-PLANE 1.0 64.0 / ; inline : FAR-PLANE 4.0 ; inline diff --git a/extra/opengl-demo-support/summary.txt b/extra/opengl/demo-support/summary.txt similarity index 100% rename from extra/opengl-demo-support/summary.txt rename to extra/opengl/demo-support/summary.txt diff --git a/extra/opengl-demo-support/tags.txt b/extra/opengl/demo-support/tags.txt similarity index 100% rename from extra/opengl-demo-support/tags.txt rename to extra/opengl/demo-support/tags.txt diff --git a/extra/opengl/opengl-docs.factor b/extra/opengl/opengl-docs.factor index cc8221baa1..cb0c9e884f 100644 --- a/extra/opengl/opengl-docs.factor +++ b/extra/opengl/opengl-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io kernel math quotations -opengl.gl ; +opengl.gl multiline assocs ; IN: opengl HELP: gl-color @@ -65,7 +65,7 @@ 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 +HELP: gen-gl-buffer { $values { "id" integer } } { $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ; @@ -81,14 +81,14 @@ 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 +HELP: delete-gl-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 +{ gen-gl-buffer delete-gl-buffer } related-words HELP: framebuffer-incomplete? { $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } } @@ -241,8 +241,19 @@ HELP: delete-gl-program { $description "Deletes the program object, invalidating it and releasing any resources allocated for it by the OpenGL implementation. Any attached " { $link gl-shader } "s are also deleted.\n\nIf the shader objects should be preserved, they should each be detached using " { $link detach-gl-program-shader } ". The program object can then be destroyed alone using " { $link delete-gl-program-only } "." } ; HELP: with-gl-program -{ $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation" } } -{ $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" } "." } ; +{ $values { "program" "A " { $link gl-program } " object" } { "uniforms" "An " { $link assoc } " between uniform parameter names and quotations with effect " { $snippet "( uniform-location -- )" } } { "quot" "A quotation" } } +{ $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" } ". Before calling " { $snippet "quot" } ", calls " { $link glGetUniformLocation } " on each key of " { $snippet "uniforms" } " to get the address of the uniform parameter, which is then placed on top of the stack for the associated quotation.\n\nExample:" } +{ $code <" +! From bunny.cel-shaded +: (draw-cel-shaded-bunny) ( geom program -- ) + { + { "light_direction" [ 1.0 -1.0 1.0 glUniform3f ] } + { "color" [ 0.6 0.5 0.5 1.0 glUniform4f ] } + { "ambient" [ 0.2 0.2 0.2 0.2 glUniform4f ] } + { "diffuse" [ 0.8 0.8 0.8 0.8 glUniform4f ] } + { "shininess" [ 100.0 glUniform1f ] } + } [ bunny-geom ] with-gl-program ; +"> } ; HELP: gl-version { $values { "version" "The version string from the OpenGL implementation" } } @@ -284,15 +295,19 @@ 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: has-gl-version-or-extensions? +{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } } +{ $description "Returns true if either " { $link has-gl-version? } " or " { $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." } ; + 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." } ; +{ $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 +{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? has-gl-version-or-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." diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 22bf657637..071f85fe12 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -5,7 +5,7 @@ USING: alien alien.c-types continuations kernel libc math macros namespaces math.vectors math.constants math.functions math.parser opengl.gl opengl.glu combinators arrays sequences -splitting words byte-arrays assocs ; +splitting words byte-arrays assocs combinators.lib ; IN: opengl : coordinates [ first2 ] 2apply ; @@ -30,6 +30,13 @@ IN: opengl : do-enabled ( what quot -- ) over glEnable dip glDisable ; inline +: do-enabled-client-state ( what quot -- ) + over glEnableClientState dip glDisableClientState ; inline + +: all-enabled ( seq quot -- ) + over [ glEnable ] each dip [ glDisable ] each ; inline +: all-enabled-client-state ( seq quot -- ) + over [ glEnableClientState ] each dip [ glDisableClientState ] each ; inline : do-matrix ( mode quot -- ) swap [ glMatrixMode glPushMatrix call ] keep @@ -103,7 +110,7 @@ IN: opengl [ glGenFramebuffersEXT ] (gen-gl-object) ; : gen-renderbuffer ( -- id ) [ glGenRenderbuffersEXT ] (gen-gl-object) ; -: gen-buffer ( -- id ) +: gen-gl-buffer ( -- id ) [ glGenBuffers ] (gen-gl-object) ; : (delete-gl-object) ( id quot -- ) @@ -114,9 +121,26 @@ IN: opengl [ glDeleteFramebuffersEXT ] (delete-gl-object) ; : delete-renderbuffer ( id -- ) [ glDeleteRenderbuffersEXT ] (delete-gl-object) ; -: delete-buffer ( id -- ) +: delete-gl-buffer ( id -- ) [ glDeleteBuffers ] (delete-gl-object) ; +: with-gl-buffer ( binding id quot -- ) + -rot dupd glBindBuffer + [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline + +: with-array-element-buffers ( array-buffer element-buffer quot -- ) + -rot GL_ELEMENT_ARRAY_BUFFER swap [ + swap GL_ARRAY_BUFFER -rot with-gl-buffer + ] with-gl-buffer ; inline + +: ( target data hint -- id ) + pick gen-gl-buffer [ [ + >r dup byte-length swap r> glBufferData + ] with-gl-buffer ] keep ; + +: buffer-offset ( int -- alien ) + ; inline + : framebuffer-incomplete? ( -- status/f ) GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ; @@ -256,7 +280,7 @@ TUPLE: sprite loc dim dim2 dlist texture ; : c-true? ( int -- ? ) zero? not ; inline : with-gl-shader-source-ptr ( string quot -- ) - swap >byte-array malloc-byte-array [ + swap string>char-alien malloc-byte-array [ swap call ] keep free ; inline @@ -295,9 +319,8 @@ TUPLE: sprite loc dim dim2 dlist texture ; GL_INFO_LOG_LENGTH gl-shader-get-int ; inline : gl-shader-info-log ( shader -- log ) - dup gl-shader-info-log-length - dup [ - 0 over glGetShaderInfoLog + dup gl-shader-info-log-length dup [ + [ 0 swap glGetShaderInfoLog ] keep alien>char-string ] with-malloc ; @@ -331,9 +354,10 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; GL_INFO_LOG_LENGTH gl-program-get-int ; inline : gl-program-info-log ( program -- log ) - dup gl-program-info-log-length - dup [ [ 0 swap glGetProgramInfoLog ] keep - alien>char-string ] with-malloc ; + dup gl-program-info-log-length dup [ + [ 0 swap glGetProgramInfoLog ] keep + alien>char-string + ] with-malloc ; : check-gl-program ( program -- program* ) dup gl-program-ok? [ dup gl-program-info-log throw ] unless ; @@ -343,7 +367,8 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; : gl-program-shaders ( program -- shaders ) dup gl-program-shaders-length [ - dup "GLuint" 0 over glGetAttachedShaders + dup "GLuint" + [ 0 swap glGetAttachedShaders ] keep ] keep c-uint-array> ; : delete-gl-program-only ( program -- ) @@ -357,9 +382,23 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; 2dup detach-gl-program-shader delete-gl-shader ] each delete-gl-program-only ; -: with-gl-program ( program quot -- ) +: (with-gl-program) ( program quot -- ) swap glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline +: (with-gl-program-uniforms) ( uniforms -- quot ) + [ [ swap , \ glGetUniformLocation , % ] [ ] make ] + { } assoc>map ; +: (make-with-gl-program) ( uniforms quot -- q ) + [ + \ dup , + [ swap (with-gl-program-uniforms) , \ call-with , % ] + [ ] make , + \ (with-gl-program) , + ] [ ] make ; + +MACRO: with-gl-program ( uniforms quot -- ) + (make-with-gl-program) ; + PREDICATE: integer gl-program (gl-program?) ; : ( vertex-shader-source fragment-shader-source -- program ) @@ -376,7 +415,7 @@ PREDICATE: integer gl-program (gl-program?) ; : gl-extensions ( -- seq ) GL_EXTENSIONS glGetString " " split ; : has-gl-extensions? ( extensions -- ? ) - gl-extensions subseq? ; + gl-extensions swap [ over member? ] all? nip ; : (make-gl-extensions-error) ( required-extensions -- ) gl-extensions swap seq-diff "Required OpenGL extensions not supported:\n" % @@ -420,8 +459,11 @@ PREDICATE: integer gl-program (gl-program?) ; [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ] (require-gl) ; +: has-gl-version-or-extensions? ( version extensions -- ? ) + has-gl-extensions? swap has-gl-version? or ; + : 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) ; + 2array [ first2 has-gl-version-or-extensions? ] [ + dup first (make-gl-version-error) "\n" % + second (make-gl-extensions-error) "\n" % + ] (require-gl) ; diff --git a/misc/Factor.tmbundle/Support/lib/tm_factor.rb b/misc/Factor.tmbundle/Support/lib/tm_factor.rb index 54272e5e36..2775a12ae9 100644 --- a/misc/Factor.tmbundle/Support/lib/tm_factor.rb +++ b/misc/Factor.tmbundle/Support/lib/tm_factor.rb @@ -33,6 +33,6 @@ def doc_using_statements(document) end def line_current_word(line, point) - left = line.rindex(/\s|^/, point - 1) + 1; right = line.index(/\s|$/, point) - 1 + left = line.rindex(/\s/, point - 1) || 0; right = line.index(/\s/, point) || line.length line[left..right] end