basis/opengl/gl/extensions/extensions.factor

   1 USING: alien alien.syntax alien.parser combinators
   2 kernel parser sequences system words namespaces hashtables init
   3 math arrays assocs continuations lexer fry locals vocabs.parser ;
   4 IN: opengl.gl.extensions
   5
   6 ERROR: unknown-gl-platform ;
   7 << {
   8     { [ os windows? ] [ "opengl.gl.windows" ] }
   9     { [ os macosx? ]  [ "opengl.gl.macosx" ] }
  10     { [ os unix? ] [ "opengl.gl.unix" ] }
  11     [ unknown-gl-platform ]
  12 } cond use-vocab >>
  13
  14 SYMBOL: +gl-function-number-counter+
  15 SYMBOL: +gl-function-pointers+
  16
  17 : reset-gl-function-number-counter ( -- )
  18     0 +gl-function-number-counter+ set-global ;
  19 : reset-gl-function-pointers ( -- )
  20     100 <hashtable> +gl-function-pointers+ set-global ;
  21
  22 [ reset-gl-function-pointers ] "opengl.gl" add-init-hook
  23 reset-gl-function-pointers
  24 reset-gl-function-number-counter
  25
  26 : gl-function-number ( -- n )
  27     +gl-function-number-counter+ get-global
  28     dup 1 + +gl-function-number-counter+ set-global ;
  29
  30 : gl-function-pointer ( names n -- funptr )
  31     gl-function-context 2array dup +gl-function-pointers+ get-global at
  32     [ 2nip ] [
  33         [
  34             [ gl-function-address ] map [ ] find nip
  35             dup [ "OpenGL function not available" throw ] unless
  36             dup
  37         ] dip
  38         +gl-function-pointers+ get-global set-at
  39     ] if* ;
  40
  41 : indirect-quot ( function-ptr-quot return types abi -- quot )
  42     '[ @  _ _ _ alien-indirect ] ;
  43
  44 :: define-indirect ( abi return function-ptr-quot function-name parameters -- )
  45     function-name create-in dup reset-generic
  46     function-ptr-quot return
  47     parameters return parse-arglist [ abi indirect-quot ] dip
  48     define-declared ;
  49
  50 SYNTAX: GL-FUNCTION:
  51     gl-function-calling-convention
  52     scan
  53     scan dup
  54     scan drop "}" parse-tokens swap prefix
  55     gl-function-number
  56     [ gl-function-pointer ] 2curry swap
  57     ";" parse-tokens [ "()" subseq? not ] filter
  58     define-indirect ;