basis/opengl/capabilities/capabilities.factor

   1 ! Copyright (C) 2008 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces make sequences splitting opengl.gl
   4 continuations math.parser math arrays sets strings math.order fry ;
   5 IN: opengl.capabilities
   6
   7 : (require-gl) ( thing require-quot make-error-quot -- )
   8     [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
   9
  10 : (has-extension?) ( query-extension(s) available-extensions -- ? )
  11     over string?  [ member? ] [ [ member? ] curry any? ] if ;
  12
  13 : gl-extensions ( -- seq )
  14     GL_EXTENSIONS glGetString " " split ;
  15 : has-gl-extensions? ( extensions -- ? )
  16     gl-extensions [ (has-extension?) ] curry all? ;
  17 : (make-gl-extensions-error) ( required-extensions -- )
  18     gl-extensions diff
  19     "Required OpenGL extensions not supported:\n" %
  20     [ "    " % % "\n" % ] each ;
  21 : require-gl-extensions ( extensions -- )
  22     [ has-gl-extensions? ]
  23     [ (make-gl-extensions-error) ]
  24     (require-gl) ;
  25
  26 : version-seq ( version-string -- version-seq )
  27     "." split [ string>number ] map ;
  28
  29 : version-before? ( version1 version2 -- ? )
  30     swap version-seq swap version-seq before=? ;
  31
  32 : (gl-version) ( -- version vendor )
  33     GL_VERSION glGetString " " split1 ;
  34 : gl-version ( -- version )
  35     (gl-version) drop ;
  36 : gl-vendor-version ( -- version )
  37     (gl-version) nip ;
  38 : gl-vendor ( -- name )
  39     GL_VENDOR glGetString ;
  40 : has-gl-version? ( version -- ? )
  41     gl-version version-before? ;
  42 : (make-gl-version-error) ( required-version -- )
  43     "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
  44 : require-gl-version ( version -- )
  45     [ has-gl-version? ]
  46     [ (make-gl-version-error) ]
  47     (require-gl) ;
  48
  49 : (glsl-version) ( -- version vendor )
  50     GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
  51 : glsl-version ( -- version )
  52     (glsl-version) drop ;
  53 : glsl-vendor-version ( -- version )
  54     (glsl-version) nip ;
  55 : has-glsl-version? ( version -- ? )
  56     glsl-version version-before? ;
  57 : require-glsl-version ( version -- )
  58     [ has-glsl-version? ]
  59     [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
  60     (require-gl) ;
  61
  62 : has-gl-version-or-extensions? ( version extensions -- ? )
  63     has-gl-extensions? swap has-gl-version? or ;
  64
  65 : require-gl-version-or-extensions ( version extensions -- )
  66     2array [ first2 has-gl-version-or-extensions? ] [
  67         dup first (make-gl-version-error) "\n" %
  68         second (make-gl-extensions-error) "\n" %
  69     ] (require-gl) ;