basis/opengl/capabilities/capabilities.factor

   1 ! Copyright (C) 2008 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays fry kernel make math.order math.parser opengl.gl
   4 sequences sets splitting strings system ;
   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 words ;
  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     [ version-seq ] bi@ before=? ;
  31
  32 : (gl-version) ( -- version1 version2 )
  33     GL_VERSION glGetString " " split1 ;
  34 : gl-version ( -- version ) (gl-version) drop ;
  35 : gl-vendor-version ( -- version ) (gl-version) nip ;
  36 : gl-vendor ( -- vendor ) GL_VENDOR glGetString ;
  37
  38 : has-gl-version? ( version -- ? )
  39     gl-version [ version-before? ] [ drop f ] if* ;
  40
  41 : (make-gl-version-error) ( required-version -- )
  42     "Required OpenGL version " % % " not supported (" % gl-version "(null)" or % " available)" %
  43     os linux = [
  44         "\nIf you have several libGL.so installed, Factor tried the first one in: ldconfig -p | grep libGL.so$" %
  45         "\nYou can change the library used like so: LD_LIBRARY_PATH=/usr/lib/fglrx/ ./factor" %
  46     ] when ;
  47
  48 : require-gl-version ( version -- )
  49     [ has-gl-version? ]
  50     [ (make-gl-version-error) ]
  51     (require-gl) ;
  52
  53 : (glsl-version) ( -- version vendor )
  54     GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ;
  55 : glsl-version ( -- version ) (glsl-version) drop ;
  56 : glsl-vendor-version ( -- version ) (glsl-version) nip ;
  57 : has-glsl-version? ( version -- ? ) glsl-version version-before? ;
  58
  59 : require-glsl-version ( version -- )
  60     [ has-glsl-version? ]
  61     [ "Required GLSL version " % % " not supported (" % glsl-version "(null)" or % " available)" % ]
  62     (require-gl) ;
  63
  64 : has-gl-version-or-extensions? ( version extensions -- ? )
  65     has-gl-extensions? swap has-gl-version? or ;
  66
  67 : require-gl-version-or-extensions ( version extensions -- )
  68     2array [ first2 has-gl-version-or-extensions? ] [
  69         dup first (make-gl-version-error) "\n" %
  70         second (make-gl-extensions-error) "\n" %
  71     ] (require-gl) ;