From ac3ec67c6a01edd6f36d52d969c3765de0d065fb Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 22 Jun 2009 11:20:54 -0500 Subject: [PATCH] separate component format from component order in image objects --- basis/cairo/cairo.factor | 3 +- basis/core-graphics/core-graphics.factor | 3 +- basis/images/bitmap/loading/loading.factor | 2 +- basis/images/images-tests.factor | 4 +- basis/images/images.factor | 74 ++++++++++++++----- basis/images/jpeg/jpeg.factor | 1 + basis/images/png/png.factor | 2 +- basis/images/processing/processing.factor | 2 +- .../tesselation/tesselation-tests.factor | 20 ++--- basis/images/tesselation/tesselation.factor | 6 +- basis/images/tiff/tiff.factor | 18 ++--- basis/opengl/gl/gl.factor | 6 ++ basis/opengl/textures/textures.factor | 71 +++++++++++++----- .../images/normalization/normalization.factor | 32 ++++---- extra/noise/noise.factor | 3 +- extra/terrain/generation/generation.factor | 1 + 16 files changed, 168 insertions(+), 80 deletions(-) diff --git a/basis/cairo/cairo.factor b/basis/cairo/cairo.factor index 3a41f0bcf9..074798a1b2 100755 --- a/basis/cairo/cairo.factor +++ b/basis/cairo/cairo.factor @@ -31,7 +31,8 @@ ERROR: cairo-error message ; &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 diff --git a/basis/core-graphics/core-graphics.factor b/basis/core-graphics/core-graphics.factor index 6612a43dca..a7bec04798 100644 --- a/basis/core-graphics/core-graphics.factor +++ b/basis/core-graphics/core-graphics.factor @@ -140,4 +140,5 @@ PRIVATE> : make-bitmap-image ( dim quot -- image ) '[ &CGContextRelease @ ] make-memory-bitmap - ARGB >>component-order ; inline + ARGB >>component-order + ubyte-components >>component-type ; inline diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor index b0bd501f09..31975fa3f0 100644 --- a/basis/images/bitmap/loading/loading.factor +++ b/basis/images/bitmap/loading/loading.factor @@ -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 ; diff --git a/basis/images/images-tests.factor b/basis/images/images-tests.factor index 8918dcb38c..ff49834a65 100644 --- a/basis/images/images-tests.factor +++ b/basis/images/images-tests.factor @@ -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 diff --git a/basis/images/images.factor b/basis/images/images.factor index 4c76b85459..f74233c515 100755 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -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 new ; inline + +: has-alpha? ( image -- ? ) component-order>> alpha-channel? ; + +GENERIC: load-image* ( path class -- image ) + +DEFER: bytes-per-pixel + + ( -- image ) image new ; inline - -: has-alpha? ( image -- ? ) component-order>> alpha-channel? ; - -GENERIC: load-image* ( path class -- image ) - -> 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 ; diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index f61254c3cf..ca3ea8d2b4 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -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 >>bitmap drop ; diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor index bb470d8dd8..2469a6a72c 100755 --- a/basis/images/png/png.factor +++ b/basis/images/png/png.factor @@ -85,7 +85,7 @@ ERROR: unimplemented-color-type 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 ) diff --git a/basis/images/processing/processing.factor b/basis/images/processing/processing.factor index fc463731b3..cd6754550d 100755 --- a/basis/images/processing/processing.factor +++ b/basis/images/processing/processing.factor @@ -17,7 +17,7 @@ IN: images.processing 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 diff --git a/basis/images/tesselation/tesselation-tests.factor b/basis/images/tesselation/tesselation-tests.factor index 2ac8e37ae7..9db58649a0 100644 --- a/basis/images/tesselation/tesselation-tests.factor +++ b/basis/images/tesselation/tesselation-tests.factor @@ -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 \ No newline at end of file +] unit-test diff --git a/basis/images/tesselation/tesselation.factor b/basis/images/tesselation/tesselation.factor index cbdf396b48..d01bad61ea 100644 --- a/basis/images/tesselation/tesselation.factor +++ b/basis/images/tesselation/tesselation.factor @@ -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-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 ] map ] map ; \ No newline at end of file + [ [ image ] map ] map ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index e00b05f2e7..7e12b03c13 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -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 ) [ ] 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 ; diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor index be457dcd00..6136115dbb 100644 --- a/basis/opengl/gl/gl.factor +++ b/basis/opengl/gl/gl.factor @@ -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 diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 2eabbd478b..0a8fc945bf 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -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 ; diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor index dcdf39a53e..0f4877055a 100755 --- a/extra/images/normalization/normalization.factor +++ b/extra/images/normalization/normalization.factor @@ -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 [ 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 [ ] map B{ } join ; inline diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 3de4147835..975019bfd1 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -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 diff --git a/extra/terrain/generation/generation.factor b/extra/terrain/generation/generation.factor index 72221d7b0e..661ea88de6 100644 --- a/extra/terrain/generation/generation.factor +++ b/extra/terrain/generation/generation.factor @@ -36,6 +36,7 @@ TUPLE: segment image ; swap >>bitmap RGBA >>component-order + ubyte-components >>component-type terrain-segment-size >>dim ; : terrain-segment ( terrain at -- image )