provide image component-orders and component-types for all GPU texture formats
							parent
							
								
									c051665efb
								
							
						
					
					
						commit
						eaddd1fdd4
					
				| 
						 | 
				
			
			@ -5,31 +5,50 @@ IN: images
 | 
			
		|||
 | 
			
		||||
SINGLETONS:
 | 
			
		||||
    A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 | 
			
		||||
    INTENSITY DEPTH R RG
 | 
			
		||||
    ubyte-components ushort-components
 | 
			
		||||
    INTENSITY DEPTH DEPTH-STENCIL R RG
 | 
			
		||||
    ubyte-components ushort-components uint-components
 | 
			
		||||
    half-components float-components
 | 
			
		||||
    byte-integer-components ubyte-integer-components
 | 
			
		||||
    short-integer-components ushort-integer-components
 | 
			
		||||
    int-integer-components uint-integer-components ;
 | 
			
		||||
    int-integer-components uint-integer-components
 | 
			
		||||
    u-5-5-5-1-components u-5-6-5-components
 | 
			
		||||
    u-10-10-10-2-components
 | 
			
		||||
    u-24-components u-24-8-components
 | 
			
		||||
    u-9-9-9-e5-components
 | 
			
		||||
    float-11-11-10-components ;
 | 
			
		||||
 | 
			
		||||
UNION: component-order 
 | 
			
		||||
    A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 | 
			
		||||
    INTENSITY DEPTH R RG ;
 | 
			
		||||
    INTENSITY DEPTH DEPTH-STENCIL R RG ;
 | 
			
		||||
 | 
			
		||||
UNION: component-type
 | 
			
		||||
    ubyte-components ushort-components
 | 
			
		||||
    half-components float-components
 | 
			
		||||
    byte-integer-components ubyte-integer-components
 | 
			
		||||
    short-integer-components ushort-integer-components
 | 
			
		||||
    int-integer-components uint-integer-components ;
 | 
			
		||||
    int-integer-components uint-integer-components
 | 
			
		||||
    u-5-5-5-1-components u-5-6-5-components
 | 
			
		||||
    u-10-10-10-2-components
 | 
			
		||||
    u-24-components u-24-8-components
 | 
			
		||||
    u-9-9-9-e5-components
 | 
			
		||||
    float-11-11-10-components ;
 | 
			
		||||
 | 
			
		||||
UNION: unnormalized-integer-components
 | 
			
		||||
    byte-integer-components ubyte-integer-components
 | 
			
		||||
    short-integer-components ushort-integer-components
 | 
			
		||||
    int-integer-components uint-integer-components ;
 | 
			
		||||
 | 
			
		||||
UNION: packed-components
 | 
			
		||||
    u-5-5-5-1-components u-5-6-5-components
 | 
			
		||||
    u-10-10-10-2-components
 | 
			
		||||
    u-24-components u-24-8-components
 | 
			
		||||
    u-9-9-9-e5-components
 | 
			
		||||
    float-11-11-10-components ;
 | 
			
		||||
 | 
			
		||||
UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
 | 
			
		||||
 | 
			
		||||
UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
 | 
			
		||||
 | 
			
		||||
TUPLE: image dim component-order component-type upside-down? bitmap ;
 | 
			
		||||
 | 
			
		||||
: <image> ( -- image ) image new ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -38,14 +57,11 @@ TUPLE: image dim component-order component-type upside-down? bitmap ;
 | 
			
		|||
 | 
			
		||||
GENERIC: load-image* ( path class -- image )
 | 
			
		||||
 | 
			
		||||
