diff --git a/basis/images/images.factor b/basis/images/images.factor index 46c0936644..e366dd2700 100644 --- a/basis/images/images.factor +++ b/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 + [ 255 suffix ] map concat ; + : normalize-component-order ( image -- image ) dup component-order>> { { RGBA [ ] } + { R32G32B32 [ + [ + dup length 4 / + [ bits>float 255.0 * >integer ] map + >byte-array add-dummy-alpha + ] change-bitmap + ] } { BGRA [ [ 4 dup [ [ 0 3 ] dip reverse-here ] each ] change-bitmap ] } - { RGB [ - [ 3 [ 255 suffix ] map concat ] change-bitmap - ] } + { RGB [ [ add-dummy-alpha ] change-bitmap ] } { BGR [ [ - 3 dup [ [ 0 3 ] dip reverse-here ] each - [ 255 suffix ] map concat + 3 + [ [ [ 0 3 ] dip 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 ; diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 9e3f901269..6f2ae47c61 100644 --- a/basis/images/loader/loader.factor +++ b/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 ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 0b749d0ade..db5141521d 100755 --- 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 ) @@ -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 { - { 32 [ RGBA ] } - { 24 [ RGB ] } + bits-per-sample find-tag { + { { 32 32 32 } [ R32G32B32 ] } + { { 16 16 16 } [ R16G16B16 ] } + { { 8 8 8 8 } [ RGBA ] } + { { 8 8 8 } [ RGB ] } [ unknown-component-order ] } case ; diff --git a/basis/tools/hexdump/hexdump.factor b/basis/tools/hexdump/hexdump.factor index b646760889..63b55729fb 100644 --- a/basis/tools/hexdump/hexdump.factor +++ b/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 hex-digits write ] [ >ascii write ] bi nl ; +: hexdump-bytes ( bytes -- ) + [ length write-header ] + [ 16 [ write-hex-line ] each-index ] bi ; + PRIVATE> GENERIC: hexdump. ( byte-array -- ) -M: byte-array hexdump. - [ length write-header ] - [ 16 [ write-hex-line ] each-index ] bi ; +M: byte-array hexdump. hexdump-bytes ; + +M: byte-vector hexdump. hexdump-bytes ; : hexdump ( byte-array -- str ) [ hexdump. ] with-string-writer ; diff --git a/basis/zlib/authors.txt b/basis/zlib/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/zlib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/zlib/ffi/authors.txt b/basis/zlib/ffi/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/zlib/ffi/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/zlib/ffi/ffi.factor b/basis/zlib/ffi/ffi.factor deleted file mode 100755 index bda2809f56..0000000000 --- a/basis/zlib/ffi/ffi.factor +++ /dev/null @@ -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 ) ; diff --git a/basis/zlib/zlib-tests.factor b/basis/zlib/zlib-tests.factor deleted file mode 100755 index 0ac77277dc..0000000000 --- a/basis/zlib/zlib-tests.factor +++ /dev/null @@ -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 diff --git a/basis/zlib/zlib.factor b/basis/zlib/zlib.factor deleted file mode 100755 index b40d9c2a98..0000000000 --- a/basis/zlib/zlib.factor +++ /dev/null @@ -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 ; - -: ( 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 dup length ] keep [ - dup length zlib.ffi:compress zlib-error - ] 3keep drop *ulong head - ] keep length ; - -: uncompress ( compressed -- byte-array ) - [ - length>> [ ] keep 2dup - ] [ - data>> dup length - zlib.ffi:uncompress zlib-error - ] bi *ulong head ; diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 561d0962ff..0469f3564a 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/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\""