! Copyright (C) 2005, 2007 Slava Pestov.
! Portions copyright (C) 2007 Eduardo Cavazos.
+! Portions copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
- USING: alien alien.c-types byte-arrays kernel libc math
- namespaces sequences math.vectors math.constants math.functions
- opengl.gl opengl.glu combinators arrays ;
+ 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 ;
IN: opengl
: coordinates [ first2 ] 2apply ;
GL_ATTACHED_SHADERS gl-program-get-int ; inline
: gl-program-shaders ( program -- shaders )
- dup gl-program-shaders-length
- [ dup "GLuint" <c-array> [ 0 <int> swap glGetAttachedShaders ] keep ] keep
- c-uint-array> ;
+ dup gl-program-shaders-length [
+ dup "GLuint" <c-array> 0 <int> over glGetAttachedShaders
+ ] keep c-uint-array> ;
-: delete-gl-program-only ( program -- ) glDeleteProgram ; inline
+: delete-gl-program-only ( program -- )
+ glDeleteProgram ; inline
-: detach-gl-program-shader ( program shader -- ) glDetachShader ; inline
+: detach-gl-program-shader ( program shader -- )
+ glDetachShader ; inline
: delete-gl-program ( program -- )
- dup gl-program-shaders [ 2dup detach-gl-program-shader delete-gl-shader ] each
- delete-gl-program-only ;
+ dup gl-program-shaders [
+ 2dup detach-gl-program-shader delete-gl-shader
+ ] each 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?) ;
+
+ : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
+ >r <vertex-shader> check-gl-shader
+ r> <fragment-shader> check-gl-shader
+ 2array <gl-program> check-gl-program ;
+
+ : (require-gl) ( thing require-quot make-error-quot -- )
+ >r dupd call
+ [ r> 2drop ]
+ [ r> " " make throw ]
+ if ; inline
+
+ : gl-extensions ( -- seq )
+ GL_EXTENSIONS glGetString " " split ;
+ : has-gl-extensions? ( extensions -- ? )
+ gl-extensions subseq? ;
+ : (make-gl-extensions-error) ( required-extensions -- )
+ gl-extensions swap seq-diff
+ "Required OpenGL extensions not supported:\n" %
+ [ " " % % "\n" % ] each ;
+ : require-gl-extensions ( extensions -- )
+ [ has-gl-extensions? ]
+ [ (make-gl-extensions-error) ]
+ (require-gl) ;
+
+ : version-seq ( version-string -- version-seq )
+ "." split [ string>number ] map ;
+
+ : version<=> ( version1 version2 -- n )
+ swap version-seq swap version-seq <=> ;
+
+ : (gl-version) ( -- version vendor )
+ GL_VERSION glGetString " " split1 ;
+ : gl-version ( -- version )
+ (gl-version) drop ;
+ : gl-vendor-version ( -- version )
+ (gl-version) nip ;
+ : has-gl-version? ( version -- ? )
+ gl-version version<=> 0 <= ;
+ : (make-gl-version-error) ( required-version -- )
+ "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
+ : require-gl-version ( version -- )
+ [ has-gl-version? ]
+ [ (make-gl-version-error) ]
+ (require-gl) ;
+
+ : (glsl-version) ( -- version vendor )
+ GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
+ : glsl-version ( -- version )
+ (glsl-version) drop ;
+ : glsl-vendor-version ( -- version )
+ (glsl-version) nip ;
+ : has-glsl-version? ( version -- ? )
+ glsl-version version<=> 0 <= ;
+ : require-glsl-version ( version -- )
+ [ has-glsl-version? ]
+ [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
+ (require-gl) ;
+
+ : 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) ;