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.gtk" ] }
  11     [ unknown-gl-platform ]
  12 } cond use-vocab >>
  13
  14 SYMBOL: +gl-function-counter+
  15 SYMBOL: +gl-function-pointers+
  16
  17 : reset-gl-function-number-counter ( -- )
  18     0 +gl-function-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-startup-hook
  23 reset-gl-function-pointers
  24 reset-gl-function-number-counter
  25
  26 : gl-function-counter ( -- n )
  27     +gl-function-counter+ counter ;
  28
  29 : gl-function-pointer ( names n -- funptr )
  30     gl-function-context 2array dup +gl-function-pointers+ get-global at
  31     [ 2nip ] [
  32         [
  33             [ gl-function-address ] map [ ] find nip
  34             dup [ "OpenGL function not available" throw ] unless
  35             dup
  36         ] dip
  37         +gl-function-pointers+ get-global set-at
  38     ] if* ;
  39
  40 : indirect-quot ( function-ptr-quot return types abi -- quot )
  41     '[ @  _ _ _ alien-indirect ] ;
  42
  43 :: define-indirect ( abi return function-name function-ptr-quot types names -- )
  44     function-name create-function
  45     function-ptr-quot return types abi indirect-quot
  46     names return function-effect
  47     define-declared ;
  48
  49 : gl-function-calling-convention ( -- symbol )
  50     os windows? [ stdcall ] [ cdecl ] if ;
  51
  52 SYNTAX: GL-FUNCTION:
  53     gl-function-calling-convention
  54     scan-function-name
  55     "{" expect "}" parse-tokens over suffix
  56     gl-function-counter '[ _ _ gl-function-pointer ]
  57     scan-c-args define-indirect ;