2008-11-30 18:47:29 -05:00
|
|
|
USING: alien alien.syntax alien.parser combinators
|
2008-11-29 16:21:12 -05:00
|
|
|
kernel parser sequences system words namespaces hashtables init
|
2008-12-17 19:10:01 -05:00
|
|
|
math arrays assocs continuations lexer fry locals vocabs.parser ;
|
2008-04-06 22:07:21 -04:00
|
|
|
IN: opengl.gl.extensions
|
2008-04-02 19:25:33 -04:00
|
|
|
|
|
|
|
ERROR: unknown-gl-platform ;
|
2008-02-08 01:43:05 -05:00
|
|
|
<< {
|
2008-04-02 19:25:33 -04:00
|
|
|
{ [ os windows? ] [ "opengl.gl.windows" ] }
|
|
|
|
{ [ os macosx? ] [ "opengl.gl.macosx" ] }
|
|
|
|
{ [ os unix? ] [ "opengl.gl.unix" ] }
|
2008-04-11 13:56:48 -04:00
|
|
|
[ unknown-gl-platform ]
|
2009-05-14 23:31:29 -04:00
|
|
|
} cond use-vocab >>
|
2008-02-08 01:43:05 -05:00
|
|
|
|
2010-02-28 19:40:34 -05:00
|
|
|
SYMBOL: +gl-function-counter+
|
2008-02-08 01:43:05 -05:00
|
|
|
SYMBOL: +gl-function-pointers+
|
|
|
|
|
|
|
|
: reset-gl-function-number-counter ( -- )
|
2010-02-28 19:40:34 -05:00
|
|
|
0 +gl-function-counter+ set-global ;
|
2008-02-08 01:43:05 -05:00
|
|
|
: reset-gl-function-pointers ( -- )
|
|
|
|
100 <hashtable> +gl-function-pointers+ set-global ;
|
|
|
|
|
2009-10-19 22:17:02 -04:00
|
|
|
[ reset-gl-function-pointers ] "opengl.gl" add-startup-hook
|
2008-02-08 01:43:05 -05:00
|
|
|
reset-gl-function-pointers
|
|
|
|
reset-gl-function-number-counter
|
|
|
|
|
2010-02-28 19:40:34 -05:00
|
|
|
: gl-function-counter ( -- n )
|
|
|
|
+gl-function-counter+ get-global
|
|
|
|
dup 1 + +gl-function-counter+ set-global ;
|
2008-02-08 01:43:05 -05:00
|
|
|
|
|
|
|
: gl-function-pointer ( names n -- funptr )
|
|
|
|
gl-function-context 2array dup +gl-function-pointers+ get-global at
|
|
|
|
[ 2nip ] [
|
2008-11-30 18:47:29 -05:00
|
|
|
[
|
|
|
|
[ gl-function-address ] map [ ] find nip
|
|
|
|
dup [ "OpenGL function not available" throw ] unless
|
|
|
|
dup
|
|
|
|
] dip
|
2008-02-08 01:43:05 -05:00
|
|
|
+gl-function-pointers+ get-global set-at
|
|
|
|
] if* ;
|
|
|
|
|
2008-11-29 16:21:12 -05:00
|
|
|
: indirect-quot ( function-ptr-quot return types abi -- quot )
|
2008-11-30 18:47:29 -05:00
|
|
|
'[ @ _ _ _ alien-indirect ] ;
|
2008-11-29 16:21:12 -05:00
|
|
|
|
2010-02-28 19:40:34 -05:00
|
|
|
:: define-indirect ( abi return function-name function-ptr-quot types names -- )
|
2008-11-30 18:47:29 -05:00
|
|
|
function-name create-in dup reset-generic
|
2010-02-28 19:40:34 -05:00
|
|
|
function-ptr-quot return types abi indirect-quot
|
|
|
|
names return function-effect
|
2008-11-30 18:47:29 -05:00
|
|
|
define-declared ;
|
2008-11-29 16:21:12 -05:00
|
|
|
|
2009-03-21 02:27:50 -04:00
|
|
|
SYNTAX: GL-FUNCTION:
|
2008-02-08 01:43:05 -05:00
|
|
|
gl-function-calling-convention
|
2010-02-28 19:40:34 -05:00
|
|
|
scan-function-name
|
|
|
|
"{" expect "}" parse-tokens over prefix
|
|
|
|
gl-function-counter '[ _ _ gl-function-pointer ]
|
|
|
|
";" scan-c-args define-indirect ;
|