opengl.textures: pad image up to a power of 2 using glTexSubImage2D instead of doing it in Factor code
parent
1a4f2724e4
commit
0affe96d95
|
@ -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 ;
|
|
@ -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 ;
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
Loading…
Reference in New Issue