drawing 96bpp images works, add lots of previously unknown ifd fields

diff --git a/basis/images/images.factor b/basis/images/images.factor
index 41d96a673b619bcbbfd8d0d412b4e3d4640f91e9..e366dd2700c54d16a040238282b5b49398c9d08f 100644 (file)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -5,7 +5,7 @@ math specialized-arrays.direct.uint byte-arrays ;
 IN: images
 
 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
-16R16G16B 32R32G32B ;
+R16G16B16 R32G32B32 ;
 
 TUPLE: image dim component-order byte-order bitmap ;
 
@@ -13,22 +13,32 @@ TUPLE: image dim component-order byte-order bitmap ;
 
 GENERIC: load-image* ( path tuple -- image )
 
+: add-dummy-alpha ( seq -- seq' )
+    3 <sliced-groups>
+    [ 255 suffix ] map concat ;
+
 : normalize-component-order ( image -- image )
     dup component-order>>
     {
         { RGBA [ ] }
+        { R32G32B32 [
+            [
+                dup length 4 / <direct-uint-array>
+                [ bits>float 255.0 * >integer ] map
+                >byte-array add-dummy-alpha
+            ] change-bitmap
+        ] }
         { BGRA [
             [
                 4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
             ] change-bitmap
         ] }
-        { RGB [
-            [ 3 <sliced-groups> [ 255 suffix ] map concat ] change-bitmap
-        ] }
+        { RGB [ [ add-dummy-alpha ] change-bitmap ] }
         { BGR [
             [
-                3 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
-                [ 255 suffix ] map concat
+                3 <sliced-groups>
+                [ [ [ 0 3 ] dip <slice> reverse-here ] each ]
+                [ add-dummy-alpha ] bi
             ] change-bitmap
         ] }
     } case
@@ -39,5 +49,6 @@ GENERIC: normalize-scan-line-order ( image -- image )
 M: image normalize-scan-line-order ;
 
 : normalize-image ( image -- image )
+    [ >byte-array ] change-bitmap
     normalize-component-order
     normalize-scan-line-order ;

diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index 28eee7d98a2986bad97eaa57d0d9c9fbf55c7df2..db5141521ddc7ac773b7f6557edd334954c93a23 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -3,7 +3,7 @@
 USING: accessors combinators io io.encodings.binary io.files kernel
 pack endian constructors sequences arrays math.order math.parser
 prettyprint classes io.binary assocs math math.bitwise byte-arrays
-grouping images compression.lzw fry ;
+grouping images compression.lzw fry strings ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -115,8 +115,9 @@ ERROR: bad-extra-samples n ;
 
 SINGLETONS: image-length image-width x-resolution y-resolution
 rows-per-strip strip-offsets strip-byte-counts bits-per-sample
-samples-per-pixel new-subfile-type orientation
-unhandled-ifd-entry ;
+samples-per-pixel new-subfile-type orientation software
+date-time photoshop exif-ifd sub-ifd inter-color-profile
+xmp iptc unhandled-ifd-entry ;
 
 ERROR: bad-tiff-magic bytes ;
 : tiff-endianness ( byte-array -- ? )
@@ -185,6 +186,7 @@ ERROR: unknown-ifd-type n ;
         { 10 [ 8 * ] }
         { 11 [ 4 * ] }
         { 12 [ 8 * ] }
+        { 13 [ 4 * ] }
         [ unknown-ifd-type ]
     } case ;
 
@@ -200,6 +202,7 @@ ERROR: bad-small-ifd-type n ;
         { 8 [ 2 head endian> 16 >signed ] }
         { 9 [ endian> 32 >signed ] }
         { 11 [ endian> bits>float ] }
+        { 13 [ endian> 32 >signed ] }
         [ bad-small-ifd-type ]
     } case ;
 
@@ -246,10 +249,18 @@ ERROR: bad-small-ifd-type n ;
         { 283 [ y-resolution ] }
         { 284 [ planar-configuration ] }
         { 296 [ lookup-resolution-unit resolution-unit ] }
+        { 305 [ >string software ] }
+        { 306 [ >string date-time ] }
         { 317 [ lookup-predictor predictor ] }
+        { 330 [ sub-ifd ] }
         { 338 [ lookup-extra-samples extra-samples ] }
         { 339 [ lookup-sample-format sample-format ] }
-        [ nip unhandled-ifd-entry ]
+        { 700 [ >string xmp ] }
+        { 34377 [ photoshop ] }
+        { 34665 [ exif-ifd ] }
+        { 33723 [ iptc ] }
+        { 34675 [ inter-color-profile ] }
+        [ nip unhandled-ifd-entry swap ]
     } case ;
 
 : process-ifd ( ifd -- ifd )
@@ -277,8 +288,8 @@ ERROR: unknown-component-order ifd ;
 
 : ifd-component-order ( ifd -- byte-order )
     bits-per-sample find-tag {
-        { { 32 32 32 } [ 32R32G32B ] }
-        { { 16 16 16 } [ 16R16G16B ] }
+        { { 32 32 32 } [ R32G32B32 ] }
+        { { 16 16 16 } [ R16G16B16 ] }
         { { 8 8 8 8 } [ RGBA ] }
         { { 8 8 8 } [ RGB ] }
         [ unknown-component-order ]