1 ! Copyright (C) 2008 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel opengl.gl alien.c-types continuations namespaces
4 assocs alien libc opengl math sequences combinators.lib
8 : with-gl-shader-source-ptr ( string quot -- )
9 swap string>char-alien malloc-byte-array [
13 : <gl-shader> ( source kind -- shader )
14 glCreateShader dup rot
15 [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
16 [ glCompileShader ] keep
19 : (gl-shader?) ( object -- ? )
20 dup integer? [ glIsShader c-bool> ] [ drop f ] if ;
22 : gl-shader-get-int ( shader enum -- value )
23 0 <int> [ glGetShaderiv ] keep *int ;
25 : gl-shader-ok? ( shader -- ? )
26 GL_COMPILE_STATUS gl-shader-get-int c-bool> ;
28 : <vertex-shader> ( source -- vertex-shader )
29 GL_VERTEX_SHADER <gl-shader> ; inline
31 : (vertex-shader?) ( object -- ? )
33 [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
36 : <fragment-shader> ( source -- fragment-shader )
37 GL_FRAGMENT_SHADER <gl-shader> ; inline
39 : (fragment-shader?) ( object -- ? )
41 [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
44 : gl-shader-info-log-length ( shader -- log-length )
45 GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
47 : gl-shader-info-log ( shader -- log )
48 dup gl-shader-info-log-length dup [
49 [ 0 <int> swap glGetShaderInfoLog ] keep
53 : check-gl-shader ( shader -- shader* )
54 dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
56 : delete-gl-shader ( shader -- ) glDeleteShader ; inline
58 PREDICATE: integer gl-shader (gl-shader?) ;
59 PREDICATE: gl-shader vertex-shader (vertex-shader?) ;
60 PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
64 : <gl-program> ( shaders -- program )
66 [ dupd glAttachShader ] each
67 [ glLinkProgram ] keep
70 : (gl-program?) ( object -- ? )
71 dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
73 : gl-program-get-int ( program enum -- value )
74 0 <int> [ glGetProgramiv ] keep *int ;
76 : gl-program-ok? ( program -- ? )
77 GL_LINK_STATUS gl-program-get-int c-bool> ;
79 : gl-program-info-log-length ( program -- log-length )
80 GL_INFO_LOG_LENGTH gl-program-get-int ; inline
82 : gl-program-info-log ( program -- log )
83 dup gl-program-info-log-length dup [
84 [ 0 <int> swap glGetProgramInfoLog ] keep
88 : check-gl-program ( program -- program* )
89 dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
91 : gl-program-shaders-length ( program -- shaders-length )
92 GL_ATTACHED_SHADERS gl-program-get-int ; inline
94 : gl-program-shaders ( program -- shaders )
95 dup gl-program-shaders-length
96 dup "GLuint" <c-array>
98 [ glGetAttachedShaders ] { 3 1 } multikeep
101 : delete-gl-program-only ( program -- )
102 glDeleteProgram ; inline
104 : detach-gl-program-shader ( program shader -- )
105 glDetachShader ; inline
107 : delete-gl-program ( program -- )
108 dup gl-program-shaders [
109 2dup detach-gl-program-shader delete-gl-shader
110 ] each delete-gl-program-only ;
112 : (with-gl-program) ( program quot -- )
113 swap glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
115 : (with-gl-program-uniforms) ( uniforms -- quot )
116 [ [ swap , \ glGetUniformLocation , % ] [ ] make ]
118 : (make-with-gl-program) ( uniforms quot -- q )
121 [ swap (with-gl-program-uniforms) , \ call-with , % ]
123 \ (with-gl-program) ,
126 MACRO: with-gl-program ( uniforms quot -- )
127 (make-with-gl-program) ;
129 PREDICATE: integer gl-program (gl-program?) ;
131 : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
132 >r <vertex-shader> check-gl-shader
133 r> <fragment-shader> check-gl-shader
134 2array <gl-program> check-gl-program ;