diff --git a/extra/graphics/tiff/tiff-tests.factor b/extra/graphics/tiff/tiff-tests.factor index daee9a5d9e..f800b4d213 100755 --- a/extra/graphics/tiff/tiff-tests.factor +++ b/extra/graphics/tiff/tiff-tests.factor @@ -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" ; diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor index f0b3f9337e..9461403805 100755 --- a/extra/graphics/tiff/tiff.factor +++ b/extra/graphics/tiff/tiff.factor @@ -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 ; +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 ; + + +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 ; + + +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> ; : read-ifds ( tiff -- tiff ) - [ - dup ifd-offset>> seek-absolute seek-input - 2 read endian> - dup [ read-ifd ] replicate - 4 read endian> - [ push-ifd ] [ 0 = [ read-ifds ] unless ] bi - ] with-tiff-endianness ; + dup ifd-offset>> seek-absolute seek-input + 2 read endian> + dup [ read-ifd ] replicate + 4 read endian> + [ 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 [ endian> ] map ] } + { 4 [ 4 [ endian> ] map ] } + { 5 [ 8 [ "II" unpack first2 / ] map ] } + { 6 [ [ 8 >signed ] map ] } + { 7 [ ] } ! blank + { 8 [ 2 [ endian> 16 >signed ] map ] } + { 9 [ 4 [ 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 [ ] } + { 274 [ ] } { 277 [ ] } { 278 [ ] } { 279 [ ] } @@ -207,21 +318,32 @@ ERROR: bad-tiff-magic bytes ; { 284 [ ] } { 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 [ - read-header - read-ifds - dup ifds>> [ process-ifd read-strips drop ] each + 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) ;