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" ] }
							 | 
						
					
						
							
								
									
										
										
										
											2010-05-23 22:23:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    { [ os unix? ] [ "opengl.gl.x11" ] }
							 | 
						
					
						
							
								
									
										
										
										
											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 ;
							 |