-! (c)2009 Joe Groff bsd license
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays byte-arrays combinators
-destructors fry gpu gpu.buffers images kernel locals math
-opengl opengl.gl opengl.textures sequences
-specialized-arrays ui.gadgets.worlds variants ;
+destructors gpu gpu.buffers images kernel math
+opengl.gl opengl.textures sequences
+specialized-arrays typed ui.gadgets.worlds variants ;
+FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: gpu.textures
{ component-type component-type read-only initial: ubyte-components } ;
C: <texture-data> texture-data
-UNION: ?texture-data texture-data POSTPONE: f ;
-UNION: ?float-array float-array POSTPONE: f ;
+
+VARIANT: compressed-texture-format
+ DXT1-RGB DXT1-RGBA DXT3 DXT5
+ LATC1 LATC1-SIGNED LATC2 LATC2-SIGNED
+ RGTC1 RGTC1-SIGNED RGTC2 RGTC2-SIGNED ;
+
+TUPLE: compressed-texture-data
+ { ptr read-only }
+ { format compressed-texture-format read-only }
+ { length integer read-only } ;
+
+C: <compressed-texture-data> compressed-texture-data
VARIANT: texture-wrap
clamp-texcoord-to-edge clamp-texcoord-to-border repeat-texcoord repeat-texcoord-mirrored ;
filter-nearest filter-linear ;
UNION: wrap-set texture-wrap sequence ;
-UNION: ?texture-filter texture-filter POSTPONE: f ;
TUPLE: texture-parameters
{ wrap wrap-set initial: { repeat-texcoord repeat-texcoord repeat-texcoord } }
{ min-filter texture-filter initial: filter-nearest }
- { min-mipmap-filter ?texture-filter initial: filter-linear }
+ { min-mipmap-filter maybe{ texture-filter } initial: filter-linear }
{ mag-filter texture-filter initial: filter-linear }
{ min-lod integer initial: -1000 }
{ max-lod integer initial: 1000 }
GENERIC: texture-object ( texture-data-target -- texture )
M: cube-map-face texture-object
- texture>> ;
+ texture>> ; inline
M: texture texture-object
- ;
+ ; inline
+
+: gl-compressed-texture-format ( format -- gl-format )
+ {
+ { DXT1-RGB [ GL_COMPRESSED_RGB_S3TC_DXT1_EXT ] }
+ { DXT1-RGBA [ GL_COMPRESSED_RGBA_S3TC_DXT1_EXT ] }
+ { DXT3 [ GL_COMPRESSED_RGBA_S3TC_DXT3_EXT ] }
+ { DXT5 [ GL_COMPRESSED_RGBA_S3TC_DXT5_EXT ] }
+ { RGTC1 [ GL_COMPRESSED_RED_RGTC1 ] }
+ { RGTC1-SIGNED [ GL_COMPRESSED_SIGNED_RED_RGTC1 ] }
+ { RGTC2 [ GL_COMPRESSED_RG_RGTC2 ] }
+ { RGTC2-SIGNED [ GL_COMPRESSED_SIGNED_RG_RGTC2 ] }
+ } case ; inline
: gl-wrap ( wrap -- gl-wrap )
{
{ clamp-texcoord-to-border [ GL_CLAMP_TO_BORDER ] }
{ repeat-texcoord [ GL_REPEAT ] }
{ repeat-texcoord-mirrored [ GL_MIRRORED_REPEAT ] }
- } case ;
+ } case ; inline
: set-texture-gl-wrap ( target wraps -- )
dup sequence? [ 1array ] unless 3 over last pad-tail {
[ [ GL_TEXTURE_WRAP_S ] dip first gl-wrap glTexParameteri ]
[ [ GL_TEXTURE_WRAP_T ] dip second gl-wrap glTexParameteri ]
[ [ GL_TEXTURE_WRAP_R ] dip third gl-wrap glTexParameteri ]
- } 2cleave ;
+ } 2cleave ; inline
: gl-mag-filter ( filter -- gl-filter )
{
{ filter-nearest [ GL_NEAREST ] }
{ filter-linear [ GL_LINEAR ] }
- } case ;
+ } case ; inline
: gl-min-filter ( filter mipmap-filter -- gl-filter )
2array {
{ { filter-linear filter-nearest } [ GL_LINEAR_MIPMAP_NEAREST ] }
{ { filter-linear filter-linear } [ GL_LINEAR_MIPMAP_LINEAR ] }
{ { filter-nearest filter-linear } [ GL_NEAREST_MIPMAP_LINEAR ] }
- } case ;
+ } case ; inline
GENERIC: texture-gl-target ( texture -- target )
GENERIC: texture-data-gl-target ( texture -- target )
-M: texture-1d texture-gl-target drop GL_TEXTURE_1D ;
-M: texture-2d texture-gl-target drop GL_TEXTURE_2D ;
-M: texture-rectangle texture-gl-target drop GL_TEXTURE_RECTANGLE ;
-M: texture-3d texture-gl-target drop GL_TEXTURE_3D ;
-M: texture-cube-map texture-gl-target drop GL_TEXTURE_CUBE_MAP ;
-M: texture-1d-array texture-gl-target drop GL_TEXTURE_1D_ARRAY ;
-M: texture-2d-array texture-gl-target drop GL_TEXTURE_2D_ARRAY ;
-
-M: texture-1d texture-data-gl-target drop GL_TEXTURE_1D ;
-M: texture-2d texture-data-gl-target drop GL_TEXTURE_2D ;
-M: texture-rectangle texture-data-gl-target drop GL_TEXTURE_RECTANGLE ;
-M: texture-3d texture-data-gl-target drop GL_TEXTURE_3D ;
-M: texture-1d-array texture-data-gl-target drop GL_TEXTURE_1D_ARRAY ;
-M: texture-2d-array texture-data-gl-target drop GL_TEXTURE_2D_ARRAY ;
+M: texture-1d texture-gl-target drop GL_TEXTURE_1D ; inline
+M: texture-2d texture-gl-target drop GL_TEXTURE_2D ; inline
+M: texture-rectangle texture-gl-target drop GL_TEXTURE_RECTANGLE ; inline
+M: texture-3d texture-gl-target drop GL_TEXTURE_3D ; inline
+M: texture-cube-map texture-gl-target drop GL_TEXTURE_CUBE_MAP ; inline
+M: texture-1d-array texture-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
+M: texture-2d-array texture-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
+
+M: texture-1d texture-data-gl-target drop GL_TEXTURE_1D ; inline
+M: texture-2d texture-data-gl-target drop GL_TEXTURE_2D ; inline
+M: texture-rectangle texture-data-gl-target drop GL_TEXTURE_RECTANGLE ; inline
+M: texture-3d texture-data-gl-target drop GL_TEXTURE_3D ; inline
+M: texture-1d-array texture-data-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
+M: texture-2d-array texture-data-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
M: cube-map-face texture-data-gl-target
axis>> {
{ -X [ GL_TEXTURE_CUBE_MAP_NEGATIVE_X ] }
{ +X [ GL_TEXTURE_CUBE_MAP_POSITIVE_X ] }
{ +Y [ GL_TEXTURE_CUBE_MAP_POSITIVE_Y ] }
{ +Z [ GL_TEXTURE_CUBE_MAP_POSITIVE_Z ] }
- } case ;
+ } case ; inline
: texture-gl-internal-format ( texture -- internal-format )
[ component-order>> ] [ component-type>> ] bi image-internal-format ; inline
[ ptr>> ] bi
] [
[ component-order>> ] [ component-type>> ] bi image-data-format f
- ] if* ;
+ ] if* ; inline
:: bind-tdt ( tdt -- texture )
tdt texture-object :> texture
texture [ texture-gl-target ] [ handle>> ] bi glBindTexture
- texture ;
-
-: get-texture-float ( target level enum -- value )
- 0 <float> [ glGetTexLevelParameterfv ] keep *float ;
-: get-texture-int ( target level enum -- value )
- 0 <int> [ glGetTexLevelParameteriv ] keep *int ;
+ texture ; inline
: ?product ( x -- y )
- dup number? [ product ] unless ;
-
-PRIVATE>
-
-GENERIC# allocate-texture 3 ( tdt level dim data -- )
+ dup number? [ product ] unless ; inline
-M:: texture-1d-data-target allocate-texture ( tdt level dim data -- )
+:: (allocate-texture) ( tdt level dim data dim-quot teximage-quot -- )
tdt bind-tdt :> texture
tdt texture-data-gl-target level texture texture-gl-internal-format
- dim 0 texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexImage1D ] with-gpu-data-ptr ;
+ dim dim-quot call 0 texture data texture-data-gl-args
+ pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
-M:: texture-2d-data-target allocate-texture ( tdt level dim data -- )
+:: (allocate-compressed-texture) ( tdt level dim compressed-data dim-quot teximage-quot -- )
tdt bind-tdt :> texture
- tdt texture-data-gl-target level texture texture-gl-internal-format
- dim first2 0 texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexImage2D ] with-gpu-data-ptr ;
+ tdt texture-data-gl-target level compressed-data format>> gl-compressed-texture-format
+ dim dim-quot call 0 compressed-data [ length>> ] [ ptr>> ] bi
+ pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
-M:: texture-3d-data-target allocate-texture ( tdt level dim data -- )
- tdt bind-tdt :> texture
- tdt texture-data-gl-target level texture texture-gl-internal-format
- dim first3 0 texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexImage3D ] with-gpu-data-ptr ;
-
-GENERIC# update-texture 4 ( tdt level loc dim data -- )
-
-M:: texture-1d-data-target update-texture ( tdt level loc dim data -- )
+:: (update-texture) ( tdt level loc dim data dim-quot texsubimage-quot -- )
tdt bind-tdt :> texture
tdt texture-data-gl-target level
- loc dim texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexSubImage1D ] with-gpu-data-ptr ;
-
-M:: texture-2d-data-target update-texture ( tdt level loc dim data -- )
- tdt bind-tdt :> texture
- tdt texture-data-gl-target level
- loc dim [ first2 ] bi@
+ loc dim dim-quot bi@
texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexSubImage2D ] with-gpu-data-ptr ;
+ pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
-M:: texture-3d-data-target update-texture ( tdt level loc dim data -- )
+:: (update-compressed-texture) ( tdt level loc dim compressed-data dim-quot texsubimage-quot -- )
tdt bind-tdt :> texture
tdt texture-data-gl-target level
- loc dim [ first3 ] bi@
- texture data texture-data-gl-args
- pixel-unpack-buffer [ glTexSubImage3D ] with-gpu-data-ptr ;
+ loc dim dim-quot bi@
+ compressed-data [ format>> gl-compressed-texture-format ] [ length>> ] [ ptr>> ] tri
+ pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
+
+PRIVATE>
+
+GENERIC#: allocate-texture 3 ( tdt level dim data -- )
+
+M: texture-1d-data-target allocate-texture ( tdt level dim data -- )
+ [ ] [ glTexImage1D ] (allocate-texture) ;
+
+M: texture-2d-data-target allocate-texture ( tdt level dim data -- )
+ [ first2 ] [ glTexImage2D ] (allocate-texture) ;
+
+M: texture-3d-data-target allocate-texture ( tdt level dim data -- )
+ [ first3 ] [ glTexImage3D ] (allocate-texture) ;
+
+GENERIC#: allocate-compressed-texture 3 ( tdt level dim compressed-data -- )
+
+M: texture-1d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
+ [ ] [ glCompressedTexImage1D ] (allocate-compressed-texture) ;
+
+M: texture-2d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
+ [ first2 ] [ glCompressedTexImage2D ] (allocate-compressed-texture) ;
+
+M: texture-3d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
+ [ first3 ] [ glCompressedTexImage3D ] (allocate-compressed-texture) ;
+
+GENERIC#: update-texture 4 ( tdt level loc dim data -- )
+
+M: texture-1d-data-target update-texture ( tdt level loc dim data -- )
+ [ ] [ glTexSubImage1D ] (update-texture) ;
+
+M: texture-2d-data-target update-texture ( tdt level loc dim data -- )
+ [ first2 ] [ glTexSubImage2D ] (update-texture) ;
+
+M: texture-3d-data-target update-texture ( tdt level loc dim data -- )
+ [ first3 ] [ glTexSubImage3D ] (update-texture) ;
+
+GENERIC#: update-compressed-texture 4 ( tdt level loc dim compressed-data -- )
+
+M: texture-1d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
+ [ ] [ glCompressedTexSubImage1D ] (update-compressed-texture) ;
+
+M: texture-2d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
+ [ first2 ] [ glCompressedTexSubImage2D ] (update-compressed-texture) ;
+
+M: texture-3d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
+ [ first3 ] [ glCompressedTexSubImage3D ] (update-compressed-texture) ;
: image>texture-data ( image -- dim texture-data )
{ [ dim>> ] [ bitmap>> ] [ component-order>> ] [ component-type>> ] } cleave
<texture-data> ; inline
-GENERIC# texture-dim 1 ( tdt level -- dim )
+GENERIC#: texture-dim 1 ( tdt level -- dim )
M:: texture-1d-data-target texture-dim ( tdt level -- dim )
tdt bind-tdt :> texture
- tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ;
+ tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ; inline
M:: texture-2d-data-target texture-dim ( tdt level -- dim )
tdt bind-tdt :> texture
- tdt texture-data-gl-target level
+ tdt texture-data-gl-target level
[ GL_TEXTURE_WIDTH get-texture-int ] [ GL_TEXTURE_HEIGHT get-texture-int ] 2bi
- 2array ;
+ 2array ; inline
M:: texture-3d-data-target texture-dim ( tdt level -- dim )
tdt bind-tdt :> texture
- tdt texture-data-gl-target level
+ tdt texture-data-gl-target level
[ GL_TEXTURE_WIDTH get-texture-int ]
[ GL_TEXTURE_HEIGHT get-texture-int ]
[ GL_TEXTURE_DEPTH get-texture-int ] 2tri
- 3array ;
+ 3array ; inline
+
+: compressed-texture-data-size ( tdt level -- size )
+ [ [ bind-tdt drop ] [ texture-data-gl-target ] bi ] dip
+ GL_TEXTURE_COMPRESSED_IMAGE_SIZE get-texture-int ; inline
: texture-data-size ( tdt level -- size )
- [ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ;
+ [ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ; inline
-:: read-texture-to ( tdt level gpu-data-ptr -- )
+TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
tdt bind-tdt :> texture
tdt texture-data-gl-target level
texture [ component-order>> ] [ component-type>> ] bi image-data-format
gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ;
-: read-texture ( tdt level -- byte-array )
- 2dup texture-data-size <byte-array>
+TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
+ 2dup texture-data-size (byte-array)
[ read-texture-to ] keep ;
+TYPED:: read-compressed-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
+ tdt bind-tdt :> texture
+ tdt texture-data-gl-target level
+ gpu-data-ptr pixel-pack-buffer [ glGetCompressedTexImage ] with-gpu-data-ptr ;
+
+TYPED: read-compressed-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
+ 2dup compressed-texture-data-size (byte-array)
+ [ read-compressed-texture-to ] keep ;
+
: allocate-texture-image ( tdt level image -- )
- image>texture-data allocate-texture ;
+ image>texture-data allocate-texture ; inline
: update-texture-image ( tdt level loc image -- )
- image>texture-data update-texture ;
+ image>texture-data update-texture ; inline
: read-texture-image ( tdt level -- image )
[ texture-dim ]
- [ drop texture-object [ component-order>> ] [ component-type>> ] bi f ]
+ [ drop texture-object [ component-order>> ] [ component-type>> ] bi f f ]
[ read-texture ] 2tri
- image boa ;
+ f image boa ; inline
<PRIVATE
: bind-texture ( texture -- gl-target )
- [ texture-gl-target dup ] [ handle>> ] bi glBindTexture ;
+ [ texture-gl-target dup ] [ handle>> ] bi glBindTexture ; inline
PRIVATE>
: generate-mipmaps ( texture -- )
- bind-texture glGenerateMipmap ;
+ bind-texture glGenerateMipmap ; inline
-: set-texture-parameters ( texture parameters -- )
+TYPED: set-texture-parameters ( texture: texture parameters: texture-parameters -- )
[ bind-texture ] dip {
[ wrap>> set-texture-gl-wrap ]
[
PRIVATE>
: <texture-1d> ( component-order component-type parameters -- texture )
- texture-1d <texture> ;
+ texture-1d <texture> ; inline
: <texture-2d> ( component-order component-type parameters -- texture )
- texture-2d <texture> ;
+ texture-2d <texture> ; inline
: <texture-3d> ( component-order component-type parameters -- texture )
- texture-3d <texture> ;
+ texture-3d <texture> ; inline
: <texture-cube-map> ( component-order component-type parameters -- texture )
- texture-cube-map <texture> ;
+ texture-cube-map <texture> ; inline
: <texture-rectangle> ( component-order component-type parameters -- texture )
- texture-rectangle <texture> ;
+ texture-rectangle <texture> ; inline
: <texture-1d-array> ( component-order component-type parameters -- texture )
- texture-1d-array <texture> ;
+ texture-1d-array <texture> ; inline
: <texture-2d-array> ( component-order component-type parameters -- texture )
- texture-2d-array <texture> ;
-
+ texture-2d-array <texture> ; inline
projects / factor.git / blobdiff