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 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 : gl-extensions ( -- seq )
  11     GL_EXTENSIONS glGetString " " split ;
  12 : has-gl-extensions? ( extensions -- ? )
  13     gl-extensions swap [ over member? ] all? nip ;
  14 : (make-gl-extensions-error) ( required-extensions -- )
  15     gl-extensions diff
  16     "Required OpenGL extensions not supported:\n" %
  17     [ "    " % % "\n" % ] each ;
  18 : require-gl-extensions ( extensions -- )
  19     [ has-gl-extensions? ]
  20     [ (make-gl-extensions-error) ]
  21     (require-gl) ;
  22
  23 : version-seq ( version-string -- version-seq )
  24     "." split [ string>number ] map ;
  25
  26 : version-before? ( version1 version2 -- ? )
  27     swap version-seq swap version-seq before=? ;
  28
  29 : (gl-version) ( -- version vendor )
  30     GL_VERSION glGetString " " split1 ;
  31 : gl-version ( -- version )
  32     (gl-version) drop ;
  33 : gl-vendor-version ( -- version )
  34     (gl-version) nip ;
  35 : has-gl-version? ( version -- ? )
  36     gl-version version-before? ;
  37 : (make-gl-version-error) ( required-version -- )
  38     "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
  39 : require-gl-version ( version -- )
  40     [ has-gl-version? ]
  41     [ (make-gl-version-error) ]
  42     (require-gl) ;
  43
  44 : (glsl-version) ( -- version vendor )
  45     GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
  46 : glsl-version ( -- version )
  47     (glsl-version) drop ;
  48 : glsl-vendor-version ( -- version )
  49     (glsl-version) nip ;
  50 : has-glsl-version? ( version -- ? )
  51     glsl-version version-before? ;
  52 : require-glsl-version ( version -- )
  53     [ has-glsl-version? ]
  54     [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
  55     (require-gl) ;
  56
  57 : has-gl-version-or-extensions? ( version extensions -- ? )
  58     has-gl-extensions? swap has-gl-version? or ;
  59
  60 : require-gl-version-or-extensions ( version extensions -- )
  61     2array [ first2 has-gl-version-or-extensions? ] [
  62         dup first (make-gl-version-error) "\n" %
  63         second (make-gl-extensions-error) "\n" %
  64     ] (require-gl) ;