diff --git a/basis/images/backend/authors.txt b/basis/images/backend/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/images/backend/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/images/backend/backend.factor b/basis/images/backend/backend.factor deleted file mode 100644 index 756b98efee..0000000000 --- a/basis/images/backend/backend.factor +++ /dev/null @@ -1,51 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel grouping fry sequences combinators -math ; -IN: images.backend - -SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; - -TUPLE: image dim component-order bitmap ; - -TUPLE: normalized-image < image ; - -GENERIC: load-image* ( path tuple -- image ) - -GENERIC: >image ( object -- image ) - -: no-op ( -- ) ; - -: normalize-component-order ( image -- image ) - dup component-order>> - { - { RGBA [ no-op ] } - { BGRA [ - [ - [ 4 [ [ 0 3 ] dip reverse-here ] each ] - [ RGBA >>component-order ] bi - ] change-bitmap - ] } - { RGB [ - [ 3 [ 255 suffix ] map concat ] change-bitmap - ] } - { BGR [ - [ - 3 dup [ [ 0 3 ] dip reverse-here ] each - [ 255 suffix ] map concat - ] change-bitmap - ] } - } case RGBA >>component-order ; - -GENERIC: normalize-scan-line-order ( image -- image ) - -M: image normalize-scan-line-order ; -: normalize-image ( image -- image ) - normalize-component-order - normalize-scan-line-order ; - -: new-image ( dim component-order bitmap class -- image ) - new - swap >>bitmap - swap >>component-order - swap >>dim ; inline diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index a7deae3178..102c13c295 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -3,16 +3,16 @@ io.files io.files.unique kernel tools.test ; IN: images.bitmap.tests : test-bitmap24 ( -- path ) - "resource:extra/images/test-images/thiswayup24.bmp" ; + "resource:basis/images/test-images/thiswayup24.bmp" ; : test-bitmap8 ( -- path ) - "resource:extra/images/test-images/rgb8bit.bmp" ; + "resource:basis/images/test-images/rgb8bit.bmp" ; : test-bitmap4 ( -- path ) - "resource:extra/images/test-images/rgb4bit.bmp" ; + "resource:basis/images/test-images/rgb4bit.bmp" ; : test-bitmap1 ( -- path ) - "resource:extra/images/test-images/1bit.bmp" ; + "resource:basis/images/test-images/1bit.bmp" ; [ t ] [ diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 46f90e33f8..5530fa12b7 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types arrays byte-arrays columns combinators fry grouping io io.binary io.encodings.binary io.files kernel libc macros math math.bitwise math.functions namespaces opengl opengl.gl prettyprint sequences strings -summary ui ui.gadgets.panes images.backend ; +summary ui ui.gadgets.panes images ; IN: images.bitmap TUPLE: bitmap-image < image ; @@ -102,7 +102,7 @@ ERROR: unknown-component-order bitmap ; [ unknown-component-order ] } case ; -M: bitmap >image ( bitmap -- bitmap-image ) +: >image ( bitmap -- bitmap-image ) { [ [ width>> ] [ height>> ] bi 2array ] [ bitmap>component-order ] diff --git a/basis/images/images.factor b/basis/images/images.factor index 3df7b5d2d1..9f4d14e7bf 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,21 +1,45 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: constructors kernel splitting unicode.case combinators -accessors images.bitmap images.tiff images.backend io.backend -io.pathnames ; IN: images -ERROR: unknown-image-extension extension ; +SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; -: image-class ( path -- class ) - file-extension >lower { - { "bmp" [ bitmap-image ] } - { "tiff" [ tiff-image ] } - [ unknown-image-extension ] - } case ; +TUPLE: image dim component-order bitmap ; -: load-image ( path -- image ) - dup image-class new load-image* ; +GENERIC: load-image* ( path tuple -- image ) -: ( path -- image ) - load-image normalize-image ; +: normalize-component-order ( image -- image ) + dup component-order>> + { + { RGBA [ ] } + { BGRA [ + [ + [ 4 [ [ 0 3 ] dip reverse-here ] each ] + [ RGBA >>component-order ] bi + ] change-bitmap + ] } + { RGB [ + [ 3 [ 255 suffix ] map concat ] change-bitmap + ] } + { BGR [ + [ + 3 dup [ [ 0 3 ] dip reverse-here ] each + [ 255 suffix ] map concat + ] change-bitmap + ] } + } case + RGBA >>component-order ; + +GENERIC: normalize-scan-line-order ( image -- image ) + +M: image normalize-scan-line-order ; + +: normalize-image ( image -- image ) + normalize-component-order + normalize-scan-line-order ; + +: new-image ( dim component-order bitmap class -- image ) + new + swap >>bitmap + swap >>component-order + swap >>dim ; inline diff --git a/basis/images/loader/authors.txt b/basis/images/loader/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/images/loader/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor new file mode 100644 index 0000000000..7aeba9f24a --- /dev/null +++ b/basis/images/loader/loader.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: constructors kernel splitting unicode.case combinators +accessors images.bitmap images.tiff images io.backend +io.pathnames ; +IN: images.loader + +ERROR: unknown-image-extension extension ; + +: image-class ( path -- class ) + file-extension >lower { + { "bmp" [ bitmap-image ] } + { "tiff" [ tiff-image ] } + [ unknown-image-extension ] + } case ; + +: load-image ( path -- image ) + dup image-class new load-image* ; + +: ( path -- image ) + load-image normalize-image ; diff --git a/extra/images/test-images/1bit.bmp b/basis/images/test-images/1bit.bmp similarity index 100% rename from extra/images/test-images/1bit.bmp rename to basis/images/test-images/1bit.bmp diff --git a/extra/images/test-images/octagon.tiff b/basis/images/test-images/octagon.tiff similarity index 100% rename from extra/images/test-images/octagon.tiff rename to basis/images/test-images/octagon.tiff diff --git a/extra/images/test-images/rgb.tiff b/basis/images/test-images/rgb.tiff similarity index 100% rename from extra/images/test-images/rgb.tiff rename to basis/images/test-images/rgb.tiff diff --git a/extra/images/test-images/rgb4bit.bmp b/basis/images/test-images/rgb4bit.bmp similarity index 100% rename from extra/images/test-images/rgb4bit.bmp rename to basis/images/test-images/rgb4bit.bmp diff --git a/extra/images/test-images/rgb8bit.bmp b/basis/images/test-images/rgb8bit.bmp similarity index 100% rename from extra/images/test-images/rgb8bit.bmp rename to basis/images/test-images/rgb8bit.bmp diff --git a/extra/images/test-images/thiswayup24.bmp b/basis/images/test-images/thiswayup24.bmp similarity index 100% rename from extra/images/test-images/thiswayup24.bmp rename to basis/images/test-images/thiswayup24.bmp diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index dac071b4b4..c81d052a7f 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.backend ; +grouping images ; IN: images.tiff TUPLE: tiff-image < image ; @@ -268,14 +268,14 @@ ERROR: unknown-component-order ifd ; [ unknown-component-order ] } case ; -M: ifd >image ( ifd -- image ) +: ifd>image ( ifd -- image ) { [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] [ ifd-component-order ] [ bitmap>> ] } cleave tiff-image new-image ; -M: parsed-tiff >image ( image -- image ) +: tiff>image ( image -- image ) ifds>> [ >image ] map first ; : load-tiff ( path -- parsed-tiff ) @@ -289,4 +289,4 @@ M: parsed-tiff >image ( image -- image ) ! tiff files can store several images -- we just take the first for now M: tiff-image load-image* ( path tiff-image -- image ) - drop load-tiff >image ; + drop load-tiff tiff>image ; diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index 92277dfdef..0795900150 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors images images.backend io.pathnames kernel +USING: accessors images images.loader io.pathnames kernel namespaces opengl opengl.gl sequences strings ui ui.gadgets ui.gadgets.panes ui.render ; IN: images.viewer