more work on tiff files.
Doug Coleman
parent
cbe86577d4
commit
d45f0c83eb
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2009 Your name.
|
||||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test graphics.tiff ;
|
||||
IN: graphics.tiff.tests
|
||||
|
|
@ -6,4 +6,6 @@ IN: graphics.tiff.tests
|
|||
: tiff-test-path ( -- path )
|
||||
"resource:extra/graphics/tiff/rgb.tiff" ;
|
||||
|
||||
: tiff-test-path2 ( -- path )
|
||||
"resource:extra/graphics/tiff/octagon.tiff" ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators io io.encodings.binary io.files
|
||||
kernel pack endian tools.hexdump constructors sequences arrays
|
||||
sorting.slots math.order math.parser prettyprint classes ;
|
||||
sorting.slots math.order math.parser prettyprint classes
|
||||
io.binary assocs math math.bitwise byte-arrays grouping ;
|
||||
USE: multiline
|
||||
|
||||
IN: graphics.tiff
|
||||
|
||||
TUPLE: tiff
|
||||
|
|
@ -14,13 +17,14 @@ ifds ;
|
|||
CONSTRUCTOR: tiff ( -- tiff )
|
||||
V{ } clone >>ifds ;
|
||||
|
||||
TUPLE: ifd count ifd-entries next processed-tags strips ;
|
||||
TUPLE: ifd count ifd-entries next
|
||||
processed-tags strips buffer ;
|
||||
|
||||
CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
|
||||
|
||||
TUPLE: ifd-entry tag type count offset ;
|
||||
TUPLE: ifd-entry tag type count offset/value ;
|
||||
|
||||
CONSTRUCTOR: ifd-entry ( tag type count offset -- ifd-entry ) ;
|
||||
CONSTRUCTOR: ifd-entry ( tag type count offset/value -- ifd-entry ) ;
|
||||
|
||||
|
||||
TUPLE: photometric-interpretation color ;
|
||||
|
|
@ -132,6 +136,44 @@ ERROR: bad-planar-configuration n ;
|
|||
[ bad-predictor ]
|
||||
} case <planar-configuration> ;
|
||||
|
||||
TUPLE: sample-format n ;
|
||||
CONSTRUCTOR: sample-format ( n -- object ) ;
|
||||
ERROR: bad-sample-format n ;
|
||||
|
||||
SINGLETONS: sample-unsigned-integer sample-signed-integer
|
||||
sample-ieee-float sample-undefined-data ;
|
||||
|
||||
: lookup-sample-format ( seq -- object )
|
||||
[
|
||||
{
|
||||
{ 1 [ sample-unsigned-integer ] }
|
||||
{ 2 [ sample-signed-integer ] }
|
||||
{ 3 [ sample-ieee-float ] }
|
||||
{ 4 [ sample-undefined-data ] }
|
||||
[ bad-sample-format ]
|
||||
} case
|
||||
] map <sample-format> ;
|
||||
|
||||
|
||||
TUPLE: extra-samples n ;
|
||||
CONSTRUCTOR: extra-samples ( n -- object ) ;
|
||||
ERROR: bad-extra-samples n ;
|
||||
|
||||
SINGLETONS: unspecified-alpha-data associated-alpha-data
|
||||
unassociated-alpha-data ;
|
||||
|
||||
: lookup-extra-samples ( seq -- object )
|
||||
{
|
||||
{ 0 [ unspecified-alpha-data ] }
|
||||
{ 1 [ associated-alpha-data ] }
|
||||
{ 2 [ unassociated-alpha-data ] }
|
||||
[ bad-extra-samples ]
|
||||
} case <extra-samples> ;
|
||||
|
||||
|
||||
TUPLE: orientation n ;
|
||||
CONSTRUCTOR: orientation ( n -- object ) ;
|
||||
|
||||
|
||||
TUPLE: new-subfile-type n ;
|
||||
CONSTRUCTOR: new-subfile-type ( n -- object ) ;
|
||||
|
|
@ -157,6 +199,7 @@ ERROR: bad-tiff-magic bytes ;
|
|||
|
||||
: push-ifd ( tiff ifd -- tiff )
|
||||
over ifds>> push ;
|
||||
! over [ dup class ] [ ifds>> ] bi* set-at ;
|
||||
|
||||
: read-ifd ( -- ifd )
|
||||
2 read endian>
|
||||
|
|
@ -165,29 +208,96 @@ ERROR: bad-tiff-magic bytes ;
|
|||
4 read endian> <ifd-entry> ;
|
||||
|
||||
: read-ifds ( tiff -- tiff )
|
||||
[
|
||||
dup ifd-offset>> seek-absolute seek-input
|
||||
2 read endian>
|
||||
dup [ read-ifd ] replicate
|
||||
4 read endian>
|
||||
[ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
|
||||
] with-tiff-endianness ;
|
||||
[ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi ;
|
||||
|
||||
ERROR: no-tag class ;
|
||||
|
||||
: ?at ( key assoc -- value/key ? )
|
||||
dupd at* [ nip t ] [ drop f ] if ; inline
|
||||
|
||||
: find-tag ( idf class -- tag )
|
||||
swap processed-tags>>
|
||||
?at [ no-tag ] unless ;
|
||||
|
||||
: read-strips ( ifd -- ifd )
|
||||
dup processed-tags>>
|
||||
[ [ strip-byte-counts instance? ] find nip n>> ]
|
||||
[ [ strip-offsets instance? ] find nip n>> ] bi
|
||||
[ seek-absolute seek-input read ] { } 2map-as >>strips ;
|
||||
dup
|
||||
[ strip-byte-counts find-tag n>> ]
|
||||
[ strip-offsets find-tag n>> ] bi
|
||||
2dup [ integer? ] both? [
|
||||
seek-absolute seek-input read 1array
|
||||
] [
|
||||
[ seek-absolute seek-input read ] { } 2map-as
|
||||
] if >>strips ;
|
||||
|
||||
! ERROR: unhandled-ifd-entry data n ;
|
||||
|
||||
: unhandled-ifd-entry ;
|
||||
|
||||
ERROR: unknown-ifd-type n ;
|
||||
|
||||
: bytes>bits ( n/byte-array -- n )
|
||||
dup byte-array? [ byte-array>bignum ] when ;
|
||||
|
||||
: value-length ( ifd-entry -- n )
|
||||
[ count>> ] [ type>> ] bi {
|
||||
{ 1 [ ] }
|
||||
{ 2 [ ] }
|
||||
{ 3 [ 2 * ] }
|
||||
{ 4 [ 4 * ] }
|
||||
{ 5 [ 8 * ] }
|
||||
{ 6 [ ] }
|
||||
{ 7 [ ] }
|
||||
{ 8 [ 2 * ] }
|
||||
{ 9 [ 4 * ] }
|
||||
{ 10 [ 8 * ] }
|
||||
{ 11 [ 4 * ] }
|
||||
{ 12 [ 8 * ] }
|
||||
[ unknown-ifd-type ]
|
||||
} case ;
|
||||
|
||||
ERROR: bad-small-ifd-type n ;
|
||||
|
||||
: adjust-offset/value ( ifd-entry -- obj )
|
||||
[ offset/value>> 4 >endian ] [ type>> ] bi
|
||||
{
|
||||
{ 1 [ 1 head endian> ] }
|
||||
{ 3 [ 2 head endian> ] }
|
||||
{ 4 [ endian> ] }
|
||||
{ 6 [ 1 head endian> 8 >signed ] }
|
||||
{ 8 [ 2 head endian> 16 >signed ] }
|
||||
{ 9 [ endian> 32 >signed ] }
|
||||
{ 11 [ endian> bits>float ] }
|
||||
[ bad-small-ifd-type ]
|
||||
} case ;
|
||||
|
||||
: offset-bytes>obj ( bytes type -- obj )
|
||||
{
|
||||
{ 1 [ ] } ! blank
|
||||
{ 2 [ ] } ! read c strings here
|
||||
{ 3 [ 2 <sliced-groups> [ endian> ] map ] }
|
||||
{ 4 [ 4 <sliced-groups> [ endian> ] map ] }
|
||||
{ 5 [ 8 <sliced-groups> [ "II" unpack first2 / ] map ] }
|
||||
{ 6 [ [ 8 >signed ] map ] }
|
||||
{ 7 [ ] } ! blank
|
||||
{ 8 [ 2 <sliced-groups> [ endian> 16 >signed ] map ] }
|
||||
{ 9 [ 4 <sliced-groups> [ endian> 32 >signed ] map ] }
|
||||
{ 10 [ 8 group [ "ii" unpack first2 / ] map ] }
|
||||
{ 11 [ 4 group [ "f" unpack ] map ] }
|
||||
{ 12 [ 8 group [ "d" unpack ] map ] }
|
||||
[ unknown-ifd-type ]
|
||||
} case ;
|
||||
|
||||
: ifd-entry-value ( ifd-entry -- n )
|
||||
dup count>> 1 = [
|
||||
offset>>
|
||||
dup value-length 4 <= [
|
||||
adjust-offset/value
|
||||
] [
|
||||
[ offset>> seek-absolute seek-input ] [ count>> read ] bi
|
||||
[ offset/value>> seek-absolute seek-input ]
|
||||
[ value-length read ]
|
||||
[ type>> ] tri offset-bytes>obj
|
||||
] if ;
|
||||
|
||||
: process-ifd-entry ( ifd-entry -- object )
|
||||
|
|
@ -199,6 +309,7 @@ ERROR: bad-tiff-magic bytes ;
|
|||
{ 259 [ lookup-compression ] }
|
||||
{ 262 [ lookup-photometric-interpretation ] }
|
||||
{ 273 [ <strip-offsets> ] }
|
||||
{ 274 [ <orientation> ] }
|
||||
{ 277 [ <samples-per-pixel> ] }
|
||||
{ 278 [ <rows-per-strip> ] }
|
||||
{ 279 [ <strip-byte-counts> ] }
|
||||
|
|
@ -207,21 +318,32 @@ ERROR: bad-tiff-magic bytes ;
|
|||
{ 284 [ <planar-configuration> ] }
|
||||
{ 296 [ lookup-resolution-unit ] }
|
||||
{ 317 [ lookup-predictor ] }
|
||||
{ 338 [ lookup-extra-samples ] }
|
||||
{ 339 [ lookup-sample-format ] }
|
||||
[ unhandled-ifd-entry swap 2array ]
|
||||
} case ;
|
||||
|
||||
: process-ifd ( ifd -- ifd )
|
||||
dup ifd-entries>> [ process-ifd-entry ] map >>processed-tags ;
|
||||
dup ifd-entries>>
|
||||
[ process-ifd-entry [ class ] keep ] H{ } map>assoc >>processed-tags ;
|
||||
|
||||
/*
|
||||
: ifd-strips>buffer ( ifd -- ifd )
|
||||
[
|
||||
[ rows-per-strip find-tag n>> ]
|
||||
[ image-length find-tag n>> ] bi
|
||||
] [
|
||||
strips>> [ length ] keep
|
||||
] bi assemble-image ;
|
||||
*/
|
||||
|
||||
: (load-tiff) ( path -- tiff )
|
||||
binary [
|
||||
<tiff>
|
||||
read-header
|
||||
read-header [
|
||||
read-ifds
|
||||
dup ifds>> [ process-ifd read-strips drop ] each
|
||||
] with-tiff-endianness
|
||||
] with-file-reader ;
|
||||
|
||||
: load-tiff ( path -- tiff )
|
||||
(load-tiff) ;
|
||||
|
||||
! TODO: duplicate ifds = error, seeking out of bounds = error
|
||||
: load-tiff ( path -- tiff ) (load-tiff) ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue