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

Clean up OpenGL code a bit

db4
Slava Pestov 2009-01-18 20:10:08 -06:00
parent 5b636c6a2a
commit 7fdf7cc906
7 changed files with 96 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
basis/opengl/opengl-docs.factor
View File

@ -1,9 +1,9 @@
USING: help.markup help.syntax io kernel math quotations
opengl.gl assocs vocabs.loader sequences accessors ;
USING: alien help.markup help.syntax io kernel math quotations
opengl.gl assocs vocabs.loader sequences accessors colors ;
IN: opengl
HELP: gl-color
{ $values { "color" "a color specifier" } }
{ $values { "color" color } }
{ $description "Wrapper for " { $link glColor4d } " taking a color specifier." } ;
HELP: gl-error
@ -60,21 +60,10 @@ HELP: do-attribs
{ $values { "bits" integer } { "quot" quotation } }
{ $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
HELP: sprite
{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
{ $list
{ { $snippet "dlist" } " - an OpenGL display list ID" }
{ { $snippet "texture" } " - an OpenGL texture ID" }
{ { $snippet "loc" } " - top-left corner of the sprite" }
{ { $snippet "dim" } " - dimensions of the sprite" }
{ { $snippet "dim2" } " - dimensions of the sprite, rounded up to the nearest powers of two" }
}
} ;
HELP: gray-texture
{ $values { "sprite" sprite } { "pixmap" "an alien or byte array" } { "id" "an OpenGL texture ID" } }
{ $description "Creates a new OpenGL texture from a 1 byte per pixel image whose dimensions are equal to " { $snippet "dim2" } "." } ;
HELP: make-texture
{ $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "type" "an OpenGL texture type" } { "id" "an OpenGL texture ID" } }
{ $description "Creates a new OpenGL texture from a pixmap image whose dimensions are equal to " { $snippet "dim" } "." } ;
HELP: gen-dlist
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glGenLists } " to handle the common case of generating a single display list ID." } ;
@ -87,10 +76,6 @@ HELP: gl-translate
{ $values { "point" "a pair of integers" } }
{ $description "Wrapper for " { $link glTranslated } " taking a point object." } ;
HELP: free-sprites
{ $values { "sprites" "a sequence of " { $link sprite } " instances" } }
{ $description "Deallocates native resources associated toa sequence of sprites." } ;
HELP: with-translation
{ $values { "loc" "a pair of integers" } { "quot" quotation } }
{ $description "Calls the quotation with a translation by " { $snippet "loc" } " pixels applied to the current " { $link GL_MODELVIEW } " matrix, restoring the matrix when the quotation is done." } ;

61
basis/opengl/opengl.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! Copyright (C) 2005, 2009 Slava Pestov.
! Portions copyright (C) 2007 Eduardo Cavazos.
! Portions copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
@ -188,31 +188,26 @@ MACRO: set-draw-buffers ( buffers -- )
: gl-look-at ( eye focus up -- )
[ first3 ] tri@ gluLookAt ;
TUPLE: sprite loc dim dim2 dlist texture ;
: <sprite> ( loc dim dim2 -- sprite )
f f sprite boa ;
: sprite-size2 ( sprite -- w h ) dim2>> first2 ;
: sprite-width ( sprite -- w ) dim>> first ;
: gray-texture ( sprite pixmap -- id )
gen-texture [
: make-texture ( dim pixmap type -- id )
[ gen-texture ] 3dip swap '[
GL_TEXTURE_BIT [
GL_TEXTURE_2D swap glBindTexture
[
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
sprite-size2 0 GL_LUMINANCE_ALPHA
GL_UNSIGNED_BYTE
] dip glTexImage2D
GL_TEXTURE_2D
0
GL_RGBA
_ first2
0
_
GL_UNSIGNED_BYTE
_
glTexImage2D
] do-attribs
] keep ;
: gen-dlist ( -- id ) 1 glGenLists ;
: make-dlist ( type quot -- id )
gen-dlist [ rot glNewList call glEndList ] keep ; inline
[ gen-dlist ] 2dip '[ _ glNewList @ glEndList ] keep ; inline
: init-texture ( -- )
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
@ -225,34 +220,8 @@ TUPLE: sprite loc dim dim2 dlist texture ;
: rect-texture-coords ( -- )
float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
: draw-sprite ( sprite -- )
GL_TEXTURE_COORD_ARRAY [
dup loc>> gl-translate
GL_TEXTURE_2D over texture>> glBindTexture
init-texture rect-texture-coords
dim2>> fill-rect-vertices
(gl-fill-rect)
GL_TEXTURE_2D 0 glBindTexture
] do-enabled-client-state ;
: make-sprite-dlist ( sprite -- id )
GL_MODELVIEW [
GL_COMPILE [ draw-sprite ] make-dlist
] do-matrix ;
: init-sprite ( texture sprite -- )
swap >>texture
dup make-sprite-dlist >>dlist drop ;
: delete-dlist ( id -- ) 1 glDeleteLists ;
: free-sprite ( sprite -- )
[ dlist>> delete-dlist ]
[ texture>> delete-texture ] bi ;
: free-sprites ( sprites -- )
[ nip [ free-sprite ] when* ] assoc-each ;
: with-translation ( loc quot -- )
GL_MODELVIEW [ [ gl-translate ] dip call ] do-matrix ; inline
@ -269,4 +238,4 @@ TUPLE: sprite loc dim dim2 dlist texture ;
GL_PROJECTION glMatrixMode
glLoadIdentity
GL_MODELVIEW glMatrixMode
glLoadIdentity ;
glLoadIdentity ;

1
basis/opengl/sprites/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

18
basis/opengl/sprites/sprites-docs.factor Normal file
View File

@ -0,0 +1,18 @@
IN: opengl.sprites
USING: help.markup help.syntax ;
HELP: sprite
{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
{ $list
{ { $snippet "dlist" } " - an OpenGL display list ID" }
{ { $snippet "texture" } " - an OpenGL texture ID" }
{ { $snippet "loc" } " - top-left corner of the sprite" }
{ { $snippet "dim" } " - dimensions of the sprite" }
{ { $snippet "dim2" } " - dimensions of the sprite, rounded up to the nearest powers of two" }
}
} ;
HELP: free-sprites
{ $values { "sprites" "a sequence of " { $link sprite } " instances" } }
{ $description "Deallocates native resources associated toa sequence of sprites." } ;

4
basis/opengl/sprites/sprites-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test opengl.sprites ;
IN: opengl.sprites.tests

39
basis/opengl/sprites/sprites.factor Normal file
View File

@ -0,0 +1,39 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences opengl opengl.gl assocs ;
IN: opengl.sprites
TUPLE: sprite loc dim dim2 dlist texture ;
: <sprite> ( loc dim dim2 -- sprite )
f f sprite boa ;
: sprite-size2 ( sprite -- w h ) dim2>> first2 ;
: sprite-width ( sprite -- w ) dim>> first ;
: draw-sprite ( sprite -- )
GL_TEXTURE_COORD_ARRAY [
dup loc>> gl-translate
GL_TEXTURE_2D over texture>> glBindTexture
init-texture rect-texture-coords
dim2>> fill-rect-vertices
(gl-fill-rect)
GL_TEXTURE_2D 0 glBindTexture
] do-enabled-client-state ;
: make-sprite-dlist ( sprite -- id )
GL_MODELVIEW [
GL_COMPILE [ draw-sprite ] make-dlist
] do-matrix ;
: init-sprite ( texture sprite -- )
swap >>texture
dup make-sprite-dlist >>dlist drop ;
: free-sprite ( sprite -- )
[ dlist>> delete-dlist ]
[ texture>> delete-texture ] bi ;
: free-sprites ( sprites -- )
[ nip [ free-sprite ] when* ] assoc-each ;

23
basis/ui/freetype/freetype.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors alien.c-types arrays io kernel libc
math math.vectors namespaces opengl opengl.gl assocs
math math.vectors namespaces opengl opengl.gl opengl.sprites assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
locals specialized-arrays.direct.uchar ;
@ -128,8 +128,9 @@ M: freetype-renderer string-height ( open-font string -- h )
drop height>> ;
: glyph-size ( glyph -- dim )
dup glyph-hori-advance ft-ceil
swap glyph-height ft-ceil 2array ;
[ glyph-hori-advance ft-ceil ]
[ glyph-height ft-ceil ]
bi 2array ;
: render-glyph ( font char -- bitmap )
load-glyph dup
@ -157,17 +158,17 @@ M: freetype-renderer string-height ( open-font string -- h )
width [ glyph glyph-bitmap-width ]
width2 [ width next-power-of-2 2 * ] |
bitmap [
[let | bitmap' [ bitmap rows width * <direct-uchar-array> ] |
0 0
rows [ bitmap' texture width width2 copy-row ] times
2drop
]
bitmap rows width * <direct-uchar-array> :> bitmap'
0 0
rows [ bitmap' texture width width2 copy-row ] times
2drop
] when
] ;
: bitmap>texture ( glyph sprite -- id )
tuck sprite-size2 * 2 * <byte-array>
[ copy-bitmap ] keep gray-texture ;
tuck dim2>> product 2 * <byte-array>
[ copy-bitmap ] keep [ dim2>> ] dip
GL_LUMINANCE_ALPHA make-texture ;
: glyph-texture-loc ( glyph font -- loc )
[ drop glyph-hori-bearing-x ft-floor ]