steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

separate component format from component order in image objects

db4
Joe Groff 2009-06-22 11:20:54 -05:00
parent 0cf61eb182
commit ac3ec67c6a
16 changed files with 168 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/cairo/cairo.factor
View File

@ -31,7 +31,8 @@ ERROR: cairo-error message ;
<cairo> &cairo_destroy
@
] make-memory-bitmap
BGRA >>component-order ; inline
BGRA >>component-order
ubyte-components >>component-type ; inline
: dummy-cairo ( -- cr )
#! Sometimes we want a dummy context; eg with Pango, we want

3
basis/core-graphics/core-graphics.factor
View File

@ -140,4 +140,5 @@ PRIVATE>
: make-bitmap-image ( dim quot -- image )
'[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap
ARGB >>component-order ; inline
ARGB >>component-order
ubyte-components >>component-type ; inline

2
basis/images/bitmap/loading/loading.factor
View File

@ -370,5 +370,5 @@ M: bitmap-image load-image* ( path bitmap-image -- bitmap )
[ loading-bitmap>bytes >>bitmap ]
[ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ]
[ header>> height>> 0 < not >>upside-down? ]
[ bitmap>component-order >>component-order ]
[ bitmap>component-order >>component-order ubyte-components >>component-type ]
} cleave ;

4
basis/images/images-tests.factor
View File

