63 lines
1.9 KiB
Factor
63 lines
1.9 KiB
Factor
|
IN: gl-internals
|
||
|
|
USING: alien kernel sequences stdio math test parser namespaces lists strings words compiler ;
|
||
|
|
|
||
|
|
! usage of 'LIBRARY:' and 'FUNCTION:' :
|
||
|
|
!
|
||
|
|
! LIBRARY: gl
|
||
|
|
! FUNCTION: void glTranslatef ( GLfloat x, GLfloat y, GLfloat z ) ;
|
||
|
|
!
|
||
|
|
! should be the same as doing:
|
||
|
|
!
|
||
|
|
! : glTranslatef ( x y z -- )
|
||
|
|
! "void" "gl" "glTranslatef" [ "GLfloat" "GLfloat" "GLfloat" ] alien-invoke ;
|
||
|
|
! \ glTranslatef compile
|
||
|
|
!
|
||
|
|
! other forms:
|
||
|
|
!
|
||
|
|
! FUNCTION: void glEnd ( ) ; -> : glEnd ( -- ) "void" "gl" "glEnd" [ ] alien-invoke ;
|
||
|
|
!
|
||
|
|
! FUNCTION: TODO: something with a return...
|
||
|
|
|
||
|
|
: LIBRARY: scan "c-library" set ; parsing
|
||
|
|
|
||
|
|
: compile-function-call ( type lib func types stack-effect -- )
|
||
|
|
>r over create-in >r
|
||
|
|
[ alien-invoke ] cons cons cons cons r> swap define-compound
|
||
|
|
word r> "stack-effect" set-word-prop
|
||
|
|
word compile ;
|
||
|
|
|
||
|
|
: (list-split) ( list1 list2 quot -- list1 list2 )
|
||
|
|
dup >r >r dup
|
||
|
|
[ unswons dup r> call
|
||
|
|
[ r> 2drop ]
|
||
|
|
[ rot cons swap r> (list-split) ] ifte ]
|
||
|
|
[ r> r> 2drop ] ifte ;
|
||
|
|
|
||
|
|
: list-split ( list quot -- list1 list2 )
|
||
|
|
#! split the list at the first element where 'elem quot call' is t, removing that element.
|
||
|
|
#! if no elements return true, return 'list [ ]'
|
||
|
|
[ ] -rot (list-split) >r reverse r> ;
|
||
|
|
|
||
|
|
: unpair ( list -- list1 list2 )
|
||
|
|
[ uncons uncons unpair rot swons >r cons r> ]
|
||
|
|
[ f f ] ifte* ;
|
||
|
|
|
||
|
|
: remove-trailing-char ( str ch -- str )
|
||
|
|
>r dup length 1 - swap 2dup nth r> =
|
||
|
|
[ head ]
|
||
|
|
[ nip ] ifte ;
|
||
|
|
|
||
|
|
: join-stack-effect ( lst -- str )
|
||
|
|
[ CHAR: , remove-trailing-char " " append ] map " " swons concat ;
|
||
|
|
|
||
|
|
: parse-stack-effect ( lst -- types stack-effect )
|
||
|
|
[ "--" = ] list-split >r unpair r> "--" swons append join-stack-effect ;
|
||
|
|
|
||
|
|
: (function) ( type lib func function-args -- )
|
||
|
|
unswons drop reverse unswons drop reverse
|
||
|
|
parse-stack-effect compile-function-call ;
|
||
|
|
|
||
|
|
: FUNCTION:
|
||
|
|
scan "c-library" get scan string-mode on
|
||
|
|
[ string-mode off (function) ] [ ] ; parsing
|