]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/gpu/textures/textures.factor
factor: trim using lists
[factor.git] / extra / gpu / textures / textures.factor
index ba2e2c32a0bd527ec4a0efe7598521af76f83f0c..6f72e2138eefb57e65a758c1c262f9dc7074fb79 100644 (file)
@@ -1,7 +1,8 @@
-! (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
+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
@@ -46,8 +47,18 @@ TUPLE: texture-data
     { 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 ;
@@ -55,12 +66,11 @@ VARIANT: texture-filter
     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 }
@@ -76,6 +86,18 @@ M: cube-map-face texture-object
 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-edge [ GL_CLAMP_TO_EDGE ] }
@@ -151,81 +173,108 @@ M: cube-map-face     texture-data-gl-target
     texture [ texture-gl-target ] [ handle>> ] bi glBindTexture
     texture ; inline
 
-: get-texture-float ( target level enum -- value )
-    0 <float> [ glGetTexLevelParameterfv ] keep *float ; inline
-: get-texture-int ( target level enum -- value )
-    0 <int> [ glGetTexLevelParameteriv ] keep *int ; inline
-
 : ?product ( x -- y )
     dup number? [ product ] unless ; inline
 
-PRIVATE>
-
-GENERIC# allocate-texture 3 ( tdt level dim data -- )
-
-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 * ; inline
@@ -237,9 +286,18 @@ TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -
     gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ;
 
 TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
-    2dup texture-data-size <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 ; inline
 
@@ -248,9 +306,9 @@ TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byt
 
 : 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 ]
     [ read-texture ] 2tri
-    image boa ; inline
+    image boa ; inline
 
 <PRIVATE
 : bind-texture ( texture -- gl-target )
@@ -299,4 +357,3 @@ PRIVATE>
     texture-1d-array <texture> ; inline
 : <texture-2d-array> ( component-order component-type parameters -- texture )
     texture-2d-array <texture> ; inline
-