From 0ce47f84c607b594da2c4854cfc3db3c9a1457f5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:14:09 -0600 Subject: [PATCH 1/6] use decode instead of >string in images.tiff --- basis/images/tiff/tiff.factor | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 674188992a..f57f15ae20 100755 --- a/basis/images/tiff/tiff.factor +++ b/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 -pack endian constructors sequences arrays math.order math.parser -prettyprint classes io.binary assocs math math.bitwise byte-arrays -grouping images compression.lzw fry strings ; +USING: accessors arrays assocs byte-arrays classes combinators +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 ; 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 ] } - { 306 [ >string date-time ] } + { 305 [ ascii decode software ] } + { 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 ] } From 813b0cb803e79eab45b58cb41c89510257290432 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:46:36 -0600 Subject: [PATCH 2/6] get the byte ordering correct for tiffs --- basis/images/bitmap/bitmap.factor | 4 ++-- basis/images/images.factor | 2 +- basis/images/tiff/tiff.factor | 17 +++++++++++++++-- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index c9bb15192b..6713a729b5 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types arrays byte-arrays columns combinators fry grouping io io.binary io.encodings.binary io.files kernel macros math math.bitwise math.functions namespaces sequences -strings images endian summary ; +strings images endian summary annotations ; IN: images.bitmap TUPLE: bitmap-image < image ; @@ -105,7 +105,7 @@ ERROR: unknown-component-order bitmap ; { [ [ width>> ] [ height>> ] bi 2array ] [ bitmap>component-order ] - [ drop little-endian ] ! XXX + [ drop little-endian ] !XXX [ buffer>> ] } cleave bitmap-image boa ; diff --git a/basis/images/images.factor b/basis/images/images.factor index e366dd2700..11452aa7d2 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -7,7 +7,7 @@ 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 new ; inline diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 674188992a..8e981a8163 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -286,6 +286,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 +311,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 +325,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 ; From d7e10c3072c2795614656364b62abfb219b8ef8d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:47:07 -0600 Subject: [PATCH 3/6] remove XXX from bitmaps --- basis/images/bitmap/bitmap.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 6713a729b5..9005776e40 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types arrays byte-arrays columns combinators fry grouping io io.binary io.encodings.binary io.files kernel macros math math.bitwise math.functions namespaces sequences -strings images endian summary annotations ; +strings images endian summary ; IN: images.bitmap TUPLE: bitmap-image < image ; @@ -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 ; From 03839aa3ccceb69355885eb59583f5afa4a16f64 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:47:48 -0600 Subject: [PATCH 4/6] str -> bytes, utility word in endian --- basis/endian/endian.factor | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/basis/endian/endian.factor b/basis/endian/endian.factor index a832d6c0a2..a453a71704 100755 --- a/basis/endian/endian.factor +++ b/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 *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 -- str ) +HOOK: >native-endian native-endianness ( obj n -- bytes ) 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 + ] [ + [ [ ] keep ] dip + little-endian = [ + '[ be> _ >le ] map + ] [ + '[ le> _ >be ] map + ] if concat + ] if ; inline From 8223f4277514255eaf0a5f5d71ed8bfbce9904ed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:52:17 -0600 Subject: [PATCH 5/6] decode uname strings as utf8 --- extra/system-info/linux/linux.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/system-info/linux/linux.factor b/extra/system-info/linux/linux.factor index 00a49fb2a2..b77e1fe649 100644 --- a/extra/system-info/linux/linux.factor +++ b/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" [ (uname) io-error ] keep - "\0" split harvest [ >string ] map + "\0" split harvest [ utf8 decode ] map 6 "" pad-tail ; : sysname ( -- string ) uname first ; From 3cf4c6fee20e5a36088a16a155e2f648e6d092ff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Feb 2009 15:56:22 -0600 Subject: [PATCH 6/6] support 48bpp tiffs --- basis/images/images.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/images/images.factor b/basis/images/images.factor index 11452aa7d2..32fbc54978 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,7 +1,8 @@ ! 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 @@ -28,6 +29,13 @@ GENERIC: load-image* ( path tuple -- image ) >byte-array add-dummy-alpha ] change-bitmap ] } + { R16G16B16 [ + [ + dup length 2 / + [ -8 shift ] map + >byte-array add-dummy-alpha + ] change-bitmap + ] } { BGRA [ [ 4 dup [ [ 0 3 ] dip reverse-here ] each