@ -3,7 +3,7 @@
USING: images tools.test kernel accessors ;
IN: images.tests
[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA f B{
[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
0 0 0 0
0 0 0 0
0 0 0 0
@ -19,7 +19,7 @@ IN: images.tests
57 57 57 255
0 0 0 0
0 0 0 0
} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{
} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
0 0 0 0
0 0 0 0
0 0 0 0

74
basis/images/images.factor
View File

@ -3,12 +3,58 @@
USING: combinators kernel accessors sequences math arrays ;
IN: images
SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
SINGLETONS:
L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
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 ;
UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
UNION: component-order
L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
: bytes-per-pixel ( component-order -- n )
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 ;
UNION: unnormalized-integer-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
int-integer-components uint-integer-components ;
UNION: alpha-channel BGRA RGBA ABGR ARGB ;
TUPLE: image dim component-order component-type upside-down? bitmap ;
: <image> ( -- image ) image new ; inline
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
GENERIC: load-image* ( path class -- image )
DEFER: bytes-per-pixel
<PRIVATE
: bytes-per-component ( component-type -- n )
{
{ ubyte-components [ 1 ] }
{ ushort-components [ 2 ] }
{ half-components [ 2 ] }
{ float-components [ 4 ] }
{ byte-integer-components [ 1 ] }
{ ubyte-integer-components [ 1 ] }
{ short-integer-components [ 2 ] }
{ ushort-integer-components [ 2 ] }
{ int-integer-components [ 4 ] }
{ uint-integer-components [ 4 ] }
} case ;
: component-count ( component-order -- n )
{
{ L [ 1 ] }
{ LA [ 2 ] }
@ -22,25 +68,11 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
{ XRGB [ 4 ] }
{ BGRX [ 4 ] }
{ XBGR [ 4 ] }
{ R16G16B16 [ 6 ] }
{ R32G32B32 [ 12 ] }
{ R16G16B16A16 [ 8 ] }
{ R32G32B32A32 [ 16 ] }
} case ;
TUPLE: image dim component-order upside-down? bitmap ;
: <image> ( -- image ) image new ; inline
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
GENERIC: load-image* ( path class -- image )
<PRIVATE
: pixel@ ( x y image -- start end bitmap )
[ dim>> first * + ]
[ component-order>> bytes-per-pixel [ * dup ] keep + ]
[ bytes-per-pixel [ * dup ] keep + ]
[ bitmap>> ] tri ;
: set-subseq ( new-value from to victim -- )
@ -48,6 +80,10 @@ GENERIC: load-image* ( path class -- image )
PRIVATE>
: bytes-per-pixel ( image -- n )
[ component-order>> component-count ]
[ component-type>> bytes-per-component ] bi * ;
: pixel-at ( x y image -- pixel )
pixel@ subseq ;

1
basis/images/jpeg/jpeg.factor
View File

@ -298,6 +298,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
: setup-bitmap ( image -- )
dup dim>> 16 v/n [ ceiling ] map 16 v*n >>dim
BGR >>component-order
ubyte-components >>component-type
f >>upside-down?
dup dim>> first2 * 3 * 0 <array> >>bitmap
drop ;

2
basis/images/png/png.factor
View File

@ -85,7 +85,7 @@ ERROR: unimplemented-color-type image ;
[ <image> ] dip {
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop RGB >>component-order ]
[ drop RGB >>component-order ubyte-components >>component-type ]
} cleave ;
: decode-indexed-color ( loading-png -- loading-png )

2
basis/images/processing/processing.factor
View File

@ -17,7 +17,7 @@ IN: images.processing
<image> over matrix-dim >>dim
swap flip flatten
[ 128 * 128 + 0 max 255 min >fixnum ] map
>byte-array >>bitmap L >>component-order ;
>byte-array >>bitmap L >>component-order ubyte-components >>component-type ;
:: matrix-zoom ( m f -- m' )
m matrix-dim f v*n coord-matrix

20
basis/images/tesselation/tesselation-tests.factor
View File

@ -10,12 +10,12 @@ IN: images.tesselation
[
{
{
T{ image f { 2 2 } L f B{ 1 2 5 6 } }
T{ image f { 2 2 } L f B{ 3 4 7 8 } }
T{ image f { 2 2 } L ubyte-components f B{ 1 2 5 6 } }
T{ image f { 2 2 } L ubyte-components f B{ 3 4 7 8 } }
}
{
T{ image f { 2 2 } L f B{ 9 10 13 14 } }
T{ image f { 2 2 } L f B{ 11 12 15 16 } }
T{ image f { 2 2 } L ubyte-components f B{ 9 10 13 14 } }
T{ image f { 2 2 } L ubyte-components f B{ 11 12 15 16 } }
}
}
] [
@ -23,18 +23,19 @@ IN: images.tesselation
1 16 [a,b] >byte-array >>bitmap
{ 4 4 } >>dim
L >>component-order
ubyte-components >>component-type
{ 2 2 } tesselate
] unit-test
[
{
{
T{ image f { 2 2 } L f B{ 1 2 4 5 } }
T{ image f { 1 2 } L f B{ 3 6 } }
T{ image f { 2 2 } L ubyte-components f B{ 1 2 4 5 } }
T{ image f { 1 2 } L ubyte-components f B{ 3 6 } }
}
{
T{ image f { 2 1 } L f B{ 7 8 } }
T{ image f { 1 1 } L f B{ 9 } }
T{ image f { 2 1 } L ubyte-components f B{ 7 8 } }
T{ image f { 1 1 } L ubyte-components f B{ 9 } }
}
}
] [
@ -42,5 +43,6 @@ IN: images.tesselation
1 9 [a,b] >byte-array >>bitmap
{ 3 3 } >>dim
L >>component-order
ubyte-components >>component-type
{ 2 2 } tesselate
] unit-test
] unit-test

6
basis/images/tesselation/tesselation.factor
View File

@ -19,7 +19,7 @@ IN: images.tesselation
'[ _ tesselate-columns ] map ;
: tile-width ( tile-bitmap original-image -- width )
[ first length ] [ component-order>> bytes-per-pixel ] bi* /i ;
[ first length ] [ bytes-per-pixel ] bi* /i ;
: <tile-image> ( tile-bitmap original-image -- tile-image )
clone
@ -28,8 +28,8 @@ IN: images.tesselation
[ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
:: tesselate ( image tess-dim -- image-grid )
image component-order>> bytes-per-pixel :> bpp
image bytes-per-pixel :> bpp
image dim>> { bpp 1 } v* :> image-dim'
tess-dim { bpp 1 } v* :> tess-dim'
image bitmap>> image-dim' tess-dim' tesselate-bitmap
[ [ image <tile-image> ] map ] map ;
[ [ image <tile-image> ] map ] map ;

18
basis/images/tiff/tiff.factor
View File

@ -484,15 +484,15 @@ ERROR: unknown-component-order ifd ;
[ unknown-component-order ]
} case >>bitmap ;
: ifd-component-order ( ifd -- byte-order )
: ifd-component-order ( ifd -- component-order component-type )
bits-per-sample find-tag {
{ { 32 32 32 32 } [ R32G32B32A32 ] }
{ { 32 32 32 } [ R32G32B32 ] }
{ { 16 16 16 16 } [ R16G16B16A16 ] }
{ { 16 16 16 } [ R16G16B16 ] }
{ { 8 8 8 8 } [ RGBA ] }
{ { 8 8 8 } [ RGB ] }
{ 8 [ LA ] }
{ { 32 32 32 32 } [ RGBA float-components ] }
{ { 32 32 32 } [ RGB float-components ] }
{ { 16 16 16 16 } [ RGBA ushort-components ] }
{ { 16 16 16 } [ RGB ushort-components ] }
{ { 8 8 8 8 } [ RGBA ubyte-components ] }
{ { 8 8 8 } [ RGB ubyte-components ] }
{ 8 [ LA ubyte-components ] }
[ unknown-component-order ]
} case ;
@ -507,7 +507,7 @@ ERROR: unknown-component-order ifd ;
: ifd>image ( ifd -- image )
[ <image> ] dip {
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array >>dim ]
[ ifd-component-order >>component-order ]
[ ifd-component-order [ >>component-order ] [ >>component-type ] bi* ]
[ bitmap>> >>bitmap ]
} cleave ;

