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

basis/images/images.factor

@@ -1,9 +1,11 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors grouping sequences combinators ;
+USING: kernel accessors grouping sequences combinators
+math specialized-arrays.direct.uint byte-arrays ;
 IN: images
 
-SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
+SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
+R16G16B16 R32G32B32 ;
 
 TUPLE: image dim component-order byte-order bitmap ;
 
@@ -11,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 [
+        { RGB [ [ add-dummy-alpha ] change-bitmap ] }
-            [ 3 <sliced-groups> [ 255 suffix ] map concat ] change-bitmap
-        ] }
         { BGR [
             [
-                3 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
+                3 <sliced-groups>
-                [ 255 suffix ] map concat
+                [ [ [ 0 3 ] dip <slice> reverse-here ] each ]
+                [ add-dummy-alpha ] bi
             ] change-bitmap
         ] }
     } case
@@ -37,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 ;

basis/images/loader/loader.factor

@@ -10,6 +10,7 @@ ERROR: unknown-image-extension extension ;
 : image-class ( path -- class )
     file-extension >lower {
         { "bmp" [ bitmap-image ] }
+        { "tif" [ tiff-image ] }
         { "tiff" [ tiff-image ] }
         [ unknown-image-extension ]
     } case ;

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
+samples-per-pixel new-subfile-type orientation software
-unhandled-ifd-entry ;
+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 )
@@ -276,9 +287,11 @@ ERROR: unhandled-compression compression ;
 ERROR: unknown-component-order ifd ;
 
 : ifd-component-order ( ifd -- byte-order )
-    bits-per-sample find-tag sum {
+    bits-per-sample find-tag {
-        { 32 [ RGBA ] }
+        { { 32 32 32 } [ R32G32B32 ] }
-        { 24 [ RGB ] }
+        { { 16 16 16 } [ R16G16B16 ] }
+        { { 8 8 8 8 } [ RGBA ] }
+        { { 8 8 8 } [ RGB ] }
         [ unknown-component-order ]
     } case ;
 

basis/tools/hexdump/hexdump.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays io io.streams.string kernel math math.parser
-namespaces sequences splitting grouping strings ascii byte-arrays ;
+namespaces sequences splitting grouping strings ascii
+byte-arrays byte-vectors ;
 IN: tools.hexdump
 
 <PRIVATE
@@ -26,13 +27,17 @@ IN: tools.hexdump
 : write-hex-line ( bytes lineno -- )
     write-offset [ >hex-digits write ] [ >ascii write ] bi nl ;
 
+: hexdump-bytes ( bytes -- )
+    [ length write-header ]
+    [ 16 <sliced-groups> [ write-hex-line ] each-index ] bi ;
+
 PRIVATE>
 
 GENERIC: hexdump. ( byte-array -- )
 
-M: byte-array hexdump.
+M: byte-array hexdump. hexdump-bytes ;
-    [ length write-header ]
+
-    [ 16 <sliced-groups> [ write-hex-line ] each-index ] bi ;
+M: byte-vector hexdump. hexdump-bytes ;
 
 : hexdump ( byte-array -- str )
     [ hexdump. ] with-string-writer ;

basis/zlib/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/zlib/ffi/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/zlib/ffi/ffi.factor

@@ -1,30 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators system ;
-IN: zlib.ffi
-
-<< "zlib" {
-    { [ os winnt? ] [ "zlib1.dll" ] }
-    { [ os macosx? ] [ "libz.dylib" ] }
-    { [ os unix? ] [ "libz.so" ] }
-} cond "cdecl" add-library >>
-
-LIBRARY: zlib
-
-CONSTANT: Z_OK 0
-CONSTANT: Z_STREAM_END 1
-CONSTANT: Z_NEED_DICT 2
-CONSTANT: Z_ERRNO -1
-CONSTANT: Z_STREAM_ERROR -2
-CONSTANT: Z_DATA_ERROR -3
-CONSTANT: Z_MEM_ERROR -4
-CONSTANT: Z_BUF_ERROR -5
-CONSTANT: Z_VERSION_ERROR -6
-
-TYPEDEF: void Bytef
-TYPEDEF: ulong uLongf
-TYPEDEF: ulong uLong
-
-FUNCTION: int compress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
-FUNCTION: int compress2 ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen, int level ) ;
-FUNCTION: int uncompress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;

basis/zlib/zlib-tests.factor

@@ -1,9 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel tools.test zlib classes ;
-IN: zlib.tests
-
-: compress-me ( -- byte-array ) B{ 1 2 3 4 5 } ;
-
-[ t ] [ compress-me [ compress uncompress ] keep = ] unit-test
-[ t ] [ compress-me compress compressed instance? ] unit-test

basis/zlib/zlib.factor

@@ -1,48 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.syntax byte-arrays combinators
-kernel math math.functions sequences system accessors
-libc ;
-QUALIFIED: zlib.ffi
-IN: zlib
-
-TUPLE: compressed data length ;
-
-: <compressed> ( data length -- compressed )
-    compressed new
-        swap >>length
-        swap >>data ;
-
-ERROR: zlib-failed n string ;
-
-: zlib-error-message ( n -- * )
-    dup zlib.ffi:Z_ERRNO = [
-        drop errno "native libc error"
-    ] [
-        dup {
-            "no error" "libc_error"
-            "stream error" "data error"
-            "memory error" "buffer error" "zlib version error"
-        } ?nth
-    ] if zlib-failed ;
-
-: zlib-error ( n -- )
-    dup zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
-
-: compressed-size ( byte-array -- n )
-    length 1001/1000 * ceiling 12 + ;
-
-: compress ( byte-array -- compressed )
-    [
-        [ compressed-size <byte-array> dup length <ulong> ] keep [
-            dup length zlib.ffi:compress zlib-error
-        ] 3keep drop *ulong head
-    ] keep length <compressed> ;
-
-: uncompress ( compressed -- byte-array )
-    [
-        length>> [ <byte-array> ] keep <ulong> 2dup
-    ] [
-        data>> dup length
-        zlib.ffi:uncompress zlib-error
-    ] bi *ulong head ;

core/classes/tuple/tuple-docs.factor

@@ -241,7 +241,7 @@ ARTICLE: "tuple-examples" "Tuple examples"
 }
 "An example of using a changer:"
 { $code
-    ": positions"
+    ": positions ( -- seq )"
     "    {"
     "        \"junior programmer\""
     "        \"senior programmer\""