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.strings libc opengl math sequences combinators
5 combinators.lib macros arrays io.encodings.ascii fry ;
8 : with-gl-shader-source-ptr ( string quot -- )
9 swap ascii malloc-string [ <void*> swap call ] keep free ; inline
11 : <gl-shader> ( source kind -- shader )
12 glCreateShader dup rot
13 [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
14 [ glCompileShader ] keep
17 : (gl-shader?) ( object -- ? )
18 dup integer? [ glIsShader c-bool> ] [ drop f ] if ;
20 : gl-shader-get-int ( shader enum -- value )
21 0 <int> [ glGetShaderiv ] keep *int ;
23 : gl-shader-ok? ( shader -- ? )
24 GL_COMPILE_STATUS gl-shader-get-int c-bool> ;
26 : <vertex-shader> ( source -- vertex-shader )
27 GL_VERTEX_SHADER <gl-shader> ; inline
29 : (vertex-shader?) ( object -- ? )
31 [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
34 : <fragment-shader> ( source -- fragment-shader )
35 GL_FRAGMENT_SHADER <gl-shader> ; inline
37 : (fragment-shader?) ( object -- ? )
39 [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
42 : gl-shader-info-log-length ( shader -- log-length )
43 GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
45 : gl-shader-info-log ( shader -- log )
46 dup gl-shader-info-log-length dup [
47 [ 0 <int> swap glGetShaderInfoLog ] keep
51 : check-gl-shader ( shader -- shader )
52 dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
54 : delete-gl-shader ( shader -- ) glDeleteShader ; inline
56 PREDICATE: gl-shader < integer (gl-shader?) ;
57 PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
58 PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
62 : <gl-program> ( shaders -- program )
64 [ dupd glAttachShader ] each
65 [ glLinkProgram ] keep
68 : (gl-program?) ( object -- ? )
69 dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
71 : gl-program-get-int ( program enum -- value )
72 0 <int> [ glGetProgramiv ] keep *int ;
74 : gl-program-ok? ( program -- ? )
75 GL_LINK_STATUS gl-program-get-int c-bool> ;
77 : gl-program-info-log-length ( program -- log-length )
78 GL_INFO_LOG_LENGTH gl-program-get-int ; inline
80 : gl-program-info-log ( program -- log )
81 dup gl-program-info-log-length dup [
82 [ 0 <int> swap glGetProgramInfoLog ] keep
86 : check-gl-program ( program -- program )
87 dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
89 : gl-program-shaders-length ( program -- shaders-length )
90 GL_ATTACHED_SHADERS gl-program-get-int ; inline
92 : gl-program-shaders ( program -- shaders )
93 dup gl-program-shaders-length
94 dup "GLuint" <c-array>
96 [ glGetAttachedShaders ] { 3 1 } multikeep
99 : delete-gl-program-only ( program -- )
100 glDeleteProgram ; inline
102 : detach-gl-program-shader ( program shader -- )
103 glDetachShader ; inline
105 : delete-gl-program ( program -- )
106 dup gl-program-shaders [
107 2dup detach-gl-program-shader delete-gl-shader
108 ] each delete-gl-program-only ;
110 : with-gl-program ( program quot -- )
111 over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
113 PREDICATE: gl-program < integer (gl-program?) ;
115 : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
116 >r <vertex-shader> check-gl-shader
117 r> <fragment-shader> check-gl-shader
118 2array <gl-program> check-gl-program ;