extra/opengl/capabilities/capabilities.factor

   1 ! Copyright (C) 2008 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces sequences splitting opengl.gl
   4 continuations math.parser math arrays sets math.order ;
   5 IN: opengl.capabilities
   6
   7 : (require-gl) ( thing require-quot make-error-quot -- )
   8     -rot dupd call
   9     [ 2drop ]
  10     [ swap " " make throw ]
  11     if ; inline
  12
  13 : gl-extensions ( -- seq )
  14     GL_EXTENSIONS glGetString " " split ;
  15 : has-gl-extensions? ( extensions -- ? )
  16     gl-extensions swap [ over member? ] all? nip ;
  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 : has-gl-version? ( version -- ? )
  39     gl-version version-before? ;
  40 : (make-gl-version-error) ( required-version -- )
  41     "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ;
  42 : require-gl-version ( version -- )
  43     [ has-gl-version? ]
  44     [ (make-gl-version-error) ]
  45     (require-gl) ;
  46
  47 : (glsl-version) ( -- version vendor )
  48     GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
  49 : glsl-version ( -- version )
  50     (glsl-version) drop ;
  51 : glsl-vendor-version ( -- version )
  52     (glsl-version) nip ;
  53 : has-glsl-version? ( version -- ? )
  54     glsl-version version-before? ;
  55 : require-glsl-version ( version -- )
  56     [ has-glsl-version? ]
  57     [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ]
  58     (require-gl) ;
  59
  60 : has-gl-version-or-extensions? ( version extensions -- ? )
  61     has-gl-extensions? swap has-gl-version? or ;
  62
  63 : require-gl-version-or-extensions ( version extensions -- )
  64     2array [ first2 has-gl-version-or-extensions? ] [
  65         dup first (make-gl-version-error) "\n" %
  66         second (make-gl-extensions-error) "\n" %
  67     ] (require-gl) ;