DEFER: bytes-per-pixel
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: bytes-per-component ( component-type -- n )
 | 
			
		||||
    {
 | 
			
		||||
        { ubyte-components [ 1 ] }
 | 
			
		||||
        { ushort-components [ 2 ] }
 | 
			
		||||
        { uint-components [ 4 ] }
 | 
			
		||||
        { half-components [ 2 ] }
 | 
			
		||||
        { float-components [ 4 ] }
 | 
			
		||||
        { byte-integer-components [ 1 ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -56,6 +72,17 @@ DEFER: bytes-per-pixel
 | 
			
		|||
        { uint-integer-components [ 4 ] }
 | 
			
		||||
    } case ;
 | 
			
		||||
 | 
			
		||||
: bytes-per-packed-pixel ( component-type -- n )
 | 
			
		||||
    {
 | 
			
		||||
        { u-5-5-5-1-components [ 2 ] }
 | 
			
		||||
        { u-5-6-5-components [ 2 ] }
 | 
			
		||||
        { u-10-10-10-2-components [ 4 ] }
 | 
			
		||||
        { u-24-components [ 4 ] }
 | 
			
		||||
        { u-24-8-components [ 4 ] }
 | 
			
		||||
        { u-9-9-9-e5-components [ 4 ] }
 | 
			
		||||
        { float-11-11-10-components [ 4 ] }
 | 
			
		||||
    } case ;
 | 
			
		||||
 | 
			
		||||
: component-count ( component-order -- n )
 | 
			
		||||
    {
 | 
			
		||||
        { A [ 1 ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -73,10 +100,20 @@ DEFER: bytes-per-pixel
 | 
			
		|||
        { XBGR [ 4 ] }
 | 
			
		||||
        { INTENSITY [ 1 ] }
 | 
			
		||||
        { DEPTH [ 1 ] }
 | 
			
		||||
        { DEPTH-STENCIL [ 1 ] }
 | 
			
		||||
        { R [ 1 ] }
 | 
			
		||||
        { RG [ 2 ] }
 | 
			
		||||
    } case ;
 | 
			
		||||
 | 
			
		||||
: bytes-per-pixel ( image -- n )
 | 
			
		||||
    dup component-type>> packed-components?
 | 
			
		||||
    [ component-type>> bytes-per-packed-pixel ] [
 | 
			
		||||
        [ component-order>> component-count ]
 | 
			
		||||
        [ component-type>>  bytes-per-component ] bi *
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: pixel@ ( x y image -- start end bitmap )
 | 
			
		||||
    [ dim>> first * + ]
 | 
			
		||||
    [ bytes-per-pixel [ * dup ] keep + ]
 | 
			
		||||
| 
						 | 
				
			
			@ -87,10 +124,6 @@ DEFER: bytes-per-pixel
 | 
			
		|||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: bytes-per-pixel ( image -- n )
 | 
			
		||||
    [ component-order>> component-count ]
 | 
			
		||||
    [ component-type>>  bytes-per-component ] bi * ;
 | 
			
		||||
 | 
			
		||||
: pixel-at ( x y image -- pixel )
 | 
			
		||||
    pixel@ subseq ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1803,6 +1803,35 @@ CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
 | 
			
		|||
CONSTANT: GL_HALF_FLOAT_ARB HEX: 140B
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_ARB_texture_rg
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
CONSTANT: GL_R8              HEX: 8229
 | 
			
		||||
CONSTANT: GL_R16             HEX: 822A
 | 
			
		||||
CONSTANT: GL_RG8             HEX: 822B
 | 
			
		||||
CONSTANT: GL_RG16            HEX: 822C
 | 
			
		||||
CONSTANT: GL_R16F            HEX: 822D
 | 
			
		||||
CONSTANT: GL_R32F            HEX: 822E
 | 
			
		||||
CONSTANT: GL_RG16F           HEX: 822F
 | 
			
		||||
CONSTANT: GL_RG32F           HEX: 8230
 | 
			
		||||
CONSTANT: GL_R8I             HEX: 8231
 | 
			
		||||
CONSTANT: GL_R8UI            HEX: 8232
 | 
			
		||||
CONSTANT: GL_R16I            HEX: 8233
 | 
			
		||||
CONSTANT: GL_R16UI           HEX: 8234
 | 
			
		||||
CONSTANT: GL_R32I            HEX: 8235
 | 
			
		||||
CONSTANT: GL_R32UI           HEX: 8236
 | 
			
		||||
CONSTANT: GL_RG8I            HEX: 8237
 | 
			
		||||
CONSTANT: GL_RG8UI           HEX: 8238
 | 
			
		||||
CONSTANT: GL_RG16I           HEX: 8239
 | 
			
		||||
CONSTANT: GL_RG16UI          HEX: 823A
 | 
			
		||||
CONSTANT: GL_RG32I           HEX: 823B
 | 
			
		||||
CONSTANT: GL_RG32UI          HEX: 823C
 | 
			
		||||
CONSTANT: GL_RG              HEX: 8227
 | 
			
		||||
CONSTANT: GL_COMPRESSED_RED  HEX: 8225
 | 
			
		||||
CONSTANT: GL_COMPRESSED_RG   HEX: 8226
 | 
			
		||||
CONSTANT: GL_RG_INTEGER      HEX: 8228
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_ARB_texture_float
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -1917,6 +1946,31 @@ CONSTANT: GL_SAMPLER_2D_RECT_ARB              HEX: 8B63
 | 
			
		|||
CONSTANT: GL_SAMPLER_2D_RECT_SHADOW_ARB       HEX: 8B64
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_EXT_packed_depth_stencil
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
CONSTANT: GL_DEPTH_STENCIL_EXT         HEX: 84F9
 | 
			
		||||
CONSTANT: GL_UNSIGNED_INT_24_8_EXT     HEX: 84FA
 | 
			
		||||
CONSTANT: GL_DEPTH24_STENCIL8_EXT      HEX: 88F0
 | 
			
		||||
CONSTANT: GL_TEXTURE_STENCIL_SIZE_EXT  HEX: 88F1
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_EXT_texture_shared_exponent
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
CONSTANT: GL_RGB9_E5_EXT                   HEX: 8C3D
 | 
			
		||||
CONSTANT: GL_UNSIGNED_INT_5_9_9_9_REV_EXT  HEX: 8C3E
 | 
			
		||||
CONSTANT: GL_TEXTURE_SHARED_SIZE_EXT       HEX: 8C3F
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_EXT_packed_float
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
CONSTANT: GL_R11F_G11F_B10F_EXT                HEX: 8C3A
 | 
			
		||||
CONSTANT: GL_UNSIGNED_INT_10F_11F_11F_REV_EXT  HEX: 8C3B
 | 
			
		||||
CONSTANT: GL_RGBA_SIGNED_COMPONENTS_EXT        HEX: 8C3C
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! GL_EXT_geometry_shader4
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: tools.test opengl.textures opengl.textures.private
 | 
			
		||||
images kernel namespaces accessors sequences ;
 | 
			
		||||
USING: tools.test opengl.gl opengl.textures opengl.textures.private
 | 
			
		||||
images kernel namespaces accessors sequences literals ;
 | 
			
		||||
IN: opengl.textures.tests
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
| 
						 | 
				
			
			@ -15,4 +15,25 @@ IN: opengl.textures.tests
 | 
			
		|||
        { { 10 30 } { 30 300 } }
 | 
			
		||||
    }
 | 
			
		||||
    [ [ image new swap >>dim ] map ] map image-locs
 | 
			
		||||
] unit-test
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGBA8 GL_RGBA GL_UNSIGNED_BYTE }
 | 
			
		||||
[ RGBA ubyte-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGBA8 GL_BGRA GL_UNSIGNED_BYTE }
 | 
			
		||||
[ BGRA ubyte-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGBA8 GL_BGRA GL_UNSIGNED_INT_8_8_8_8_REV }
 | 
			
		||||
[ ARGB ubyte-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGBA32F_ARB GL_RGBA GL_FLOAT }
 | 
			
		||||
[ RGBA float-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGBA32UI_EXT GL_BGRA_INTEGER_EXT GL_UNSIGNED_INT }
 | 
			
		||||
[ BGRA uint-integer-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_RGB9_E5_EXT GL_RGB GL_UNSIGNED_INT_5_9_9_9_REV_EXT }
 | 
			
		||||
[ BGR u-9-9-9-e5-components (image-format) ] unit-test
 | 
			
		||||
 | 
			
		||||
${ GL_R11F_G11F_B10F_EXT GL_RGB GL_UNSIGNED_INT_10F_11F_11F_REV_EXT }
 | 
			
		||||
[ BGR float-11-11-10-components (image-format) ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,7 +4,7 @@ USING: accessors assocs cache colors.constants destructors kernel
 | 
			
		|||
opengl opengl.gl opengl.capabilities combinators images
 | 
			
		||||
images.tesselation grouping specialized-arrays.float sequences math
 | 
			
		||||
math.vectors math.matrices generalizations fry arrays namespaces
 | 
			
		||||
system locals ;
 | 
			
		||||
system locals literals ;
 | 
			
		||||
IN: opengl.textures
 | 
			
		||||
 | 
			
		||||
SYMBOL: non-power-of-2-textures?
 | 
			
		||||
| 
						 | 
				
			
			@ -22,46 +22,233 @@ SYMBOL: non-power-of-2-textures?
 | 
			
		|||
 | 
			
		||||
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
 | 
			
		||||
 | 
			
		||||
GENERIC: component-type>type ( component-type -- internal-format type )
 | 
			
		||||
GENERIC: component-order>format ( type component-order -- type format )
 | 
			
		||||
GENERIC: component-order>integer-format ( type component-order -- type format )
 | 
			
		||||
ERROR: unsupported-component-order component-order component-type ;
 | 
			
		||||
 | 
			
		||||
ERROR: unsupported-component-order component-order ;
 | 
			
		||||
CONSTANT: image-internal-formats H{
 | 
			
		||||
    { { A         ubyte-components          } $ GL_ALPHA8            }
 | 
			
		||||
    { { A         ushort-components         } $ GL_ALPHA16           }
 | 
			
		||||
    { { A         half-components           } $ GL_ALPHA16F_ARB      }
 | 
			
		||||
    { { A         float-components          } $ GL_ALPHA32F_ARB      }
 | 
			
		||||
    { { A         byte-integer-components   } $ GL_ALPHA8I_EXT       }
 | 
			
		||||
    { { A         ubyte-integer-components  } $ GL_ALPHA8UI_EXT      }
 | 
			
		||||
    { { A         short-integer-components  } $ GL_ALPHA16I_EXT      }
 | 
			
		||||
    { { A         ushort-integer-components } $ GL_ALPHA16UI_EXT     }
 | 
			
		||||
    { { A         int-integer-components    } $ GL_ALPHA32I_EXT      }
 | 
			
		||||
    { { A         uint-integer-components   } $ GL_ALPHA32UI_EXT     }
 | 
			
		||||
 | 
			
		||||
M: ubyte-components component-type>type drop GL_RGBA8 GL_UNSIGNED_BYTE ;
 | 
			
		||||
M: ushort-components component-type>type drop GL_RGBA16 GL_UNSIGNED_SHORT ;
 | 
			
		||||
M: half-components component-type>type drop GL_RGBA16F_ARB GL_HALF_FLOAT_ARB ;
 | 
			
		||||
M: float-components component-type>type drop GL_RGBA32F_ARB GL_FLOAT ;
 | 
			
		||||
M: byte-integer-components component-type>type drop GL_RGBA8I_EXT GL_BYTE ;
 | 
			
		||||
M: short-integer-components component-type>type drop GL_RGBA16I_EXT GL_SHORT ;
 | 
			
		||||
M: int-integer-components component-type>type drop GL_RGBA32I_EXT GL_INT ;
 | 
			
		||||
M: ubyte-integer-components component-type>type drop GL_RGBA8I_EXT GL_UNSIGNED_BYTE ;
 | 
			
		||||
M: ushort-integer-components component-type>type drop GL_RGBA16I_EXT GL_UNSIGNED_SHORT ;
 | 
			
		||||
M: uint-integer-components component-type>type drop GL_RGBA32I_EXT GL_UNSIGNED_INT ;
 | 
			
		||||
    { { L         ubyte-components          } $ GL_LUMINANCE8        }
 | 
			
		||||
    { { L         ushort-components         } $ GL_LUMINANCE16       }
 | 
			
		||||
    { { L         half-components           } $ GL_LUMINANCE16F_ARB  }
 | 
			
		||||
    { { L         float-components          } $ GL_LUMINANCE32F_ARB  }
 | 
			
		||||
    { { L         byte-integer-components   } $ GL_LUMINANCE8I_EXT   }
 | 
			
		||||
    { { L         ubyte-integer-components  } $ GL_LUMINANCE8UI_EXT  }
 | 
			
		||||
    { { L         short-integer-components  } $ GL_LUMINANCE16I_EXT  }
 | 
			
		||||
    { { L         ushort-integer-components } $ GL_LUMINANCE16UI_EXT }
 | 
			
		||||
    { { L         int-integer-components    } $ GL_LUMINANCE32I_EXT  }
 | 
			
		||||
    { { L         uint-integer-components   } $ GL_LUMINANCE32UI_EXT }
 | 
			
		||||
 | 
			
		||||
M: RGB component-order>format drop GL_RGB ;
 | 
			
		||||
M: BGR component-order>format drop GL_BGR ;
 | 
			
		||||
M: RGBA component-order>format drop GL_RGBA ;
 | 
			
		||||
M: ARGB component-order>format
 | 
			
		||||
    swap GL_UNSIGNED_BYTE =
 | 
			
		||||
    [ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA ]
 | 
			
		||||
    { { R         ubyte-components          } $ GL_R8    }
 | 
			
		||||
    { { R         ushort-components         } $ GL_R16   }
 | 
			
		||||
    { { R         half-components           } $ GL_R16F  }
 | 
			
		||||
    { { R         float-components          } $ GL_R32F  }
 | 
			
		||||
    { { R         byte-integer-components   } $ GL_R8I   }
 | 
			
		||||
    { { R         ubyte-integer-components  } $ GL_R8UI  }
 | 
			
		||||
    { { R         short-integer-components  } $ GL_R16I  }
 | 
			
		||||
    { { R         ushort-integer-components } $ GL_R16UI }
 | 
			
		||||
    { { R         int-integer-components    } $ GL_R32I  }
 | 
			
		||||
    { { R         uint-integer-components   } $ GL_R32UI }
 | 
			
		||||
 | 
			
		||||
    { { INTENSITY ubyte-components          } $ GL_INTENSITY8        }
 | 
			
		||||
    { { INTENSITY ushort-components         } $ GL_INTENSITY16       }
 | 
			
		||||
    { { INTENSITY half-components           } $ GL_INTENSITY16F_ARB  }
 | 
			
		||||
    { { INTENSITY float-components          } $ GL_INTENSITY32F_ARB  }
 | 
			
		||||
    { { INTENSITY byte-integer-components   } $ GL_INTENSITY8I_EXT   }
 | 
			
		||||
    { { INTENSITY ubyte-integer-components  } $ GL_INTENSITY8UI_EXT  }
 | 
			
		||||
    { { INTENSITY short-integer-components  } $ GL_INTENSITY16I_EXT  }
 | 
			
		||||
    { { INTENSITY ushort-integer-components } $ GL_INTENSITY16UI_EXT }
 | 
			
		||||
    { { INTENSITY int-integer-components    } $ GL_INTENSITY32I_EXT  }
 | 
			
		||||
    { { INTENSITY uint-integer-components   } $ GL_INTENSITY32UI_EXT }
 | 
			
		||||
 | 
			
		||||
    { { DEPTH     ushort-components         } $ GL_DEPTH_COMPONENT16 }
 | 
			
		||||
    { { DEPTH     u-24-components           } $ GL_DEPTH_COMPONENT24 }
 | 
			
		||||
    { { DEPTH     uint-components           } $ GL_DEPTH_COMPONENT32 }
 | 
			
		||||
 | 
			
		||||
    { { LA        ubyte-components          } $ GL_LUMINANCE8_ALPHA8       }
 | 
			
		||||
    { { LA        ushort-components         } $ GL_LUMINANCE16_ALPHA16     }
 | 
			
		||||
    { { LA        half-components           } $ GL_LUMINANCE_ALPHA16F_ARB  }
 | 
			
		||||
    { { LA        float-components          } $ GL_LUMINANCE_ALPHA32F_ARB  }
 | 
			
		||||
    { { LA        byte-integer-components   } $ GL_LUMINANCE_ALPHA8I_EXT   }
 | 
			
		||||
    { { LA        ubyte-integer-components  } $ GL_LUMINANCE_ALPHA8UI_EXT  }
 | 
			
		||||
    { { LA        short-integer-components  } $ GL_LUMINANCE_ALPHA16I_EXT  }
 | 
			
		||||
    { { LA        ushort-integer-components } $ GL_LUMINANCE_ALPHA16UI_EXT }
 | 
			
		||||
    { { LA        int-integer-components    } $ GL_LUMINANCE_ALPHA32I_EXT  }
 | 
			
		||||
    { { LA        uint-integer-components   } $ GL_LUMINANCE_ALPHA32UI_EXT }
 | 
			
		||||
 | 
			
		||||
    { { RG        ubyte-components          } $ GL_RG8    }
 | 
			
		||||
    { { RG        ushort-components         } $ GL_RG16   }
 | 
			
		||||
    { { RG        half-components           } $ GL_RG16F  }
 | 
			
		||||
    { { RG        float-components          } $ GL_RG32F  }
 | 
			
		||||
    { { RG        byte-integer-components   } $ GL_RG8I   }
 | 
			
		||||
    { { RG        ubyte-integer-components  } $ GL_RG8UI  }
 | 
			
		||||
    { { RG        short-integer-components  } $ GL_RG16I  }
 | 
			
		||||
    { { RG        ushort-integer-components } $ GL_RG16UI }
 | 
			
		||||
    { { RG        int-integer-components    } $ GL_RG32I  }
 | 
			
		||||
    { { RG        uint-integer-components   } $ GL_RG32UI }
 | 
			
		||||
 | 
			
		||||
    { { DEPTH-STENCIL u-24-8-components     } $ GL_DEPTH24_STENCIL8_EXT }
 | 
			
		||||
 | 
			
		||||
    { { RGB       ubyte-components          } $ GL_RGB8               }
 | 
			
		||||
    { { RGB       ushort-components         } $ GL_RGB16              }
 | 
			
		||||
    { { RGB       half-components           } $ GL_RGB16F_ARB         }
 | 
			
		||||
    { { RGB       float-components          } $ GL_RGB32F_ARB         }
 | 
			
		||||
    { { RGB       byte-integer-components   } $ GL_RGB8I_EXT          }
 | 
			
		||||
    { { RGB       ubyte-integer-components  } $ GL_RGB8UI_EXT         }
 | 
			
		||||
    { { RGB       byte-integer-components   } $ GL_RGB8I_EXT          }
 | 
			
		||||
    { { RGB       ubyte-integer-components  } $ GL_RGB8UI_EXT         }
 | 
			
		||||
    { { RGB       short-integer-components  } $ GL_RGB16I_EXT         }
 | 
			
		||||
    { { RGB       ushort-integer-components } $ GL_RGB16UI_EXT        }
 | 
			
		||||
    { { RGB       int-integer-components    } $ GL_RGB32I_EXT         }
 | 
			
		||||
    { { RGB       uint-integer-components   } $ GL_RGB32UI_EXT        }
 | 
			
		||||
    { { RGB       u-5-6-5-components        } $ GL_RGB5               }
 | 
			
		||||
    { { RGB       u-9-9-9-e5-components     } $ GL_RGB9_E5_EXT        }
 | 
			
		||||
    { { RGB       float-11-11-10-components } $ GL_R11F_G11F_B10F_EXT }
 | 
			
		||||
 | 
			
		||||
    { { RGBA      ubyte-components          } $ GL_RGBA8              }
 | 
			
		||||
    { { RGBA      ushort-components         } $ GL_RGBA16             }
 | 
			
		||||
    { { RGBA      half-components           } $ GL_RGBA16F_ARB        }
 | 
			
		||||
    { { RGBA      float-components          } $ GL_RGBA32F_ARB        }
 | 
			
		||||
    { { RGBA      byte-integer-components   } $ GL_RGBA8I_EXT         }
 | 
			
		||||
    { { RGBA      ubyte-integer-components  } $ GL_RGBA8UI_EXT        }
 | 
			
		||||
    { { RGBA      byte-integer-components   } $ GL_RGBA8I_EXT         }
 | 
			
		||||
    { { RGBA      ubyte-integer-components  } $ GL_RGBA8UI_EXT        }
 | 
			
		||||
    { { RGBA      short-integer-components  } $ GL_RGBA16I_EXT        }
 | 
			
		||||
    { { RGBA      ushort-integer-components } $ GL_RGBA16UI_EXT       }
 | 
			
		||||
    { { RGBA      int-integer-components    } $ GL_RGBA32I_EXT        }
 | 
			
		||||
    { { RGBA      uint-integer-components   } $ GL_RGBA32UI_EXT       }
 | 
			
		||||
    { { RGBA      u-5-5-5-1-components      } $ GL_RGB5_A1            }
 | 
			
		||||
    { { RGBA      u-10-10-10-2-components   } $ GL_RGB10_A2           }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
GENERIC: fix-internal-component-order ( order -- order' )
 | 
			
		||||
 | 
			
		||||
M: object fix-internal-component-order ;
 | 
			
		||||
M: BGR fix-internal-component-order drop RGB ;
 | 
			
		||||
M: BGRA fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: ARGB fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: ABGR fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: RGBX fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: BGRX fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: XRGB fix-internal-component-order drop RGBA ;
 | 
			
		||||
M: XBGR fix-internal-component-order drop RGBA ;
 | 
			
		||||
 | 
			
		||||
: image-internal-format ( component-order component-type -- internal-format )
 | 
			
		||||
    2dup
 | 
			
		||||
    [ fix-internal-component-order ] dip 2array image-internal-formats at
 | 
			
		||||
    [ 2nip ] [ unsupported-component-order ] if* ;
 | 
			
		||||
 | 
			
		||||
: reversed-type? ( component-type -- ? )
 | 
			
		||||
    { u-9-9-9-e5-components float-11-11-10-components } member? ;
 | 
			
		||||
 | 
			
		||||
: (component-order>format) ( component-order component-type -- gl-format )
 | 
			
		||||
    dup unnormalized-integer-components? [
 | 
			
		||||
        swap {
 | 
			
		||||
            { A [ drop GL_ALPHA_INTEGER_EXT ] }
 | 
			
		||||
            { L [ drop GL_LUMINANCE_INTEGER_EXT ] }
 | 
			
		||||
            { R [ drop GL_RED_INTEGER_EXT ] }
 | 
			
		||||
            { LA [ drop GL_LUMINANCE_ALPHA_INTEGER_EXT ] }
 | 
			
		||||
            { RG [ drop GL_RG_INTEGER ] }
 | 
			
		||||
            { BGR [ drop GL_BGR_INTEGER_EXT ] }
 | 
			
		||||
            { RGB [ drop GL_RGB_INTEGER_EXT ] }
 | 
			
		||||
            { BGRA [ drop GL_BGRA_INTEGER_EXT ] }
 | 
			
		||||
            { RGBA [ drop GL_RGBA_INTEGER_EXT ] }
 | 
			
		||||
            { BGRX [ drop GL_BGRA_INTEGER_EXT ] }
 | 
			
		||||
            { RGBX [ drop GL_RGBA_INTEGER_EXT ] }
 | 
			
		||||
            [ swap unsupported-component-order ]
 | 
			
		||||
        } case
 | 
			
		||||
    ] [
 | 
			
		||||
        swap {
 | 
			
		||||
            { A [ drop GL_ALPHA ] }
 | 
			
		||||
            { L [ drop GL_LUMINANCE ] }
 | 
			
		||||
            { R [ drop GL_RED ] }
 | 
			
		||||
            { LA [ drop GL_LUMINANCE_ALPHA ] }
 | 
			
		||||
            { RG [ drop GL_RG ] }
 | 
			
		||||
            { BGR [ reversed-type? GL_RGB GL_BGR ? ] }
 | 
			
		||||
            { RGB [ reversed-type? GL_BGR GL_RGB ? ] }
 | 
			
		||||
            { BGRA [ drop GL_BGRA ] }
 | 
			
		||||
            { RGBA [ drop GL_RGBA ] }
 | 
			
		||||
            { ARGB [ drop GL_BGRA ] }
 | 
			
		||||
            { ABGR [ drop GL_RGBA ] }
 | 
			
		||||
            { BGRX [ drop GL_BGRA ] }
 | 
			
		||||
            { RGBX [ drop GL_RGBA ] }
 | 
			
		||||
            { XRGB [ drop GL_BGRA ] }
 | 
			
		||||
            { XBGR [ drop GL_RGBA ] }
 | 
			
		||||
            { INTENSITY [ drop GL_INTENSITY ] }
 | 
			
		||||
            { DEPTH [ drop GL_DEPTH_COMPONENT ] }
 | 
			
		||||
            { DEPTH-STENCIL [ drop GL_DEPTH_STENCIL_EXT ] }
 | 
			
		||||
            [ swap unsupported-component-order ]
 | 
			
		||||
        } case
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
GENERIC: (component-type>type) ( component-order component-type -- gl-type )
 | 
			
		||||
 | 
			
		||||
M: object (component-type>type) unsupported-component-order ;
 | 
			
		||||
 | 
			
		||||
: four-channel-alpha-first? ( component-order component-type -- ? )
 | 
			
		||||
    over component-count 4 =
 | 
			
		||||
    [ drop alpha-channel-precedes-colors? ]
 | 
			
		||||
    [ unsupported-component-order ] if ;
 | 
			
		||||
M: BGRA component-order>format drop GL_BGRA ;
 | 
			
		||||
M: BGRX component-order>format drop GL_BGRA ;
 | 
			
		||||
M: LA component-order>format drop GL_LUMINANCE_ALPHA ;
 | 
			
		||||
M: L component-order>format drop GL_LUMINANCE ;
 | 
			
		||||
 | 
			
		||||
M: object component-order>format unsupported-component-order ;
 | 
			
		||||
: not-alpha-first ( component-order component-type -- )
 | 
			
		||||
    over alpha-channel-precedes-colors?
 | 
			
		||||
    [ unsupported-component-order ]
 | 
			
		||||
    [ 2drop ] if ;
 | 
			
		||||
 | 
			
		||||
M: RGB component-order>integer-format drop GL_RGB_INTEGER_EXT ;
 | 
			
		||||
M: BGR component-order>integer-format drop GL_BGR_INTEGER_EXT ;
 | 
			
		||||
M: RGBA component-order>integer-format drop GL_RGBA_INTEGER_EXT ;
 | 
			
		||||
M: BGRA component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
 | 
			
		||||
M: BGRX component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
 | 
			
		||||
M: LA component-order>integer-format drop GL_LUMINANCE_ALPHA_INTEGER_EXT ;
 | 
			
		||||
M: L component-order>integer-format drop GL_LUMINANCE_INTEGER_EXT ;
 | 
			
		||||
M: ubyte-components          (component-type>type)
 | 
			
		||||
    drop alpha-channel-precedes-colors?
 | 
			
		||||
    [ GL_UNSIGNED_INT_8_8_8_8_REV ]
 | 
			
		||||
    [ GL_UNSIGNED_BYTE ] if ;
 | 
			
		||||
 | 
			
		||||
M: object component-order>integer-format unsupported-component-order ;
 | 
			
		||||
M: ushort-components         (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
 | 
			
		||||
M: uint-components           (component-type>type) not-alpha-first GL_UNSIGNED_INT   ;
 | 
			
		||||
M: half-components           (component-type>type) not-alpha-first GL_HALF_FLOAT_ARB ;
 | 
			
		||||
M: float-components          (component-type>type) not-alpha-first GL_FLOAT          ;
 | 
			
		||||
M: byte-integer-components   (component-type>type) not-alpha-first GL_BYTE           ;
 | 
			
		||||
M: ubyte-integer-components  (component-type>type) not-alpha-first GL_UNSIGNED_BYTE  ;
 | 
			
		||||
M: short-integer-components  (component-type>type) not-alpha-first GL_SHORT          ;
 | 
			
		||||
M: ushort-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
 | 
			
		||||
M: int-integer-components    (component-type>type) not-alpha-first GL_INT            ;
 | 
			
		||||
M: uint-integer-components   (component-type>type) not-alpha-first GL_UNSIGNED_INT   ;
 | 
			
		||||
 | 
			
		||||
M: u-5-5-5-1-components      (component-type>type)
 | 
			
		||||
    four-channel-alpha-first?
 | 
			
		||||
    [ GL_UNSIGNED_SHORT_1_5_5_5_REV ]
 | 
			
		||||
    [ GL_UNSIGNED_SHORT_5_5_5_1     ] if ;
 | 
			
		||||
 | 
			
		||||
M: u-5-6-5-components        (component-type>type) 2drop GL_UNSIGNED_SHORT_5_6_5 ;
 | 
			
		||||
 | 
			
		||||
M: u-10-10-10-2-components   (component-type>type)
 | 
			
		||||
    four-channel-alpha-first?
 | 
			
		||||
    [ GL_UNSIGNED_INT_2_10_10_10_REV ]
 | 
			
		||||
    [ GL_UNSIGNED_INT_10_10_10_2     ] if ;
 | 
			
		||||
 | 
			
		||||
M: u-24-components           (component-type>type)
 | 
			
		||||
    over DEPTH =
 | 
			
		||||
    [ 2drop GL_UNSIGNED_INT ] [ unsupported-component-order ] if ;
 | 
			
		||||
 | 
			
		||||
M: u-24-8-components         (component-type>type)
 | 
			
		||||
    over DEPTH-STENCIL =
 | 
			
		||||
    [ 2drop GL_UNSIGNED_INT_24_8_EXT ] [ unsupported-component-order ] if ;
 | 
			
		||||
 | 
			
		||||
M: u-9-9-9-e5-components     (component-type>type)
 | 
			
		||||
    over BGR =
 | 
			
		||||
    [ 2drop GL_UNSIGNED_INT_5_9_9_9_REV_EXT ] [ unsupported-component-order ] if ;
 | 
			
		||||
 | 
			
		||||
M: float-11-11-10-components (component-type>type)
 | 
			
		||||
    over BGR =
 | 
			
		||||
    [ 2drop GL_UNSIGNED_INT_10F_11F_11F_REV_EXT ] [ unsupported-component-order ] if ;
 | 
			
		||||
 | 
			
		||||
: image-data-format ( component-order component-type -- gl-format gl-type )
 | 
			
		||||
    [ (component-order>format) ] [ (component-type>type) ] 2bi ;
 | 
			
		||||
 | 
			
		||||
SLOT: display-list
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -71,6 +258,12 @@ GENERIC: draw-scaled-texture ( dim texture -- )
 | 
			
		|||
 | 
			
		||||
DEFER: make-texture
 | 
			
		||||
 | 
			
		||||
: (image-format) ( component-order component-type -- internal-format format type )
 | 
			
		||||
    [ image-internal-format ] [ image-data-format ] 2bi ;
 | 
			
		||||
 | 
			
		||||
: image-format ( image -- internal-format format type )
 | 
			
		||||
    [ component-order>> ] [ component-type>> ] bi (image-format) ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
 | 
			
		||||
| 
						 | 
				
			
			@ -80,15 +273,6 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
 | 
			
		|||
        [ dup 1 = [ next-power-of-2 ] unless ] map
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: image-format ( image -- internal-format format type )
 | 
			
		||||
    dup component-type>>
 | 
			
		||||
    [ nip component-type>type ]
 | 
			
		||||
    [
 | 
			
		||||
        unnormalized-integer-components?
 | 
			
		||||
        [ component-order>> component-order>integer-format ]
 | 
			
		||||
        [ component-order>> component-order>format ] if
 | 
			
		||||
    ] 2bi swap ;
 | 
			
		||||
 | 
			
		||||
:: tex-image ( image bitmap -- )
 | 
			
		||||
    image image-format :> type :> format :> internal-format
 | 
			
		||||
    GL_TEXTURE_2D 0 internal-format
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue