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 alien.data alien.strings libc opengl math sequences combinators
5 macros arrays io.encodings.ascii fry specialized-arrays
6 destructors accessors ;
7 SPECIALIZED-ARRAY: uint
10 : with-gl-shader-source-ptr ( string quot -- )
11 swap ascii malloc-string [ <void*> swap call ] keep free ; inline
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 [
50 [ 0 <int> swap glGetShaderInfoLog ] keep
54 : check-gl-shader ( shader -- shader )
55 dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
57 : delete-gl-shader ( shader -- ) glDeleteShader ; inline
59 PREDICATE: gl-shader < integer (gl-shader?) ;
60 PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
61 PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
65 : (gl-program) ( shaders quot: ( gl-program -- ) -- program )
68 [ swap [ glAttachShader ] with each ]
69 [ swap call ] bi-curry bi*
70 ] [ glLinkProgram ] [ ] tri gl-error ; inline
72 : <mrt-gl-program> ( shaders frag-data-locations -- program )
73 [ [ first2 swap glBindFragDataLocation ] with each ] curry (gl-program) ;
75 : <gl-program> ( shaders -- program )
76 [ drop ] (gl-program) ;
78 : (gl-program?) ( object -- ? )
79 dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
81 : gl-program-get-int ( program enum -- value )
82 0 <int> [ glGetProgramiv ] keep *int ;
84 : gl-program-ok? ( program -- ? )
85 GL_LINK_STATUS gl-program-get-int c-bool> ;
87 : gl-program-info-log-length ( program -- log-length )
88 GL_INFO_LOG_LENGTH gl-program-get-int ; inline
90 : gl-program-info-log ( program -- log )
91 dup gl-program-info-log-length dup [
93 [ 0 <int> swap glGetProgramInfoLog ] keep
97 : check-gl-program ( program -- program )
98 dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
100 : gl-program-shaders-length ( program -- shaders-length )
101 GL_ATTACHED_SHADERS gl-program-get-int ; inline
103 ! On some macosx-x86-64 graphics drivers, glGetAttachedShaders tries to treat the
104 ! shaders parameter as a ulonglong array rather than a GLuint array as documented.
105 ! We hack around this by allocating a buffer twice the size and sifting out the zero
108 : gl-program-shaders ( program -- shaders )
109 dup gl-program-shaders-length 2 *
112 [ glGetAttachedShaders ] keep [ zero? not ] filter ;
114 : delete-gl-program-only ( program -- )
115 glDeleteProgram ; inline
117 : detach-gl-program-shader ( program shader -- )
118 glDetachShader ; inline
120 : delete-gl-program ( program -- )
121 dup gl-program-shaders [
122 2dup detach-gl-program-shader delete-gl-shader
123 ] each delete-gl-program-only ;
125 : with-gl-program ( program quot -- )
126 over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
128 PREDICATE: gl-program < integer (gl-program?) ;
130 : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
131 [ <vertex-shader> check-gl-shader ]
132 [ <fragment-shader> check-gl-shader ] bi*
133 2array <gl-program> check-gl-program ;