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

opengl: Add words to work with color objects

db4
Eduardo Cavazos 2008-07-28 14:19:35 -05:00
parent e9e1313b6c
commit 47d8a56dc0
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/opengl/opengl.factor
View File

@ -2,10 +2,12 @@
! Portions copyright (C) 2007 Eduardo Cavazos. ! Portions copyright (C) 2007 Eduardo Cavazos.
! Portions copyright (C) 2008 Joe Groff. ! Portions copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types continuations kernel libc math macros USING: alien alien.c-types continuations kernel libc math macros
namespaces math.vectors math.constants math.functions namespaces math.vectors math.constants math.functions
math.parser opengl.gl opengl.glu combinators arrays sequences math.parser opengl.gl opengl.glu combinators arrays sequences
splitting words byte-arrays assocs ; splitting words byte-arrays assocs colors accessors ;
IN: opengl IN: opengl
: coordinates ( point1 point2 -- x1 y2 x2 y2 ) : coordinates ( point1 point2 -- x1 y2 x2 y2 )
@ -14,6 +16,8 @@ IN: opengl
: fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
[ first2 [ >fixnum ] bi@ ] bi@ ; [ first2 [ >fixnum ] bi@ ] bi@ ;
: gl-color ( color -- ) first4 glColor4d ; inline : gl-color ( color -- ) first4 glColor4d ; inline
: gl-clear-color ( color -- ) : gl-clear-color ( color -- )
@ -22,6 +26,16 @@ IN: opengl
: gl-clear ( color -- ) : gl-clear ( color -- )
gl-clear-color GL_COLOR_BUFFER_BIT glClear ; gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
: color>raw ( object -- 4array )
>rgba
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave
4array ;
: set-color ( object -- ) color>raw first4 glColor4d ;
: set-clear-color ( object -- ) color>raw first4 glClearColor ;
: gl-error ( -- ) : gl-error ( -- )
glGetError dup zero? [ glGetError dup zero? [
"GL error: " over gluErrorString append throw "GL error: " over gluErrorString append throw