! 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) ;
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 ;
-
-: repeat-last ( seq n -- seq' )
- over peek pad-tail concat ;
+TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
-: power-of-2-bitmap ( rows dim size -- bitmap dim )
- '[
- first2
- [ [ _ ] dip '[ _ group _ repeat-last ] map ]
- [ repeat-last ]
- bi*
- ] keep ;
+: (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 ;
-: 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 ;
+: (tex-sub-image) ( image -- )
+ [ GL_TEXTURE_2D 0 0 0 ] dip
+ [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
+ glTexSubImage2D ;
-:: 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 [
: 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
: 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
[ 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 ;
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 ;
\ No newline at end of file
+ [ [ max-texture-size tesselate ] dip <multi-texture> ] if ;
\ No newline at end of file