6
basis/opengl/gl/gl.factor
View File

@ -1801,6 +1801,12 @@ CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT HEX: 8D56
CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
! GL_ARB_half_float_pixel, GL_ARB_half_float_vertex
CONSTANT: GL_HALF_FLOAT_ARB HEX: 140B
! GL_ARB_texture_float

71
basis/opengl/textures/textures.factor
View File

@ -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 ;
system locals ;
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
@ -22,16 +22,46 @@ SYMBOL: non-power-of-2-textures?
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
GENERIC: component-order>format ( component-order -- format type )
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 )
M: RGB component-order>format drop GL_RGB GL_UNSIGNED_BYTE ;
M: BGR component-order>format drop GL_BGR GL_UNSIGNED_BYTE ;
M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
M: LA component-order>format drop GL_LUMINANCE_ALPHA GL_UNSIGNED_BYTE ;
M: L component-order>format drop GL_LUMINANCE GL_UNSIGNED_BYTE ;
ERROR: unsupported-component-order component-order ;
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 ;
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_EXT ]
[ unsupported-component-order ] if ;
M: BGRA component-order>format drop GL_BGRA_EXT ;
M: BGRX component-order>format drop GL_BGRA_EXT ;
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 ;
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: object component-order>integer-format unsupported-component-order ;
SLOT: display-list
@ -50,18 +80,25 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
[ dup 1 = [ next-power-of-2 ] unless ] map
] unless ;
: tex-image ( image bitmap -- )
: image-format ( image -- internal-format format type )
dup component-type>>
[ nip component-type>type ]
[
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
[ dim>> adjust-texture-dim first2 0 ]
[ component-order>> component-order>format ] bi
] dip
glTexImage2D ;
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
image dim>> adjust-texture-dim first2 0
format type bitmap glTexImage2D ;
: tex-sub-image ( image -- )
[ GL_TEXTURE_2D 0 0 0 ] dip
[ dim>> first2 ]
[ component-order>> component-order>format ]
[ image-format [ drop ] 2dip ]
[ bitmap>> ] tri
glTexSubImage2D ;

32
extra/images/normalization/normalization.factor
View File

@ -3,7 +3,8 @@
USING: kernel accessors grouping sequences combinators
math specialized-arrays.direct.uint byte-arrays fry
specialized-arrays.direct.ushort specialized-arrays.uint
specialized-arrays.ushort specialized-arrays.float images ;
specialized-arrays.ushort specialized-arrays.float images
half-floats ;
IN: images.normalization
<PRIVATE
@ -11,30 +12,31 @@ IN: images.normalization
: add-dummy-alpha ( seq -- seq' )
3 <groups> [ 255 suffix ] map concat ;
: normalize-floats ( byte-array -- byte-array )
byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
: normalize-floats ( float-array -- byte-array )
[ 255.0 * >integer ] B{ } map-as ;
GENERIC: normalize-component-type* ( image component-type -- image )
GENERIC: normalize-component-order* ( image component-order -- image )
: normalize-component-order ( image -- image )
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
M: RGBA normalize-component-order* drop ;
M: float-components normalize-component-type*
drop byte-array>float-array normalize-floats ;
M: half-components normalize-component-type*
drop byte-array>half-array normalize-floats ;
M: R32G32B32A32 normalize-component-order*
drop normalize-floats ;
M: R32G32B32 normalize-component-order*
drop normalize-floats add-dummy-alpha ;
: RGB16>8 ( bitmap -- bitmap' )
: ushorts>ubytes ( bitmap -- bitmap' )
byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
M: R16G16B16A16 normalize-component-order*
drop RGB16>8 ;
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;
M: R16G16B16 normalize-component-order*
drop RGB16>8 add-dummy-alpha ;
M: ubyte-components normalize-component-type*
drop ;
M: RGBA normalize-component-order* drop ;
: BGR>RGB ( bitmap -- pixels )
3 <sliced-groups> [ <reversed> ] map B{ } join ; inline

3
extra/noise/noise.factor
View File

@ -64,7 +64,8 @@ HINTS: hashes { byte-array fixnum fixnum fixnum } ;
image new
swap >>dim
swap >>bitmap
L >>component-order ;
L >>component-order
ubyte-components >>component-type ;
:: perlin-noise-unsafe ( table point -- value )
point unit-cube :> cube

1
extra/terrain/generation/generation.factor
View File

@ -36,6 +36,7 @@ TUPLE: segment image ;
<image>
swap >>bitmap
RGBA >>component-order
ubyte-components >>component-type
terrain-segment-size >>dim ;
: terrain-segment ( terrain at -- image )