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

throw more errors on tiff if formats are unsupported

db4
Doug Coleman 2009-05-05 22:58:38 -05:00
parent 58d0e17936
commit 8e8623aef0
1 changed files with 44 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
basis/images/tiff/tiff.factor
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 math.vectors specialized-arrays.float ; strings math.vectors specialized-arrays.float locals ;
IN: images.tiff IN: images.tiff
TUPLE: tiff-image < image ; TUPLE: tiff-image < image ;
@ -184,7 +184,7 @@ samples-per-pixel new-subfile-type subfile-type orientation
software date-time photoshop exif-ifd sub-ifd inter-color-profile software date-time photoshop exif-ifd sub-ifd inter-color-profile
xmp iptc fill-order document-name page-number page-name xmp iptc fill-order document-name page-number page-name
x-position y-position host-computer copyright artist x-position y-position host-computer copyright artist
min-sample-value max-sample-value make model cell-width cell-length min-sample-value max-sample-value tiff-make tiff-model cell-width cell-length
gray-response-unit gray-response-curve color-map threshholding gray-response-unit gray-response-curve color-map threshholding
image-description free-offsets free-byte-counts tile-width tile-length image-description free-offsets free-byte-counts tile-width tile-length
matteing data-type image-depth tile-depth matteing data-type image-depth tile-depth
@ -243,10 +243,13 @@ ERROR: bad-tiff-magic bytes ;
ERROR: no-tag class ; ERROR: no-tag class ;
: find-tag ( idf class -- tag ) : find-tag* ( ifd class -- tag/class ? )
swap processed-tags>> ?at [ no-tag ] unless ; swap processed-tags>> ?at ;
: tag? ( idf class -- tag ) : find-tag ( ifd class -- tag )
find-tag* [ no-tag ] unless ;
: tag? ( ifd class -- tag )
swap processed-tags>> key? ; swap processed-tags>> key? ;
: read-strips ( ifd -- ifd ) : read-strips ( ifd -- ifd )
@ -339,8 +342,8 @@ ERROR: bad-small-ifd-type n ;
{ 266 [ fill-order ] } { 266 [ fill-order ] }
{ 269 [ ascii decode document-name ] } { 269 [ ascii decode document-name ] }
{ 270 [ ascii decode image-description ] } { 270 [ ascii decode image-description ] }
{ 271 [ ascii decode make ] } { 271 [ ascii decode tiff-make ] }
{ 272 [ ascii decode model ] } { 272 [ ascii decode tiff-model ] }
{ 273 [ strip-offsets ] } { 273 [ strip-offsets ] }
{ 274 [ orientation ] } { 274 [ orientation ] }
{ 277 [ samples-per-pixel ] } { 277 [ samples-per-pixel ] }
@ -350,7 +353,7 @@ ERROR: bad-small-ifd-type n ;
{ 281 [ max-sample-value ] } { 281 [ max-sample-value ] }
{ 282 [ first x-resolution ] } { 282 [ first x-resolution ] }
{ 283 [ first y-resolution ] } { 283 [ first y-resolution ] }
{ 284 [ planar-configuration ] } { 284 [ lookup-planar-configuration planar-configuration ] }
{ 285 [ page-name ] } { 285 [ page-name ] }
{ 286 [ x-position ] } { 286 [ x-position ] }
{ 287 [ y-position ] } { 287 [ y-position ] }
@ -437,8 +440,8 @@ ERROR: unhandled-compression compression ;
[ samples-per-pixel find-tag ] tri [ samples-per-pixel find-tag ] tri
[ * ] keep [ * ] keep
'[ '[
_ group [ _ group [ rest ] [ first ] bi _ group
[ v+ ] accumulate swap suffix concat ] map [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
concat >byte-array concat >byte-array
] change-bitmap ; ] change-bitmap ;
@ -521,23 +524,39 @@ ERROR: unknown-component-order ifd ;
] with-tiff-endianness ] with-tiff-endianness
] with-file-reader ; ] with-file-reader ;
: process-tif-ifds ( parsed-tiff -- parsed-tiff ) : process-chunky-ifd ( ifd -- )
dup ifds>> [ read-strips
read-strips uncompress-strips
uncompress-strips strips>bitmap
strips>bitmap fix-bitmap-endianness
fix-bitmap-endianness strips-predictor
strips-predictor dup extra-samples tag? [ handle-alpha-data ] when
dup extra-samples tag? [ handle-alpha-data ] when drop ;
drop
] each ; : process-planar-ifd ( ifd -- )
"planar ifd not supported" throw ;
: dispatch-planar-configuration ( ifd planar-configuration -- )
{
{ planar-configuration-chunky [ process-chunky-ifd ] }
{ planar-configuration-planar [ process-planar-ifd ] }
} case ;
: process-ifd ( ifd -- )
dup planar-configuration find-tag* [
dispatch-planar-configuration
] [
drop "no planar configuration" throw
] if ;
: process-tif-ifds ( parsed-tiff -- )
ifds>> [ process-ifd ] each ;
: load-tiff ( path -- parsed-tiff ) : load-tiff ( path -- parsed-tiff )
[ load-tiff-ifds ] [ [ load-tiff-ifds dup ] keep
binary [ binary [
[ process-tif-ifds ] with-tiff-endianness [ process-tif-ifds ] with-tiff-endianness
] with-file-reader ] with-file-reader ;
] bi ;
! tiff files can store several images -- we just take the first for now ! tiff files can store several images -- we just take the first for now
M: tiff-image load-image* ( path tiff-image -- image ) M: tiff-image load-image* ( path tiff-image -- image )