images.bitmap: now conforms to image encode protocol. images.normalization: added several component-order shuffle words
Keith Lazuka
parent
471c86a110
commit
6ce12ed342
|
|
@ -2,20 +2,21 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types arrays byte-arrays columns
|
||||
combinators compression.run-length endian fry grouping images
|
||||
images.bitmap.loading images.loader io io.binary
|
||||
images.loader images.normalization io io.binary
|
||||
io.encodings.binary io.encodings.string io.files
|
||||
io.streams.limited kernel locals macros math math.bitwise
|
||||
math.functions namespaces sequences specialized-arrays
|
||||
strings summary ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
specialized-arrays.instances.uint
|
||||
specialized-arrays.instances.ushort strings summary ;
|
||||
IN: images.bitmap
|
||||
|
||||
SINGLETON: bmp-image
|
||||
"bmp" bmp-image register-image-class
|
||||
|
||||
: write2 ( n -- ) 2 >le write ;
|
||||
: write4 ( n -- ) 4 >le write ;
|
||||
|
||||
: save-bitmap ( image path -- )
|
||||
binary [
|
||||
: output-bmp ( image -- )
|
||||
B{ CHAR: B CHAR: M } write
|
||||
[
|
||||
bitmap>> length 14 + 40 + write4
|
||||
|
|
@ -54,5 +55,8 @@ IN: images.bitmap
|
|||
! color-palette
|
||||
[ bitmap>> write ]
|
||||
} cleave
|
||||
] bi
|
||||
] with-file-writer ;
|
||||
] bi ;
|
||||
|
||||
M: bmp-image image>stream
|
||||
drop BGR reorder-colors output-bmp ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,14 +4,11 @@ USING: accessors alien.c-types arrays byte-arrays combinators
|
|||
compression.run-length fry grouping images images.loader io
|
||||
io.binary io.encodings.8-bit io.encodings.binary
|
||||
io.encodings.string io.streams.limited kernel math math.bitwise
|
||||
sequences specialized-arrays summary ;
|
||||
sequences specialized-arrays summary images.bitmap ;
|
||||
QUALIFIED-WITH: bitstreams b
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: images.bitmap.loading
|
||||
|
||||
SINGLETON: bitmap-image
|
||||
"bmp" bitmap-image register-image-class
|
||||
|
||||
! http://www.fileformat.info/format/bmp/egff.htm
|
||||
! http://www.digicamsoft.com/bmp/bmp.html
|
||||
|
||||
|
|
@ -364,7 +361,7 @@ ERROR: unsupported-bitmap-file magic ;
|
|||
: loading-bitmap>bytes ( loading-bitmap -- byte-array )
|
||||
uncompress-bitmap bitmap>bytes ;
|
||||
|
||||
M: bitmap-image stream>image ( stream bitmap-image -- bitmap )
|
||||
M: bmp-image stream>image ( stream bmp-image -- bitmap )
|
||||
drop load-bitmap
|
||||
[ image new ] dip
|
||||
{
|
||||
|
|
|
|||
|
|
@ -53,3 +53,4 @@ GENERIC: image>stream ( image class -- )
|
|||
: save-graphic-image ( image path -- )
|
||||
[ image-class ] [ ] bi
|
||||
binary [ image>stream ] with-file-writer ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,76 @@
|
|||
! BSD License. Copyright 2009 Keith Lazuka
|
||||
USING: images.normalization images.normalization.private
|
||||
sequences tools.test ;
|
||||
IN: images.normalization.tests
|
||||
|
||||
! RGB
|
||||
|
||||
[ B{ 0 1 2 255 3 4 5 255 } ]
|
||||
[ B{ 0 1 2 3 4 5 } RGB>RGBA ] unit-test
|
||||
|
||||
[ B{ 2 1 0 5 4 3 } ]
|
||||
[ B{ 0 1 2 3 4 5 } RGB>BGR ] unit-test
|
||||
|
||||
[ B{ 2 1 0 255 5 4 3 255 } ]
|
||||
[ B{ 0 1 2 3 4 5 } RGB>BGRA ] unit-test
|
||||
|
||||
[ B{ 255 0 1 2 255 3 4 5 } ]
|
||||
[ B{ 0 1 2 3 4 5 } RGB>ARGB ] unit-test
|
||||
|
||||
! RGBA
|
||||
|
||||
[ B{ 0 1 2 4 5 6 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>RGB ] unit-test
|
||||
|
||||
[ B{ 2 1 0 6 5 4 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGR ] unit-test
|
||||
|
||||
[ B{ 2 1 0 3 6 5 4 7 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGRA ] unit-test
|
||||
|
||||
[ B{ 3 0 1 2 7 4 5 6 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>ARGB ] unit-test
|
||||
|
||||
! BGR
|
||||
|
||||
[ B{ 2 1 0 5 4 3 } ]
|
||||
[ B{ 0 1 2 3 4 5 } BGR>RGB ] unit-test
|
||||
|
||||
[ B{ 2 1 0 255 5 4 3 255 } ]
|
||||
[ B{ 0 1 2 3 4 5 } BGR>RGBA ] unit-test
|
||||
|
||||
[ B{ 0 1 2 255 3 4 5 255 } ]
|
||||
[ B{ 0 1 2 3 4 5 } BGR>BGRA ] unit-test
|
||||
|
||||
[ B{ 255 2 1 0 255 5 4 3 } ]
|
||||
[ B{ 0 1 2 3 4 5 } BGR>ARGB ] unit-test
|
||||
|
||||
! BGRA
|
||||
|
||||
[ B{ 2 1 0 6 5 4 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGB ] unit-test
|
||||
|
||||
[ B{ 0 1 2 4 5 6 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>BGR ] unit-test
|
||||
|
||||
[ B{ 2 1 0 3 6 5 4 7 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGBA ] unit-test
|
||||
|
||||
[ B{ 3 2 1 0 7 6 5 4 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>ARGB ] unit-test
|
||||
|
||||
! ARGB
|
||||
|
||||
[ B{ 1 2 3 5 6 7 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGB ] unit-test
|
||||
|
||||
[ B{ 3 2 1 7 6 5 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGR ] unit-test
|
||||
|
||||
[ B{ 3 2 1 0 7 6 5 4 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGRA ] unit-test
|
||||
|
||||
[ B{ 1 2 3 0 5 6 7 4 } ]
|
||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGBA ] unit-test
|
||||
|
||||
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2009 Doug Coleman
|
||||
! Copyright (C) 2009 Doug Coleman, Keith Lazuka
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types kernel accessors grouping sequences
|
||||
combinators math byte-arrays fry images half-floats
|
||||
|
|
@ -12,21 +12,158 @@ IN: images.normalization
|
|||
|
||||
<PRIVATE
|
||||
|
||||
! Helpers
|
||||
: add-dummy-alpha ( seq -- seq' )
|
||||
3 <groups> [ 255 suffix ] map concat ;
|
||||
|
||||
: normalize-floats ( float-array -- byte-array )
|
||||
[ 255.0 * >integer ] B{ } map-as ;
|
||||
|
||||
: fix-XBGR ( bitmap -- bitmap' )
|
||||
dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
|
||||
|
||||
: fix-BGRX ( bitmap -- bitmap' )
|
||||
dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
|
||||
|
||||
! Bitmap Conversions
|
||||
|
||||
! TODO RGBX, XRGB, BGRX, XBGR conversions
|
||||
|
||||
! BGR>
|
||||
: BGR>RGB ( bitmap -- bitmap' )
|
||||
3 <sliced-groups> [ <reversed> ] map concat ; inline
|
||||
|
||||
: BGR>BGRA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
|
||||
|
||||
: BGR>RGBA ( bitmap -- bitmap' ) BGR>RGB add-dummy-alpha ; inline
|
||||
|
||||
: BGR>ARGB ( bitmap -- bitmap' )
|
||||
3 <sliced-groups> [ 255 suffix <reversed> ] map concat ; inline
|
||||
|
||||
! BGRA>
|
||||
: BGRA>BGR ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ but-last-slice ] map concat ; inline
|
||||
|
||||
: BGRA>RGBA ( bitmap -- bitmap' )
|
||||
4 <sliced-groups>
|
||||
[ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
|
||||
|
||||
: BGRA>RGB ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ but-last-slice <reversed> ] map concat ; inline
|
||||
|
||||
: BGRA>ARGB ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ <reversed> ] map concat ; inline
|
||||
|
||||
! RGB>
|
||||
: RGB>BGR ( bitmap -- bitmap' ) BGR>RGB ; inline
|
||||
|
||||
: RGB>RGBA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
|
||||
|
||||
: RGB>BGRA ( bitmap -- bitmap' )
|
||||
3 <sliced-groups> [ <reversed> add-dummy-alpha ] map concat ; inline
|
||||
|
||||
: RGB>ARGB ( bitmap -- bitmap' )
|
||||
3 <sliced-groups> [ 255 prefix ] map concat ; inline
|
||||
|
||||
! RGBA>
|
||||
|
||||
: RGBA>BGR ( bitmap -- bitmap' ) BGRA>RGB ; inline
|
||||
|
||||
: RGBA>BGRA ( bitmap -- bitmap' ) BGRA>RGBA ; inline
|
||||
|
||||
: RGBA>RGB ( bitmap -- bitmap' ) BGRA>BGR ; inline
|
||||
|
||||
: RGBA>ARGB ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ unclip-last-slice prefix ] map concat ; inline
|
||||
|
||||
! ARGB>
|
||||
|
||||
: ARGB>RGB ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ rest-slice ] map concat ; inline
|
||||
|
||||
: ARGB>RGBA ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ unclip-slice suffix ] map concat ; inline
|
||||
|
||||
: ARGB>BGR ( bitmap -- bitmap' )
|
||||
4 <sliced-groups> [ rest-slice <reversed> ] map concat ; inline
|
||||
|
||||
: ARGB>BGRA ( bitmap -- bitmap' )
|
||||
4 <sliced-groups>
|
||||
[ unclip-slice [ <reversed> ] dip suffix ] map concat ; inline
|
||||
|
||||
! Dispatch
|
||||
GENERIC# convert-component-order 1 ( image src-order dest-order -- image )
|
||||
|
||||
M: RGB convert-component-order
|
||||
nip [ >>component-order ] keep {
|
||||
{ RGB [ ] }
|
||||
{ RGBA [ [ RGB>RGBA ] change-bitmap ] }
|
||||
{ BGRA [ [ BGR>BGRA ] change-bitmap ] }
|
||||
{ ARGB [ [ RGB>RGBA RGBA>ARGB ] change-bitmap ] }
|
||||
{ BGR [ [ RGB>BGR ] change-bitmap ] }
|
||||
[ "Cannot convert from RGB to desired component order!" throw ]
|
||||
} case ;
|
||||
|
||||
M: RGBA convert-component-order
|
||||
nip [ >>component-order ] keep {
|
||||
{ RGBA [ ] }
|
||||
{ BGRA [ [ RGBA>BGRA ] change-bitmap ] }
|
||||
{ BGR [ [ RGBA>BGR ] change-bitmap ] }
|
||||
{ RGB [ [ RGBA>RGB ] change-bitmap ] }
|
||||
{ ARGB [ [ RGBA>ARGB ] change-bitmap ] }
|
||||
[ "Cannot convert from RGBA to desired component order!" throw ]
|
||||
} case ;
|
||||
|
||||
M: BGR convert-component-order
|
||||
nip [ >>component-order ] keep {
|
||||
{ BGR [ ] }
|
||||
{ BGRA [ [ BGR>BGRA ] change-bitmap ] }
|
||||
{ RGB [ [ BGR>RGB ] change-bitmap ] }
|
||||
{ RGBA [ [ BGR>RGBA ] change-bitmap ] }
|
||||
{ ARGB [ [ BGR>ARGB ] change-bitmap ] }
|
||||
[ "Cannot convert from BGR to desired component order!" throw ]
|
||||
} case ;
|
||||
|
||||
M: BGRA convert-component-order
|
||||
nip [ >>component-order ] keep {
|
||||
{ BGRA [ ] }
|
||||
{ BGR [ [ BGRA>BGR ] change-bitmap ] }
|
||||
{ RGB [ [ BGRA>RGB ] change-bitmap ] }
|
||||
{ RGBA [ [ BGRA>RGBA ] change-bitmap ] }
|
||||
{ ARGB [ [ BGRA>ARGB ] change-bitmap ] }
|
||||
[ "Cannot convert from BGRA to desired component order!" throw ]
|
||||
} case ;
|
||||
|
||||
M: ARGB convert-component-order
|
||||
nip [ >>component-order ] keep {
|
||||
{ ARGB [ ] }
|
||||
{ BGR [ [ ARGB>BGR ] change-bitmap ] }
|
||||
{ RGB [ [ ARGB>RGB ] change-bitmap ] }
|
||||
{ RGBA [ [ ARGB>RGBA ] change-bitmap ] }
|
||||
{ BGRA [ [ ARGB>BGRA ] change-bitmap ] }
|
||||
[ "Cannot convert from ARGB to desired component order!" throw ]
|
||||
} case ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! asserts that component-type must be ubyte-components
|
||||
: reorder-colors ( image component-order -- image )
|
||||
[
|
||||
[ component-type>> ubyte-components assert= ]
|
||||
[ dup component-order>> ] bi
|
||||
] dip convert-component-order ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
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 ;
|
||||
RGBA reorder-colors ;
|
||||
|
||||
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 ;
|
||||
|
||||
|
|
@ -39,45 +176,6 @@ M: ushort-components normalize-component-type*
|
|||
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
|
||||
|
||||
: BGRA>RGBA ( bitmap -- pixels )
|
||||
4 <sliced-groups>
|
||||
[ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
|
||||
|
||||
M: BGRA normalize-component-order*
|
||||
drop BGRA>RGBA ;
|
||||
|
||||
M: RGB normalize-component-order*
|
||||
drop add-dummy-alpha ;
|
||||
|
||||
M: BGR normalize-component-order*
|
||||
drop BGR>RGB add-dummy-alpha ;
|
||||
|
||||
: ARGB>RGBA ( bitmap -- bitmap' )
|
||||
4 <groups> [ unclip suffix ] map B{ } join ; inline
|
||||
|
||||
M: ARGB normalize-component-order*
|
||||
drop ARGB>RGBA ;
|
||||
|
||||
M: ABGR normalize-component-order*
|
||||
drop ARGB>RGBA BGRA>RGBA ;
|
||||
|
||||
: fix-XBGR ( bitmap -- bitmap' )
|
||||
dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
|
||||
|
||||
M: XBGR normalize-component-order*
|
||||
drop fix-XBGR ABGR normalize-component-order* ;
|
||||
|
||||
: fix-BGRX ( bitmap -- bitmap' )
|
||||
dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
|
||||
|
||||
M: BGRX normalize-component-order*
|
||||
drop fix-BGRX BGRA normalize-component-order* ;
|
||||
|
||||
: normalize-scan-line-order ( image -- image )
|
||||
dup upside-down?>> [
|
||||
dup dim>> first 4 * '[
|
||||
|
|
@ -93,3 +191,4 @@ PRIVATE>
|
|||
normalize-component-order
|
||||
normalize-scan-line-order
|
||||
RGBA >>component-order ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue