! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays combinators
-combinators.short-circuit compression.lzw endian fry grouping
-images images.loader io io.binary io.encodings.ascii
+combinators.short-circuit compression.lzw endian grouping
+images images.loader io io.encodings.ascii
io.encodings.string io.encodings.utf8 io.streams.throwing kernel
math math.bitwise math.vectors pack sequences ;
IN: images.tiff
{ 10 [ photometric-interpretation-itulab ] }
{ 32844 [ photometric-interpretation-logl ] }
{ 32845 [ photometric-interpretation-logluv ] }
- [ throw-bad-photometric-interpretation ]
+ [ bad-photometric-interpretation ]
} case ;
SINGLETONS: compression
{ 34676 [ compression-sgilog ] }
{ 34677 [ compression-sgilog24 ] }
{ 34712 [ compression-jp2000 ] }
- [ throw-bad-compression ]
+ [ bad-compression ]
} case ;
SINGLETONS: resolution-unit
{ 1 [ resolution-unit-none ] }
{ 2 [ resolution-unit-inch ] }
{ 3 [ resolution-unit-centimeter ] }
- [ throw-bad-resolution-unit ]
+ [ bad-resolution-unit ]
} case ;
SINGLETONS: predictor
{
{ 1 [ predictor-none ] }
{ 2 [ predictor-horizontal-differencing ] }
- [ throw-bad-predictor ]
+ [ bad-predictor ]
} case ;
SINGLETONS: planar-configuration
{
{ 1 [ planar-configuration-chunky ] }
{ 2 [ planar-configuration-planar ] }
- [ throw-bad-planar-configuration ]
+ [ bad-planar-configuration ]
} case ;
SINGLETONS: sample-format
{ 2 [ sample-format-signed-integer ] }
{ 3 [ sample-format-ieee-float ] }
{ 4 [ sample-format-undefined-data ] }
- [ throw-bad-sample-format ]
+ [ bad-sample-format ]
} case
] map ;
{ 0 [ extra-samples-unspecified-alpha-data ] }
{ 1 [ extra-samples-associated-alpha-data ] }
{ 2 [ extra-samples-unassociated-alpha-data ] }
- [ throw-bad-extra-samples ]
+ [ bad-extra-samples ]
} case ;
SINGLETONS: image-length image-width x-resolution y-resolution
{
{ 1 [ jpeg-proc-baseline ] }
{ 14 [ jpeg-proc-lossless ] }
- [ throw-bad-jpeg-proc ]
+ [ bad-jpeg-proc ]
} case ;
ERROR: bad-tiff-magic bytes ;
{
{ B{ CHAR: M CHAR: M } [ big-endian ] }
{ B{ CHAR: I CHAR: I } [ little-endian ] }
- [ throw-bad-tiff-magic ]
+ [ bad-tiff-magic ]
} case ;
: read-header ( tiff -- tiff )
swap processed-tags>> ?at ;
: find-tag ( ifd class -- tag )
- find-tag* [ throw-no-tag ] unless ;
+ find-tag* [ no-tag ] unless ;
: tag? ( ifd class -- tag )
swap processed-tags>> key? ;
{ 11 [ 4 * ] }
{ 12 [ 8 * ] }
{ 13 [ 4 * ] }
- [ "value-length" throw-unknown-ifd-type ]
+ [ "value-length" unknown-ifd-type ]
} case ;
ERROR: bad-small-ifd-type n ;
{ 9 [ endian> 32 >signed ] }
{ 11 [ endian> bits>float ] }
{ 13 [ endian> 32 >signed ] }
- [ throw-bad-small-ifd-type ]
+ [ bad-small-ifd-type ]
} case ;
: offset-bytes>obj ( bytes type -- obj )
{ 10 [ 8 group [ "ii" unpack first2 / ] map ] }
{ 11 [ 4 group [ "f" unpack ] map ] }
{ 12 [ 8 group [ "d" unpack ] map ] }
- [ "offset-bytes>obj" throw-unknown-ifd-type ]
+ [ "offset-bytes>obj" unknown-ifd-type ]
} case ;
: ifd-entry-value ( ifd-entry -- n )
{
{ compression-none [ ] }
{ compression-lzw [ [ tiff-lzw-uncompress ] map ] }
- [ throw-unhandled-compression ]
+ [ unhandled-compression ]
} case ;
: uncompress-strips ( ifd -- ifd )
[ * ] keep
'[
_ group
- [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
+ [ _ [ group ] [ 0 <array> ] bi [ v+ ] accumulate* concat ] map
B{ } concat-as
] change-bitmap ;
{
{ predictor-none [ ] }
{ predictor-horizontal-differencing [ (strips-predictor) ] }
- [ throw-bad-predictor ]
+ [ bad-predictor ]
} case
] when ;
{ { 8 8 8 8 } [ ] }
{ { 8 8 8 } [ ] }
{ 8 [ ] }
- [ throw-unknown-component-order ]
+ [ unknown-component-order ]
} case >>bitmap ;
: ifd-component-order ( ifd -- component-order component-type )
{ { 8 8 8 8 } [ RGBA ubyte-components ] }
{ { 8 8 8 } [ RGB ubyte-components ] }
{ 8 [ LA ubyte-components ] }
- [ throw-unknown-component-order ]
+ [ unknown-component-order ]
} case ;
: handle-alpha-data ( ifd -- ifd )
{ extra-samples-associated-alpha-data [ ] }
{ extra-samples-unspecified-alpha-data [ ] }
{ extra-samples-unassociated-alpha-data [ ] }
- [ throw-bad-extra-samples ]
+ [ bad-extra-samples ]
} case ;
: ifd>image ( ifd -- image )