steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

working on tiff

db4
Doug Coleman 2009-02-08 17:37:54 -06:00
parent c069add10b
commit 83252cce04
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/graphics/tiff/tiff.factor
View File

@ -2,20 +2,19 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators io io.encodings.binary io.files USING: accessors combinators io io.encodings.binary io.files
kernel pack endian tools.hexdump constructors sequences arrays kernel pack endian tools.hexdump constructors sequences arrays
sorting.slots math.order math.parser prettyprint ; sorting.slots math.order math.parser prettyprint classes ;
IN: graphics.tiff IN: graphics.tiff
TUPLE: tiff TUPLE: tiff
endianness endianness
the-answer the-answer
ifd-offset ifd-offset
ifds ifds ;
processed-ifds ;
CONSTRUCTOR: tiff ( -- tiff ) CONSTRUCTOR: tiff ( -- tiff )
V{ } clone >>ifds ; V{ } clone >>ifds ;
TUPLE: ifd count ifd-entries next ; TUPLE: ifd count ifd-entries next processed-tags strips ;
CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ; CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
@ -137,8 +136,6 @@ ERROR: bad-planar-configuration n ;
TUPLE: new-subfile-type n ; TUPLE: new-subfile-type n ;
CONSTRUCTOR: new-subfile-type ( n -- object ) ; CONSTRUCTOR: new-subfile-type ( n -- object ) ;
ERROR: bad-tiff-magic bytes ; ERROR: bad-tiff-magic bytes ;
: tiff-endianness ( byte-array -- ? ) : tiff-endianness ( byte-array -- ? )
@ -176,6 +173,12 @@ ERROR: bad-tiff-magic bytes ;
[ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi [ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
] with-tiff-endianness ; ] with-tiff-endianness ;
: 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 ;
! ERROR: unhandled-ifd-entry data n ; ! ERROR: unhandled-ifd-entry data n ;
: unhandled-ifd-entry ; : unhandled-ifd-entry ;
@ -207,17 +210,18 @@ ERROR: bad-tiff-magic bytes ;
[ unhandled-ifd-entry swap 2array ] [ unhandled-ifd-entry swap 2array ]
} case ; } case ;
: process-ifd ( ifd -- processed-ifd ) : process-ifd ( ifd -- ifd )
ifd-entries>> [ process-ifd-entry ] map ; dup ifd-entries>> [ process-ifd-entry ] map >>processed-tags ;
: (load-tiff) ( path -- tiff ) : (load-tiff) ( path -- tiff )
binary [ binary [
<tiff> <tiff>
read-header read-header
read-ifds read-ifds
dup ifds>> [ process-ifd ] map dup ifds>> [ process-ifd read-strips drop ] each
>>processed-ifds
] with-file-reader ; ] with-file-reader ;
: load-tiff ( path -- tiff ) : load-tiff ( path -- tiff )
(load-tiff) ; (load-tiff) ;
! TODO: duplicate ifds = error, seeking out of bounds = error