]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorSlava Pestov <slava@factorcode.org>
Mon, 28 Jan 2008 05:17:48 +0000 (23:17 -0600)
committerSlava Pestov <slava@factorcode.org>
Mon, 28 Jan 2008 05:17:48 +0000 (23:17 -0600)
1  2 
extra/combinators/lib/lib.factor
extra/opengl/opengl.factor

Simple merge
index 3fffa1531881b52a13e7614bc6ccbbeb8fb4e78b,2f3b87827a055d45023d4bc29626af2c9b2aed8d..656c514cd12c58fb15349e3feba99886135a73b5
mode 100755,100644..100755
@@@ -1,10 -1,9 +1,10 @@@
  ! 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 ;
@@@ -278,22 -329,83 +341,86 @@@ PREDICATE: gl-shader fragment-shader (f
      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) ;