Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-02-14 12:07:47 -06:00
commit df7806ef01
4 changed files with 58 additions and 18 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types namespaces io.binary fry USING: alien.c-types namespaces io.binary fry
kernel math grouping sequences ; kernel math grouping sequences math.bitwise ;
IN: endian IN: endian
SINGLETONS: big-endian little-endian ; SINGLETONS: big-endian little-endian ;
@ -9,9 +9,6 @@ SINGLETONS: big-endian little-endian ;
: compute-native-endianness ( -- class ) : compute-native-endianness ( -- class )
1 <int> *char 0 = big-endian little-endian ? ; 1 <int> *char 0 = big-endian little-endian ? ;
: >signed ( x n -- y )
2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
SYMBOL: native-endianness SYMBOL: native-endianness
native-endianness [ compute-native-endianness ] initialize native-endianness [ compute-native-endianness ] initialize

View File

@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors grouping sequences combinators USING: kernel accessors grouping sequences combinators
math specialized-arrays.direct.uint byte-arrays math specialized-arrays.direct.uint byte-arrays
specialized-arrays.direct.ushort ; specialized-arrays.direct.ushort specialized-arrays.uint
specialized-arrays.ushort specialized-arrays.float ;
IN: images IN: images
SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
R16G16B16 R32G32B32 ; R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
TUPLE: image dim component-order bitmap ; TUPLE: image dim component-order bitmap ;
@ -18,34 +19,37 @@ GENERIC: load-image* ( path tuple -- image )
3 <sliced-groups> 3 <sliced-groups>
[ 255 suffix ] map concat ; [ 255 suffix ] map concat ;
: normalize-floats ( byte-array -- byte-array )
byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
: normalize-component-order ( image -- image ) : normalize-component-order ( image -- image )
dup component-order>> dup component-order>>
{ {
{ RGBA [ ] } { RGBA [ ] }
{ R32G32B32A32 [
[ normalize-floats ] change-bitmap
] }
{ R32G32B32 [ { R32G32B32 [
[ [ normalize-floats add-dummy-alpha ] change-bitmap
dup length 4 / <direct-uint-array> ] }
[ bits>float 255.0 * >integer ] map { R16G16B16A16 [
>byte-array add-dummy-alpha [ byte-array>ushort-array [ -8 shift ] B{ } map-as ] change-bitmap
] change-bitmap
] } ] }
{ R16G16B16 [ { R16G16B16 [
[ [
dup length 2 / <direct-ushort-array> byte-array>ushort-array [ -8 shift ] B{ } map-as add-dummy-alpha
[ -8 shift ] map
>byte-array add-dummy-alpha
] change-bitmap ] change-bitmap
] } ] }
{ BGRA [ { BGRA [
[ [
4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each 4 <sliced-groups> dup [ 3 head-slice reverse-here ] each
] change-bitmap ] change-bitmap
] } ] }
{ RGB [ [ add-dummy-alpha ] change-bitmap ] } { RGB [ [ add-dummy-alpha ] change-bitmap ] }
{ BGR [ { BGR [
[ [
3 <sliced-groups> 3 <sliced-groups>
[ [ [ 0 3 ] dip <slice> reverse-here ] each ] [ [ 3 head-slice reverse-here ] each ]
[ add-dummy-alpha ] bi [ add-dummy-alpha ] bi
] change-bitmap ] change-bitmap
] } ] }

View File

@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io
io.binary io.encodings.ascii io.encodings.binary io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack prettyprint sequences math.bitwise math.order math.parser pack prettyprint sequences
strings ; strings math.vectors ;
IN: images.tiff IN: images.tiff
TUPLE: tiff-image < image ; TUPLE: tiff-image < image ;
@ -119,7 +119,9 @@ SINGLETONS: image-length image-width x-resolution y-resolution
rows-per-strip strip-offsets strip-byte-counts bits-per-sample rows-per-strip strip-offsets strip-byte-counts bits-per-sample
samples-per-pixel new-subfile-type orientation software samples-per-pixel new-subfile-type orientation software
date-time photoshop exif-ifd sub-ifd inter-color-profile date-time photoshop exif-ifd sub-ifd inter-color-profile
xmp iptc unhandled-ifd-entry ; xmp iptc fill-order document-name page-number page-name
x-position y-position
unhandled-ifd-entry ;
ERROR: bad-tiff-magic bytes ; ERROR: bad-tiff-magic bytes ;
: tiff-endianness ( byte-array -- ? ) : tiff-endianness ( byte-array -- ? )
@ -159,6 +161,9 @@ ERROR: no-tag class ;
: find-tag ( idf class -- tag ) : find-tag ( idf class -- tag )
swap processed-tags>> ?at [ no-tag ] unless ; swap processed-tags>> ?at [ no-tag ] unless ;
: tag? ( idf class -- tag )
swap processed-tags>> key? ;
: read-strips ( ifd -- ifd ) : read-strips ( ifd -- ifd )
dup dup
[ strip-byte-counts find-tag ] [ strip-byte-counts find-tag ]
@ -242,6 +247,8 @@ ERROR: bad-small-ifd-type n ;
{ 258 [ bits-per-sample ] } { 258 [ bits-per-sample ] }
{ 259 [ lookup-compression compression ] } { 259 [ lookup-compression compression ] }
{ 262 [ lookup-photometric-interpretation photometric-interpretation ] } { 262 [ lookup-photometric-interpretation photometric-interpretation ] }
{ 266 [ fill-order ] }
{ 269 [ ascii decode document-name ] }
{ 273 [ strip-offsets ] } { 273 [ strip-offsets ] }
{ 274 [ orientation ] } { 274 [ orientation ] }
{ 277 [ samples-per-pixel ] } { 277 [ samples-per-pixel ] }
@ -250,7 +257,11 @@ ERROR: bad-small-ifd-type n ;
{ 282 [ first x-resolution ] } { 282 [ first x-resolution ] }
{ 283 [ first y-resolution ] } { 283 [ first y-resolution ] }
{ 284 [ planar-configuration ] } { 284 [ planar-configuration ] }
{ 285 [ page-name ] }
{ 286 [ x-position ] }
{ 287 [ y-position ] }
{ 296 [ lookup-resolution-unit resolution-unit ] } { 296 [ lookup-resolution-unit resolution-unit ] }
{ 297 [ page-number ] }
{ 305 [ ascii decode software ] } { 305 [ ascii decode software ] }
{ 306 [ ascii decode date-time ] } { 306 [ ascii decode date-time ] }
{ 317 [ lookup-predictor predictor ] } { 317 [ lookup-predictor predictor ] }
@ -286,6 +297,27 @@ ERROR: unhandled-compression compression ;
: strips>bitmap ( ifd -- ifd ) : strips>bitmap ( ifd -- ifd )
dup strips>> concat >>bitmap ; dup strips>> concat >>bitmap ;
: (strips-predictor) ( ifd -- ifd )
[ ]
[ image-width find-tag ]
[ samples-per-pixel find-tag ] tri
[ * ] keep
'[
_ group [ _ group [ rest ] [ first ] bi
[ v+ ] accumulate swap suffix concat ] map
concat >byte-array
] change-bitmap ;
: strips-predictor ( ifd -- ifd )
dup predictor tag? [
dup predictor find-tag
{
{ predictor-none [ ] }
{ predictor-horizontal-differencing [ (strips-predictor) ] }
[ bad-predictor ]
} case
] when ;
ERROR: unknown-component-order ifd ; ERROR: unknown-component-order ifd ;
: fix-bitmap-endianness ( ifd -- ifd ) : fix-bitmap-endianness ( ifd -- ifd )
@ -302,7 +334,9 @@ ERROR: unknown-component-order ifd ;
: ifd-component-order ( ifd -- byte-order ) : ifd-component-order ( ifd -- byte-order )
bits-per-sample find-tag { bits-per-sample find-tag {
{ { 32 32 32 32 } [ R32G32B32A32 ] }
{ { 32 32 32 } [ R32G32B32 ] } { { 32 32 32 } [ R32G32B32 ] }
{ { 16 16 16 16 } [ R16G16B16A16 ] }
{ { 16 16 16 } [ R16G16B16 ] } { { 16 16 16 } [ R16G16B16 ] }
{ { 8 8 8 8 } [ RGBA ] } { { 8 8 8 8 } [ RGBA ] }
{ { 8 8 8 } [ RGB ] } { { 8 8 8 } [ RGB ] }
@ -329,6 +363,7 @@ ERROR: unknown-component-order ifd ;
uncompress-strips uncompress-strips
strips>bitmap strips>bitmap
fix-bitmap-endianness fix-bitmap-endianness
strips-predictor
drop drop
] each ] each
] with-endianness ] with-endianness

View File

@ -102,3 +102,7 @@ PRIVATE>
: signed-be> ( bytes -- x ) : signed-be> ( bytes -- x )
<reversed> signed-le> ; <reversed> signed-le> ;
: >signed ( x n -- y )
2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;