Clean up OpenGL code a bit
parent
5b636c6a2a
commit
7fdf7cc906
|
@ -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." } ;
|
||||
|
|
|
@ -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 ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -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." } ;
|
||||
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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 ]
|
||||
|
|
Loading…
Reference in New Issue