extra/gpu/textures/textures.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types arrays byte-arrays combinators
   4 destructors gpu gpu.buffers images kernel math
   5 opengl.gl opengl.textures sequences
   6 specialized-arrays typed ui.gadgets.worlds variants ;
   7 FROM: alien.c-types => float ;
   8 SPECIALIZED-ARRAY: float
   9 IN: gpu.textures
  10
  11 TUPLE: texture < gpu-object
  12     { component-order component-order read-only initial: RGBA }
  13     { component-type component-type read-only initial: ubyte-components } ;
  14
  15 TUPLE: texture-1d < texture ;
  16 TUPLE: texture-2d < texture ;
  17 TUPLE: texture-rectangle < texture ;
  18 TUPLE: texture-3d < texture ;
  19 TUPLE: texture-cube-map < texture ;
  20
  21 TUPLE: texture-1d-array < texture ;
  22 TUPLE: texture-2d-array < texture ;
  23
  24 VARIANT: cube-map-axis
  25     -X -Y -Z +X +Y +Z ;
  26
  27 TUPLE: cube-map-face
  28     { texture texture-cube-map read-only }
  29     { axis cube-map-axis read-only } ;
  30 C: <cube-map-face> cube-map-face
  31
  32 UNION: texture-1d-data-target
  33     texture-1d ;
  34 UNION: texture-2d-data-target
  35     texture-2d texture-rectangle texture-1d-array cube-map-face ;
  36 UNION: texture-3d-data-target
  37     texture-3d texture-2d-array ;
  38 UNION: texture-data-target
  39     texture-1d-data-target texture-2d-data-target texture-3d-data-target ;
  40
  41 M: texture dispose
  42     [ [ delete-texture ] when* f ] change-handle drop ;
  43
  44 TUPLE: texture-data
  45     { ptr read-only }
  46     { component-order component-order read-only initial: RGBA }
  47     { component-type component-type read-only initial: ubyte-components } ;
  48
  49 C: <texture-data> texture-data
  50
  51 VARIANT: compressed-texture-format
  52     DXT1-RGB DXT1-RGBA DXT3 DXT5
  53     LATC1 LATC1-SIGNED LATC2 LATC2-SIGNED
  54     RGTC1 RGTC1-SIGNED RGTC2 RGTC2-SIGNED ;
  55
  56 TUPLE: compressed-texture-data
  57     { ptr read-only }
  58     { format compressed-texture-format read-only }
  59     { length integer read-only } ;
  60
  61 C: <compressed-texture-data> compressed-texture-data
  62
  63 VARIANT: texture-wrap
  64     clamp-texcoord-to-edge clamp-texcoord-to-border repeat-texcoord repeat-texcoord-mirrored ;
  65 VARIANT: texture-filter
  66     filter-nearest filter-linear ;
  67
  68 UNION: wrap-set texture-wrap sequence ;
  69
  70 TUPLE: texture-parameters
  71     { wrap wrap-set initial: { repeat-texcoord repeat-texcoord repeat-texcoord } }
  72     { min-filter texture-filter initial: filter-nearest }
  73     { min-mipmap-filter maybe{ texture-filter } initial: filter-linear }
  74     { mag-filter texture-filter initial: filter-linear }
  75     { min-lod integer initial: -1000 }
  76     { max-lod integer initial:  1000 }
  77     { lod-bias integer initial: 0 }
  78     { base-level integer initial: 0 }
  79     { max-level integer initial: 1000 } ;
  80
  81 <PRIVATE
  82
  83 GENERIC: texture-object ( texture-data-target -- texture )
  84 M: cube-map-face texture-object
  85     texture>> ; inline
  86 M: texture texture-object
  87     ; inline
  88
  89 : gl-compressed-texture-format ( format -- gl-format )
  90     {
  91         { DXT1-RGB     [ GL_COMPRESSED_RGB_S3TC_DXT1_EXT  ] }
  92         { DXT1-RGBA    [ GL_COMPRESSED_RGBA_S3TC_DXT1_EXT ] }
  93         { DXT3         [ GL_COMPRESSED_RGBA_S3TC_DXT3_EXT ] }
  94         { DXT5         [ GL_COMPRESSED_RGBA_S3TC_DXT5_EXT ] }
  95         { RGTC1        [ GL_COMPRESSED_RED_RGTC1          ] }
  96         { RGTC1-SIGNED [ GL_COMPRESSED_SIGNED_RED_RGTC1   ] }
  97         { RGTC2        [ GL_COMPRESSED_RG_RGTC2           ] }
  98         { RGTC2-SIGNED [ GL_COMPRESSED_SIGNED_RG_RGTC2    ] }
  99     } case ; inline
 100
 101 : gl-wrap ( wrap -- gl-wrap )
 102     {
 103         { clamp-texcoord-to-edge [ GL_CLAMP_TO_EDGE ] }
 104         { clamp-texcoord-to-border [ GL_CLAMP_TO_BORDER ] }
 105         { repeat-texcoord [ GL_REPEAT ] }
 106         { repeat-texcoord-mirrored [ GL_MIRRORED_REPEAT ] }
 107     } case ; inline
 108
 109 : set-texture-gl-wrap ( target wraps -- )
 110     dup sequence? [ 1array ] unless 3 over last pad-tail {
 111         [ [ GL_TEXTURE_WRAP_S ] dip first  gl-wrap glTexParameteri ]
 112         [ [ GL_TEXTURE_WRAP_T ] dip second gl-wrap glTexParameteri ]
 113         [ [ GL_TEXTURE_WRAP_R ] dip third  gl-wrap glTexParameteri ]
 114     } 2cleave ; inline
 115
 116 : gl-mag-filter ( filter -- gl-filter )
 117     {
 118         { filter-nearest [ GL_NEAREST ] }
 119         { filter-linear [ GL_LINEAR ] }
 120     } case ; inline
 121
 122 : gl-min-filter ( filter mipmap-filter -- gl-filter )
 123     2array {
 124         { { filter-nearest f              } [ GL_NEAREST                ] }
 125         { { filter-linear  f              } [ GL_LINEAR                 ] }
 126         { { filter-nearest filter-nearest } [ GL_NEAREST_MIPMAP_NEAREST ] }
 127         { { filter-linear  filter-nearest } [ GL_LINEAR_MIPMAP_NEAREST  ] }
 128         { { filter-linear  filter-linear  } [ GL_LINEAR_MIPMAP_LINEAR   ] }
 129         { { filter-nearest filter-linear  } [ GL_NEAREST_MIPMAP_LINEAR  ] }
 130     } case ; inline
 131
 132 GENERIC: texture-gl-target ( texture -- target )
 133 GENERIC: texture-data-gl-target ( texture -- target )
 134
 135 M: texture-1d        texture-gl-target drop GL_TEXTURE_1D ; inline
 136 M: texture-2d        texture-gl-target drop GL_TEXTURE_2D ; inline
 137 M: texture-rectangle texture-gl-target drop GL_TEXTURE_RECTANGLE ; inline
 138 M: texture-3d        texture-gl-target drop GL_TEXTURE_3D ; inline
 139 M: texture-cube-map  texture-gl-target drop GL_TEXTURE_CUBE_MAP ; inline
 140 M: texture-1d-array  texture-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
 141 M: texture-2d-array  texture-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
 142
 143 M: texture-1d        texture-data-gl-target drop GL_TEXTURE_1D ; inline
 144 M: texture-2d        texture-data-gl-target drop GL_TEXTURE_2D ; inline
 145 M: texture-rectangle texture-data-gl-target drop GL_TEXTURE_RECTANGLE ; inline
 146 M: texture-3d        texture-data-gl-target drop GL_TEXTURE_3D ; inline
 147 M: texture-1d-array  texture-data-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
 148 M: texture-2d-array  texture-data-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
 149 M: cube-map-face     texture-data-gl-target
 150     axis>> {
 151         { -X [ GL_TEXTURE_CUBE_MAP_NEGATIVE_X ] }
 152         { -Y [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Y ] }
 153         { -Z [ GL_TEXTURE_CUBE_MAP_NEGATIVE_Z ] }
 154         { +X [ GL_TEXTURE_CUBE_MAP_POSITIVE_X ] }
 155         { +Y [ GL_TEXTURE_CUBE_MAP_POSITIVE_Y ] }
 156         { +Z [ GL_TEXTURE_CUBE_MAP_POSITIVE_Z ] }
 157     } case ; inline
 158
 159 : texture-gl-internal-format ( texture -- internal-format )
 160     [ component-order>> ] [ component-type>> ] bi image-internal-format ; inline
 161
 162 : texture-data-gl-args ( texture data -- format type ptr )
 163     [
 164         nip
 165         [ [ component-order>> ] [ component-type>> ] bi image-data-format ]
 166         [ ptr>> ] bi
 167     ] [
 168         [ component-order>> ] [ component-type>> ] bi image-data-format f
 169     ] if* ; inline
 170
 171 :: bind-tdt ( tdt -- texture )
 172     tdt texture-object :> texture
 173     texture [ texture-gl-target ] [ handle>> ] bi glBindTexture
 174     texture ; inline
 175
 176 : ?product ( x -- y )
 177     dup number? [ product ] unless ; inline
 178
 179 :: (allocate-texture) ( tdt level dim data dim-quot teximage-quot -- )
 180     tdt bind-tdt :> texture
 181     tdt texture-data-gl-target level texture texture-gl-internal-format
 182     dim dim-quot call 0 texture data texture-data-gl-args
 183     pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
 184
 185 :: (allocate-compressed-texture) ( tdt level dim compressed-data dim-quot teximage-quot -- )
 186     tdt bind-tdt :> texture
 187     tdt texture-data-gl-target level compressed-data format>> gl-compressed-texture-format
 188     dim dim-quot call 0 compressed-data [ length>> ] [ ptr>> ] bi
 189     pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
 190
 191 :: (update-texture) ( tdt level loc dim data dim-quot texsubimage-quot -- )
 192     tdt bind-tdt :> texture
 193     tdt texture-data-gl-target level
 194     loc dim dim-quot bi@
 195     texture data texture-data-gl-args
 196     pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
 197
 198 :: (update-compressed-texture) ( tdt level loc dim compressed-data dim-quot texsubimage-quot -- )
 199     tdt bind-tdt :> texture
 200     tdt texture-data-gl-target level
 201     loc dim dim-quot bi@
 202     compressed-data [ format>> gl-compressed-texture-format ] [ length>> ] [ ptr>> ] tri
 203     pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
 204
 205 PRIVATE>
 206
 207 GENERIC#: allocate-texture 3 ( tdt level dim data -- )
 208
 209 M: texture-1d-data-target allocate-texture ( tdt level dim data -- )
 210     [ ] [ glTexImage1D ] (allocate-texture) ;
 211
 212 M: texture-2d-data-target allocate-texture ( tdt level dim data -- )
 213     [ first2 ] [ glTexImage2D ] (allocate-texture) ;
 214
 215 M: texture-3d-data-target allocate-texture ( tdt level dim data -- )
 216     [ first3 ] [ glTexImage3D ] (allocate-texture) ;
 217
 218 GENERIC#: allocate-compressed-texture 3 ( tdt level dim compressed-data -- )
 219
 220 M: texture-1d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
 221     [ ] [ glCompressedTexImage1D ] (allocate-compressed-texture) ;
 222
 223 M: texture-2d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
 224     [ first2 ] [ glCompressedTexImage2D ] (allocate-compressed-texture) ;
 225
 226 M: texture-3d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
 227     [ first3 ] [ glCompressedTexImage3D ] (allocate-compressed-texture) ;
 228
 229 GENERIC#: update-texture 4 ( tdt level loc dim data -- )
 230
 231 M: texture-1d-data-target update-texture ( tdt level loc dim data -- )
 232     [ ] [ glTexSubImage1D ] (update-texture) ;
 233
 234 M: texture-2d-data-target update-texture ( tdt level loc dim data -- )
 235     [ first2 ] [ glTexSubImage2D ] (update-texture) ;
 236
 237 M: texture-3d-data-target update-texture ( tdt level loc dim data -- )
 238     [ first3 ] [ glTexSubImage3D ] (update-texture) ;
 239
 240 GENERIC#: update-compressed-texture 4 ( tdt level loc dim compressed-data -- )
 241
 242 M: texture-1d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
 243     [ ] [ glCompressedTexSubImage1D ] (update-compressed-texture) ;
 244
 245 M: texture-2d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
 246     [ first2 ] [ glCompressedTexSubImage2D ] (update-compressed-texture) ;
 247
 248 M: texture-3d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
 249     [ first3 ] [ glCompressedTexSubImage3D ] (update-compressed-texture) ;
 250
 251 : image>texture-data ( image -- dim texture-data )
 252     { [ dim>> ] [ bitmap>> ] [ component-order>> ] [ component-type>> ] } cleave
 253     <texture-data> ; inline
 254
 255 GENERIC#: texture-dim 1 ( tdt level -- dim )
 256
 257 M:: texture-1d-data-target texture-dim ( tdt level -- dim )
 258     tdt bind-tdt :> texture
 259     tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ; inline
 260
 261 M:: texture-2d-data-target texture-dim ( tdt level -- dim )
 262     tdt bind-tdt :> texture
 263     tdt texture-data-gl-target level
 264     [ GL_TEXTURE_WIDTH get-texture-int ] [ GL_TEXTURE_HEIGHT get-texture-int ] 2bi
 265     2array ; inline
 266
 267 M:: texture-3d-data-target texture-dim ( tdt level -- dim )
 268     tdt bind-tdt :> texture
 269     tdt texture-data-gl-target level
 270     [ GL_TEXTURE_WIDTH get-texture-int ]
 271     [ GL_TEXTURE_HEIGHT get-texture-int ]
 272     [ GL_TEXTURE_DEPTH get-texture-int ] 2tri
 273     3array ; inline
 274
 275 : compressed-texture-data-size ( tdt level -- size )
 276     [ [ bind-tdt drop ] [ texture-data-gl-target ] bi ] dip
 277     GL_TEXTURE_COMPRESSED_IMAGE_SIZE get-texture-int ; inline
 278
 279 : texture-data-size ( tdt level -- size )
 280     [ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ; inline
 281
 282 TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
 283     tdt bind-tdt :> texture
 284     tdt texture-data-gl-target level
 285     texture [ component-order>> ] [ component-type>> ] bi image-data-format
 286     gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ;
 287
 288 TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
 289     2dup texture-data-size (byte-array)
 290     [ read-texture-to ] keep ;
 291
 292 TYPED:: read-compressed-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
 293     tdt bind-tdt :> texture
 294     tdt texture-data-gl-target level
 295     gpu-data-ptr pixel-pack-buffer [ glGetCompressedTexImage ] with-gpu-data-ptr ;
 296
 297 TYPED: read-compressed-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
 298     2dup compressed-texture-data-size (byte-array)
 299     [ read-compressed-texture-to ] keep ;
 300
 301 : allocate-texture-image ( tdt level image -- )
 302     image>texture-data allocate-texture ; inline
 303
 304 : update-texture-image ( tdt level loc image -- )
 305     image>texture-data update-texture ; inline
 306
 307 : read-texture-image ( tdt level -- image )
 308     [ texture-dim ]
 309     [ drop texture-object [ component-order>> ] [ component-type>> ] bi f f ]
 310     [ read-texture ] 2tri
 311     f image boa ; inline
 312
 313 <PRIVATE
 314 : bind-texture ( texture -- gl-target )
 315     [ texture-gl-target dup ] [ handle>> ] bi glBindTexture ; inline
 316 PRIVATE>
 317
 318 : generate-mipmaps ( texture -- )
 319     bind-texture glGenerateMipmap ; inline
 320
 321 TYPED: set-texture-parameters ( texture: texture parameters: texture-parameters -- )
 322     [ bind-texture ] dip {
 323         [ wrap>> set-texture-gl-wrap ]
 324         [
 325             [ GL_TEXTURE_MIN_FILTER ] dip
 326             [ min-filter>> ] [ min-mipmap-filter>> ] bi gl-min-filter glTexParameteri
 327         ] [
 328             [ GL_TEXTURE_MAG_FILTER ] dip
 329             mag-filter>> gl-mag-filter glTexParameteri
 330         ]
 331         [ [ GL_TEXTURE_MIN_LOD ] dip min-lod>> glTexParameteri ]
 332         [ [ GL_TEXTURE_MAX_LOD ] dip max-lod>> glTexParameteri ]
 333         [ [ GL_TEXTURE_LOD_BIAS ] dip lod-bias>> glTexParameteri ]
 334         [ [ GL_TEXTURE_BASE_LEVEL ] dip base-level>> glTexParameteri ]
 335         [ [ GL_TEXTURE_MAX_LEVEL ] dip max-level>> glTexParameteri ]
 336     } 2cleave ;
 337
 338 <PRIVATE
 339
 340 : <texture> ( component-order component-type parameters class -- texture )
 341     '[ [ gen-texture ] 2dip _ boa dup window-resource ] dip
 342     [ T{ texture-parameters } clone ] unless* set-texture-parameters ; inline
 343
 344 PRIVATE>
 345
 346 : <texture-1d> ( component-order component-type parameters -- texture )
 347     texture-1d <texture> ; inline
 348 : <texture-2d> ( component-order component-type parameters -- texture )
 349     texture-2d <texture> ; inline
 350 : <texture-3d> ( component-order component-type parameters -- texture )
 351     texture-3d <texture> ; inline
 352 : <texture-cube-map> ( component-order component-type parameters -- texture )
 353     texture-cube-map <texture> ; inline
 354 : <texture-rectangle> ( component-order component-type parameters -- texture )
 355     texture-rectangle <texture> ; inline
 356 : <texture-1d-array> ( component-order component-type parameters -- texture )
 357     texture-1d-array <texture> ; inline
 358 : <texture-2d-array> ( component-order component-type parameters -- texture )
 359     texture-2d-array <texture> ; inline