steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Generalize make-texture

db4
Slava Pestov 2009-01-29 22:08:07 -06:00
parent cadaf71372
commit 0568915bca
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/opengl/opengl.factor
View File

@ -40,10 +40,10 @@ IN: opengl
[ glDisableClientState ] each ; inline [ glDisableClientState ] each ; inline
MACRO: all-enabled ( seq quot -- ) MACRO: all-enabled ( seq quot -- )
[ words>values ] dip [ (all-enabled) ] 2curry ; [ words>values ] dip '[ _ _ (all-enabled) ] ;
MACRO: all-enabled-client-state ( seq quot -- ) MACRO: all-enabled-client-state ( seq quot -- )
[ words>values ] dip [ (all-enabled-client-state) ] 2curry ; [ words>values ] dip '[ _ (all-enabled-client-state) ] ;
: do-matrix ( mode quot -- ) : do-matrix ( mode quot -- )
swap [ glMatrixMode glPushMatrix call ] keep swap [ glMatrixMode glPushMatrix call ] keep
@ -177,7 +177,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
[ length ] [ >uint-array underlying>> ] bi glDrawBuffers ; [ length ] [ >uint-array underlying>> ] bi glDrawBuffers ;
MACRO: set-draw-buffers ( buffers -- ) MACRO: set-draw-buffers ( buffers -- )
words>values [ (set-draw-buffers) ] curry ; words>values '[ _ (set-draw-buffers) ] ;
: do-attribs ( bits quot -- ) : do-attribs ( bits quot -- )
swap glPushAttrib call glPopAttrib ; inline swap glPushAttrib call glPopAttrib ; inline
@ -185,18 +185,18 @@ MACRO: set-draw-buffers ( buffers -- )
: gl-look-at ( eye focus up -- ) : gl-look-at ( eye focus up -- )
[ first3 ] tri@ gluLookAt ; [ first3 ] tri@ gluLookAt ;
: make-texture ( dim pixmap type -- id ) :: make-texture ( dim pixmap format type -- id )
[ gen-texture ] 3dip swap '[ gen-texture [
GL_TEXTURE_BIT [ GL_TEXTURE_BIT [
GL_TEXTURE_2D swap glBindTexture GL_TEXTURE_2D swap glBindTexture
GL_TEXTURE_2D GL_TEXTURE_2D
0 0
GL_RGBA GL_RGBA
_ first2 dim first2
0 0
_ format
GL_UNSIGNED_BYTE type
_ pixmap
glTexImage2D glTexImage2D
] do-attribs ] do-attribs
] keep ; ] keep ;