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

handle associated alpha data in tiffs

db4
Doug Coleman 2009-02-14 19:24:42 -06:00
parent 99122a8fb1
commit 47a2f42c9f
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
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 ; strings math.vectors specialized-arrays.float ;
IN: images.tiff IN: images.tiff
TUPLE: tiff-image < image ; TUPLE: tiff-image < image ;
@ -343,6 +343,25 @@ ERROR: unknown-component-order ifd ;
[ unknown-component-order ] [ unknown-component-order ]
} case ; } case ;
: handle-alpha-data ( ifd -- ifd )
dup extra-samples find-tag {
{ extra-samples-associated-alpha-data [
[
B{ } like dup
byte-array>float-array
4 <sliced-groups>
[
dup fourth dup 0 = [
2drop
] [
[ 3 head-slice ] dip '[ _ / ] change-each
] if
] each
] change-bitmap
] }
[ bad-extra-samples ]
} case ;
: ifd>image ( ifd -- image ) : ifd>image ( ifd -- image )
{ {
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
@ -364,6 +383,7 @@ ERROR: unknown-component-order ifd ;
strips>bitmap strips>bitmap
fix-bitmap-endianness fix-bitmap-endianness
strips-predictor strips-predictor
handle-alpha-data
drop drop
] each ] each
] with-endianness ] with-endianness