opengl.textures: pad image up to a power of 2 using glTexSubImage2D instead of doing it in Factor code

db4
Slava Pestov 2009-04-04 20:04:35 -05:00
parent 1a4f2724e4
commit 0affe96d95
6 changed files with 36 additions and 70 deletions

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs cache colors.constants destructors fry kernel
opengl opengl.gl combinators images images.tesselation grouping
specialized-arrays.float locals sequences math math.vectors
math.matrices generalizations fry columns arrays ;
specialized-arrays.float sequences math math.vectors
math.matrices generalizations fry arrays ;
IN: opengl.textures
: gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
@ -19,61 +19,42 @@ M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
GENERIC: draw-texture ( texture -- )
SLOT: display-list
: draw-texture ( texture -- ) display-list>> [ glCallList ] when* ;
GENERIC: draw-scaled-texture ( dim texture -- )
<PRIVATE
TUPLE: single-texture image loc dim texture-coords texture display-list disposed ;
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
: repeat-last ( seq n -- seq' )
over peek pad-tail concat ;
: (tex-image) ( image -- )
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
[ dim>> first2 [ next-power-of-2 ] bi@ 0 ]
[ component-order>> component-order>format f ] bi
glTexImage2D ;
: power-of-2-bitmap ( rows dim size -- bitmap dim )
'[
first2
[ [ _ ] dip '[ _ group _ repeat-last ] map ]
[ repeat-last ]
bi*
] keep ;
: (tex-sub-image) ( image -- )
[ GL_TEXTURE_2D 0 0 0 ] dip
[ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
glTexSubImage2D ;
: image-rows ( image -- rows )
[ bitmap>> ]
[ dim>> first ]
[ component-order>> bytes-per-pixel ]
tri * group ; inline
: power-of-2-image ( image -- image )
dup dim>> [ [ 0 = ] [ power-of-2? ] bi or ] all? [
clone dup
[ image-rows ]
[ dim>> [ next-power-of-2 ] map ]
[ component-order>> bytes-per-pixel ] tri
power-of-2-bitmap
[ >>bitmap ] [ >>dim ] bi*
] unless ;
:: make-texture ( image -- id )
: make-texture ( image -- id )
#! We use glTexSubImage2D to work around the power of 2 texture size
#! limitation
gen-texture [
GL_TEXTURE_BIT [
GL_TEXTURE_2D swap glBindTexture
GL_TEXTURE_2D
0
GL_RGBA
image dim>> first2
0
image component-order>> component-order>format
image bitmap>>
glTexImage2D
[ (tex-image) ] [ (tex-sub-image) ] bi
] do-attribs
] keep ;
: init-texture ( -- )
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE glTexParameteri ;
: with-texturing ( quot -- )
GL_TEXTURE_2D [
@ -101,7 +82,7 @@ TUPLE: single-texture image loc dim texture-coords texture display-list disposed
: texture-coords ( texture -- coords )
[
[ dim>> ] [ image>> dim>> ] bi v/
[ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/
{ { 0 0 } { 1 0 } { 1 1 } { 0 1 } }
[ v* ] with map
] keep
@ -111,9 +92,8 @@ TUPLE: single-texture image loc dim texture-coords texture display-list disposed
: make-texture-display-list ( texture -- dlist )
GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ;
: <single-texture> ( image loc dim -- texture )
[ power-of-2-image ] 2dip
single-texture new swap >>dim swap >>loc swap >>image
: <single-texture> ( image loc -- texture )
single-texture new swap >>loc swap [ >>image ] [ dim>> >>dim ] bi
dup image>> dim>> product 0 = [
dup texture-coords >>texture-coords
dup image>> make-texture >>texture
@ -124,21 +104,19 @@ M: single-texture dispose*
[ texture>> [ delete-texture ] when* ]
[ display-list>> [ delete-dlist ] when* ] bi ;
M: single-texture draw-texture display-list>> [ glCallList ] when* ;
M: single-texture draw-scaled-texture
dup texture>> [ draw-textured-rect ] [ 2drop ] if ;
TUPLE: multi-texture grid display-list loc disposed ;
: image-locs ( image-grid -- loc-grid )
[ first [ dim>> first ] map ] [ 0 <column> [ dim>> second ] map ] bi
[ first [ dim>> first ] map ] [ [ first dim>> second ] map ] bi
[ 0 [ + ] accumulate nip ] bi@
cross-zip flip ;
: <texture-grid> ( image-grid loc -- grid )
[ dup image-locs ] dip
'[ [ _ v+ over dim>> <single-texture> |dispose ] 2map ] 2map ;
'[ [ _ v+ <single-texture> |dispose ] 2map ] 2map ;
: draw-textured-grid ( grid -- )
[ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ;
@ -165,18 +143,13 @@ TUPLE: multi-texture grid display-list loc disposed ;
f multi-texture boa
] with-destructors ;
M: multi-texture draw-texture display-list>> [ glCallList ] when* ;
M: multi-texture dispose* grid>> [ [ dispose ] each ] each ;
CONSTANT: max-texture-size { 512 512 }
PRIVATE>
: small-texture? ( dim -- ? )
max-texture-size [ <= ] 2all? ;
: <texture> ( image loc dim -- texture )
pick dim>> small-texture?
: <texture> ( image loc -- texture )
over dim>> max-texture-size [ <= ] 2all?
[ <single-texture> ]
[ drop [ max-texture-size tesselate ] dip <multi-texture> ] if ;
[ [ max-texture-size tesselate ] dip <multi-texture> ] if ;

View File

@ -20,7 +20,7 @@ PRIVATE>
: rendered-image ( path -- texture )
world get image-texture-cache
[ cached-image [ { 0 0 } ] keep dim>> <texture> ] cache ;
[ cached-image { 0 0 } <texture> ] cache ;
: draw-image ( image-name -- )
rendered-image draw-texture ;

View File

@ -20,9 +20,7 @@ M: core-text-renderer flush-layout-cache
: rendered-line ( font string -- texture )
world get world-text-handle [
cached-line
[ image>> ] [ loc>> ] [ image>> dim>> ] tri
<texture>
cached-line [ image>> ] [ loc>> ] bi <texture>
] 2cache ;
M: core-text-renderer draw-string ( font string -- )

View File

@ -16,9 +16,7 @@ M: pango-renderer flush-layout-cache
: rendered-layout ( font string -- texture )
world get world-text-handle [
cached-layout
[ image>> ] [ text-position vneg ] [ image>> dim>> ] tri
<texture>
cached-layout [ image>> ] [ text-position vneg ] bi <texture>
] 2cache ;
M: pango-renderer draw-string ( font string -- )

View File

@ -16,7 +16,7 @@ M: uniscribe-renderer flush-layout-cache
: rendered-script-string ( font string -- texture )
world get world-text-handle
[ cached-script-string [ image>> { 0 0 } ] [ size>> ] bi <texture> ]
[ cached-script-string image>> { 0 0 } <texture> ]
2cache ;
M: uniscribe-renderer draw-string ( font string -- )

View File

@ -71,11 +71,8 @@ TUPLE: script-string font string metrics ssa size image disposed ;
: draw-script-string ( dc script-string -- )
[ font>> set-dc-colors ] keep (draw-script-string) ;
: script-string-bitmap-size ( script-string -- dim )
size>> dup small-texture? [ [ next-power-of-2 ] map ] when ;
:: make-script-string-image ( dc script-string -- image )
script-string script-string-bitmap-size dc
script-string size>> dc
[ dc script-string draw-script-string ] make-bitmap-image ;
: set-dc-font ( dc font -- )