Merge branch 'master' of git://factorcode.org/git/factor

basis/endian/endian.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types namespaces io.binary fry
-kernel math grouping sequences ;
+kernel math grouping sequences math.bitwise ;
 IN: endian
 
 SINGLETONS: big-endian little-endian ;
@@ -9,9 +9,6 @@ SINGLETONS: big-endian little-endian ;
 : compute-native-endianness ( -- class )
     1 <int> *char 0 = big-endian little-endian ? ;
 
-: >signed ( x n -- y )
-    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
-
 SYMBOL: native-endianness
 native-endianness [ compute-native-endianness ] initialize
 

basis/images/images.factor

@@ -2,11 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors grouping sequences combinators
 math specialized-arrays.direct.uint byte-arrays
-specialized-arrays.direct.ushort ;
+specialized-arrays.direct.ushort specialized-arrays.uint
+specialized-arrays.ushort specialized-arrays.float ;
 IN: images
 
 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
-R16G16B16 R32G32B32 ;
+R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
 
 TUPLE: image dim component-order bitmap ;
 
@@ -18,34 +19,37 @@ GENERIC: load-image* ( path tuple -- image )
     3 <sliced-groups>
     [ 255 suffix ] map concat ;
 
+: normalize-floats ( byte-array -- byte-array )
+    byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
+
 : normalize-component-order ( image -- image )
     dup component-order>>
     {
         { RGBA [ ] }
+        { R32G32B32A32 [
+            [ normalize-floats ] change-bitmap
+        ] }
         { R32G32B32 [
-            [
+            [ normalize-floats add-dummy-alpha ] change-bitmap
-                dup length 4 / <direct-uint-array>
+        ] }
-                [ bits>float 255.0 * >integer ] map
+        { R16G16B16A16 [
-                >byte-array add-dummy-alpha
+            [ byte-array>ushort-array [ -8 shift ] B{ } map-as ] change-bitmap
-            ] change-bitmap
         ] }
         { R16G16B16 [
             [
-                dup length 2 / <direct-ushort-array>
+                byte-array>ushort-array [ -8 shift ] B{ } map-as add-dummy-alpha
-                [ -8 shift ] map
-                >byte-array add-dummy-alpha
             ] change-bitmap
         ] }
         { BGRA [
             [
-                4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
+                4 <sliced-groups> dup [ 3 head-slice reverse-here ] each
             ] change-bitmap
         ] }
         { RGB [ [ add-dummy-alpha ] change-bitmap ] }
         { BGR [
             [
                 3 <sliced-groups>
-                [ [ [ 0 3 ] dip <slice> reverse-here ] each ]
+                [ [ 3 head-slice reverse-here ] each ]
                 [ add-dummy-alpha ] bi
             ] change-bitmap
         ] }

basis/images/tiff/tiff.factor

@@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io
 io.binary io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
-strings ;
+strings math.vectors ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -119,7 +119,9 @@ 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 software
 date-time photoshop exif-ifd sub-ifd inter-color-profile
-xmp iptc unhandled-ifd-entry ;
+xmp iptc fill-order document-name page-number page-name
+x-position y-position
+unhandled-ifd-entry ;
 
 ERROR: bad-tiff-magic bytes ;
 : tiff-endianness ( byte-array -- ? )
@@ -159,6 +161,9 @@ ERROR: no-tag class ;
 : find-tag ( idf class -- tag )
     swap processed-tags>> ?at [ no-tag ] unless ;
 
+: tag? ( idf class -- tag )
+    swap processed-tags>> key? ;
+
 : read-strips ( ifd -- ifd )
     dup
     [ strip-byte-counts find-tag ]
@@ -242,6 +247,8 @@ ERROR: bad-small-ifd-type n ;
         { 258 [ bits-per-sample ] }
         { 259 [ lookup-compression compression ] }
         { 262 [ lookup-photometric-interpretation photometric-interpretation ] }
+        { 266 [ fill-order ] }
+        { 269 [ ascii decode document-name ] }
         { 273 [ strip-offsets ] }
         { 274 [ orientation ] }
         { 277 [ samples-per-pixel ] }
@@ -250,7 +257,11 @@ ERROR: bad-small-ifd-type n ;
         { 282 [ first x-resolution ] }
         { 283 [ first y-resolution ] }
         { 284 [ planar-configuration ] }
+        { 285 [ page-name ] }
+        { 286 [ x-position ] }
+        { 287 [ y-position ] }
         { 296 [ lookup-resolution-unit resolution-unit ] }
+        { 297 [ page-number ] }
         { 305 [ ascii decode software ] }
         { 306 [ ascii decode date-time ] }
         { 317 [ lookup-predictor predictor ] }
@@ -286,6 +297,27 @@ ERROR: unhandled-compression compression ;
 : strips>bitmap ( ifd -- ifd )
     dup strips>> concat >>bitmap ;
 
+: (strips-predictor) ( ifd -- ifd )
+    [ ]
+    [ image-width find-tag ]
+    [ samples-per-pixel find-tag ] tri
+    [ * ] keep
+    '[
+        _ group [ _ group [ rest ] [ first ] bi
+        [ v+ ] accumulate swap suffix concat ] map
+        concat >byte-array
+    ] change-bitmap ;
+
+: strips-predictor ( ifd -- ifd )
+    dup predictor tag? [
+        dup predictor find-tag
+        {
+            { predictor-none [ ] }
+            { predictor-horizontal-differencing [ (strips-predictor) ] }
+            [ bad-predictor ]
+        } case
+    ] when ;
+
 ERROR: unknown-component-order ifd ;
 
 : fix-bitmap-endianness ( ifd -- ifd )
@@ -302,7 +334,9 @@ ERROR: unknown-component-order ifd ;
 
 : ifd-component-order ( ifd -- byte-order )
     bits-per-sample find-tag {
+        { { 32 32 32 32 } [ R32G32B32A32 ] }
         { { 32 32 32 } [ R32G32B32 ] }
+        { { 16 16 16 16 } [ R16G16B16A16 ] }
         { { 16 16 16 } [ R16G16B16 ] }
         { { 8 8 8 8 } [ RGBA ] }
         { { 8 8 8 } [ RGB ] }
@@ -329,6 +363,7 @@ ERROR: unknown-component-order ifd ;
                 uncompress-strips
                 strips>bitmap
                 fix-bitmap-endianness
+                strips-predictor
                 drop
             ] each
         ] with-endianness

basis/math/bitwise/bitwise.factor

@@ -102,3 +102,7 @@ PRIVATE>
 
 : signed-be> ( bytes -- x )
     <reversed> signed-le> ;
+
+: >signed ( x n -- y )
+    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
+