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

basis/endian/endian.factor

@@ -1,39 +1,39 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types namespaces io.binary fry
-kernel math ;
+kernel math grouping sequences ;
 IN: endian
 
 SINGLETONS: big-endian little-endian ;
 
-: native-endianness ( -- class )
+: compute-native-endianness ( -- class )
     1 <int> *char 0 = big-endian little-endian ? ;
 
 : >signed ( x n -- y )
     2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
 
-native-endianness \ native-endianness set-global
+SYMBOL: native-endianness
+native-endianness [ compute-native-endianness ] initialize
 
 SYMBOL: endianness
+endianness [ native-endianness get-global ] initialize
 
-\ native-endianness get-global endianness set-global
+HOOK: >native-endian native-endianness ( obj n -- bytes )
-
-HOOK: >native-endian native-endianness ( obj n -- str )
 
 M: big-endian >native-endian >be ;
 
 M: little-endian >native-endian >le ;
 
-HOOK: unsigned-native-endian> native-endianness ( obj -- str )
+HOOK: unsigned-native-endian> native-endianness ( obj -- bytes )
 
 M: big-endian unsigned-native-endian> be> ;
 
 M: little-endian unsigned-native-endian> le> ;
 
-: signed-native-endian> ( obj n -- str )
+: signed-native-endian> ( obj n -- n' )
     [ unsigned-native-endian> ] dip >signed ;
 
-HOOK: >endian endianness ( obj n -- str )
+HOOK: >endian endianness ( obj n -- bytes )
 
 M: big-endian >endian >be ;
 
@@ -45,13 +45,13 @@ M: big-endian endian> be> ;
 
 M: little-endian endian> le> ;
 
-HOOK: unsigned-endian> endianness ( obj -- str )
+HOOK: unsigned-endian> endianness ( obj -- bytes )
 
 M: big-endian unsigned-endian> be> ;
 
 M: little-endian unsigned-endian> le> ;
 
-: signed-endian> ( obj n -- str )
+: signed-endian> ( obj n -- bytes )
     [ unsigned-endian> ] dip >signed ;
 
 : with-endianness ( endian quot -- )
@@ -65,3 +65,15 @@ M: little-endian unsigned-endian> le> ;
 
 : with-native-endian ( quot -- )
     \ native-endianness get-global swap with-endianness ; inline
+
+: seq>native-endianness ( seq n -- seq' )
+    native-endianness get-global dup endianness get = [
+        2drop
+    ] [
+        [ [ <sliced-groups> ] keep ] dip
+        little-endian = [
+            '[ be> _ >le ] map
+        ] [
+            '[ le> _ >be ] map
+        ] if concat
+    ] if ; inline

basis/images/bitmap/bitmap.factor

@@ -105,7 +105,6 @@ ERROR: unknown-component-order bitmap ;
     {
         [ [ width>> ] [ height>> ] bi 2array ]
         [ bitmap>component-order ]
-        [ drop little-endian ] ! XXX
         [ buffer>> ]
     } cleave bitmap-image boa ;
 

basis/images/images.factor

@@ -1,13 +1,14 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors grouping sequences combinators
-math specialized-arrays.direct.uint byte-arrays ;
+math specialized-arrays.direct.uint byte-arrays
+specialized-arrays.direct.ushort ;
 IN: images
 
 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 R16G16B16 R32G32B32 ;
 
-TUPLE: image dim component-order byte-order bitmap ;
+TUPLE: image dim component-order bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
@@ -28,6 +29,13 @@ GENERIC: load-image* ( path tuple -- image )
                 >byte-array add-dummy-alpha
             ] change-bitmap
         ] }
+        { R16G16B16 [
+            [
+                dup length 2 / <direct-ushort-array>
+                [ -8 shift ] map
+                >byte-array add-dummy-alpha
+            ] change-bitmap
+        ] }
         { BGRA [
             [
                 4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each

basis/images/tiff/tiff.factor

@@ -1,9 +1,11 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators io io.encodings.binary io.files kernel
+USING: accessors arrays assocs byte-arrays classes combinators
-pack endian constructors sequences arrays math.order math.parser
+compression.lzw constructors endian fry grouping images io
-prettyprint classes io.binary assocs math math.bitwise byte-arrays
+io.binary io.encodings.ascii io.encodings.binary
-grouping images compression.lzw fry strings ;
+io.encodings.string io.encodings.utf8 io.files kernel math
+math.bitwise math.order math.parser pack prettyprint sequences
+strings ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -249,13 +251,13 @@ ERROR: bad-small-ifd-type n ;
         { 283 [ first y-resolution ] }
         { 284 [ planar-configuration ] }
         { 296 [ lookup-resolution-unit resolution-unit ] }
-        { 305 [ >string software ] }
+        { 305 [ ascii decode software ] }
-        { 306 [ >string date-time ] }
+        { 306 [ ascii decode date-time ] }
         { 317 [ lookup-predictor predictor ] }
         { 330 [ sub-ifd ] }
         { 338 [ lookup-extra-samples extra-samples ] }
         { 339 [ lookup-sample-format sample-format ] }
-        { 700 [ >string xmp ] }
+        { 700 [ utf8 decode xmp ] }
         { 34377 [ photoshop ] }
         { 34665 [ exif-ifd ] }
         { 33723 [ iptc ] }
@@ -286,6 +288,18 @@ ERROR: unhandled-compression compression ;
 
 ERROR: unknown-component-order ifd ;
 
+: fix-bitmap-endianness ( ifd -- ifd )
+    dup [ bitmap>> ] [ bits-per-sample find-tag ] bi
+    {
+        { { 32 32 32 32 } [ 4 seq>native-endianness ] }
+        { { 32 32 32 } [ 4 seq>native-endianness ] }
+        { { 16 16 16 16 } [ 2 seq>native-endianness ] }
+        { { 16 16 16 } [ 2 seq>native-endianness ] }
+        { { 8 8 8 8 } [ ] }
+        { { 8 8 8 } [ ] }
+        [ unknown-component-order ]
+    } case >>bitmap ;
+
 : ifd-component-order ( ifd -- byte-order )
     bits-per-sample find-tag {
         { { 32 32 32 } [ R32G32B32 ] }
@@ -299,7 +313,6 @@ ERROR: unknown-component-order ifd ;
     {
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
         [ ifd-component-order ]
-        [ drop big-endian ] ! XXX
         [ bitmap>> ]
     } cleave tiff-image boa ;
 
@@ -314,7 +327,9 @@ ERROR: unknown-component-order ifd ;
             dup ifds>> [
                 process-ifd read-strips
                 uncompress-strips
-                strips>bitmap drop
+                strips>bitmap
+                fix-bitmap-endianness
+                drop
             ] each
         ] with-endianness
     ] with-file-reader ;

extra/system-info/linux/linux.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: unix alien alien.c-types kernel math sequences strings
-io.backend.unix splitting ;
+io.backend.unix splitting io.encodings.utf8 io.encodings.string ;
 IN: system-info.linux
 
 : (uname) ( buf -- int )
@@ -9,7 +9,7 @@ IN: system-info.linux
 
 : uname ( -- seq )
     65536 "char" <c-array> [ (uname) io-error ] keep
-    "\0" split harvest [ >string ] map
+    "\0" split harvest [ utf8 decode ] map
     6 "" pad-tail ;
 
 : sysname ( -- string ) uname first ;