diff --git a/extra/graphics/bitmap/bitmap-tests.factor b/extra/graphics/bitmap/bitmap-tests.factor deleted file mode 100644 index f8a125e855..0000000000 --- a/extra/graphics/bitmap/bitmap-tests.factor +++ /dev/null @@ -1,30 +0,0 @@ -USING: graphics.bitmap graphics.viewer io.encodings.binary -io.files io.files.unique kernel tools.test ; -IN: graphics.bitmap.tests - -: test-bitmap32-alpha ( -- path ) - "resource:extra/graphics/bitmap/test-images/32alpha.bmp" ; - -: test-bitmap24 ( -- path ) - "resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ; - -: test-bitmap16 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb16bit.bmp" ; - -: test-bitmap8 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ; - -: test-bitmap4 ( -- path ) - "resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" ; - -: test-bitmap1 ( -- path ) - "resource:extra/graphics/bitmap/test-images/1bit.bmp" ; - -[ t ] -[ - test-bitmap24 - [ binary file-contents ] [ load-bitmap ] bi - - "test-bitmap24" unique-file - [ save-bitmap ] [ binary file-contents ] bi = -] unit-test diff --git a/extra/graphics/viewer/authors.txt b/extra/graphics/viewer/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/graphics/viewer/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/graphics/viewer/viewer.factor b/extra/graphics/viewer/viewer.factor deleted file mode 100644 index 517ab4e010..0000000000 --- a/extra/graphics/viewer/viewer.factor +++ /dev/null @@ -1,66 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators graphics.bitmap kernel math -math.functions namespaces opengl opengl.gl ui ui.gadgets -ui.gadgets.panes ui.render graphics.tiff sequences ; -IN: graphics.viewer - -TUPLE: graphics-gadget < gadget image ; - -GENERIC: draw-image ( image -- ) -GENERIC: width ( image -- w ) -GENERIC: height ( image -- h ) - -M: graphics-gadget pref-dim* - image>> [ width ] keep height abs 2array ; - -M: graphics-gadget draw-gadget* ( gadget -- ) - origin get [ image>> draw-image ] with-translation ; - -: ( bitmap -- gadget ) - \ graphics-gadget new-gadget - swap >>image ; - -: bits>gl-params ( n -- gl-bgr gl-format ) - { - { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] } - { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } - { 8 [ GL_BGR GL_UNSIGNED_BYTE ] } - { 4 [ GL_BGR GL_UNSIGNED_BYTE ] } - } case ; - -M: bitmap draw-image ( bitmap -- ) - dup height>> 0 < [ - 0 0 glRasterPos2i - 1.0 -1.0 glPixelZoom - ] [ - 0 over height>> abs glRasterPos2i - 1.0 1.0 glPixelZoom - ] if - [ width>> ] keep - [ - [ height>> abs ] keep - bit-count>> bits>gl-params - ] keep array>> glDrawPixels ; - -M: bitmap width ( bitmap -- ) width>> ; -M: bitmap height ( bitmap -- ) height>> ; - -: bitmap. ( path -- ) - load-bitmap gadget. ; - -: bitmap-window ( path -- gadget ) - load-bitmap [ "bitmap" open-window ] keep ; - -M: tiff width ( tiff -- ) ifds>> first image-width find-tag ; -M: tiff height ( tiff -- ) ifds>> first image-length find-tag ; - -M: tiff draw-image ( tiff -- ) - [ 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom ] dip - ifds>> first - { - [ image-width find-tag ] - [ image-length find-tag ] - [ bits-per-sample find-tag sum bits>gl-params ] - [ buffer>> ] - } cleave glDrawPixels ; diff --git a/extra/images/authors.txt b/extra/images/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/images/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/images/backend/authors.txt b/extra/images/backend/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/images/backend/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/images/backend/backend.factor b/extra/images/backend/backend.factor new file mode 100644 index 0000000000..ef2a9a4248 --- /dev/null +++ b/extra/images/backend/backend.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel ; +IN: images.backend + +TUPLE: image width height depth pitch buffer ; + +GENERIC: load-image* ( path tuple -- image ) + +: load-image ( path class -- image ) + new load-image* ; + +: new-image ( width height depth buffer class -- image ) + new + swap >>buffer + swap >>depth + swap >>height + swap >>width ; inline diff --git a/extra/graphics/authors.txt b/extra/images/bitmap/authors.txt old mode 100644 new mode 100755 similarity index 100% rename from extra/graphics/authors.txt rename to extra/images/bitmap/authors.txt diff --git a/extra/images/bitmap/bitmap-tests.factor b/extra/images/bitmap/bitmap-tests.factor new file mode 100644 index 0000000000..6865bfee3c --- /dev/null +++ b/extra/images/bitmap/bitmap-tests.factor @@ -0,0 +1,30 @@ +USING: images.bitmap images.viewer io.encodings.binary +io.files io.files.unique kernel tools.test ; +IN: images.bitmap.tests + +: test-bitmap32-alpha ( -- path ) + "resource:extra/images/bitmap/test-images/32alpha.bmp" ; + +: test-bitmap24 ( -- path ) + "resource:extra/images/bitmap/test-images/thiswayup24.bmp" ; + +: test-bitmap16 ( -- path ) + "resource:extra/images/bitmap/test-images/rgb16bit.bmp" ; + +: test-bitmap8 ( -- path ) + "resource:extra/images/bitmap/test-images/rgb8bit.bmp" ; + +: test-bitmap4 ( -- path ) + "resource:extra/images/bitmap/test-images/rgb4bit.bmp" ; + +: test-bitmap1 ( -- path ) + "resource:extra/images/bitmap/test-images/1bit.bmp" ; + +[ t ] +[ + test-bitmap24 + [ binary file-contents ] [ load-bitmap ] bi + + "test-bitmap24" unique-file + [ save-bitmap ] [ binary file-contents ] bi = +] unit-test diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor similarity index 83% rename from extra/graphics/bitmap/bitmap.factor rename to extra/images/bitmap/bitmap.factor index f8008dc7c1..220cdc153f 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/images/bitmap/bitmap.factor @@ -4,8 +4,10 @@ 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 ; -IN: graphics.bitmap +summary ui ui.gadgets.panes images.backend ; +IN: images.bitmap + +TUPLE: bitmap-image < image ; ! Currently can only handle 24/32bit bitmaps. ! Handles row-reversed bitmaps (their height is negative) @@ -14,7 +16,7 @@ TUPLE: bitmap magic size reserved offset header-length width height planes bit-count compression size-image x-pels y-pels color-used color-important rgb-quads color-index alpha-channel-zero? -array ; +buffer ; : array-copy ( bitmap array -- bitmap array' ) over size-image>> abs memory>byte-array ; @@ -25,7 +27,7 @@ MACRO: (nbits>bitmap) ( bits -- ) 2over * _ * >>size-image swap >>height swap >>width - swap array-copy [ >>array ] [ >>color-index ] bi + swap array-copy [ >>buffer ] [ >>color-index ] bi _ >>bit-count ] ; @@ -35,19 +37,19 @@ MACRO: (nbits>bitmap) ( bits -- ) : bgra>bitmap ( array height width -- bitmap ) 32 (nbits>bitmap) ; -: 8bit>array ( bitmap -- array ) +: 8bit>buffer ( bitmap -- array ) [ rgb-quads>> 4 [ 3 head-slice ] map ] [ color-index>> >array ] bi [ swap nth ] with map concat ; ERROR: bmp-not-supported n ; -: raw-bitmap>array ( bitmap -- array ) +: raw-bitmap>buffer ( bitmap -- array ) dup bit-count>> { { 32 [ color-index>> ] } { 24 [ color-index>> ] } { 16 [ bmp-not-supported ] } - { 8 [ 8bit>array ] } + { 8 [ 8bit>buffer ] } { 4 [ bmp-not-supported ] } { 2 [ bmp-not-supported ] } { 1 [ bmp-not-supported ] } @@ -95,19 +97,24 @@ M: bitmap-magic summary dup rgb-quads-length read >>rgb-quads dup color-index-length read >>color-index ; -: (load-bitmap) ( path -- bitmap ) +: load-bitmap ( path -- bitmap ) binary [ bitmap new parse-file-header parse-bitmap-header parse-bitmap ] with-file-reader ; : alpha-channel-zero? ( bitmap -- ? ) - array>> 4 3 [ 0 = ] all? ; + buffer>> 4 3 [ 0 = ] all? ; -: load-bitmap ( path -- bitmap ) - (load-bitmap) - dup raw-bitmap>array >>array - dup alpha-channel-zero? >>alpha-channel-zero? ; +: bitmap>image ( bitmap -- bitmap-image ) + { [ width>> ] [ height>> ] [ bit-count>> ] [ buffer>> ] } cleave + bitmap-image new-image ; + +M: bitmap-image load-image* ( path bitmap -- bitmap-image ) + drop load-bitmap + dup raw-bitmap>buffer >>buffer + dup alpha-channel-zero? >>alpha-channel-zero? + bitmap>image ; : write2 ( n -- ) 2 >le write ; : write4 ( n -- ) 4 >le write ; @@ -116,7 +123,7 @@ M: bitmap-magic summary binary [ B{ CHAR: B CHAR: M } write [ - array>> length 14 + 40 + write4 + buffer>> length 14 + 40 + write4 0 write4 54 write4 40 write4 diff --git a/extra/images/images.factor b/extra/images/images.factor new file mode 100644 index 0000000000..eb4fc63fee --- /dev/null +++ b/extra/images/images.factor @@ -0,0 +1,13 @@ +! 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 + +: ( path -- image ) + normalize-path dup "." split1-last nip >lower + { + { "bmp" [ bitmap-image load-image ] } + { "tiff" [ tiff-image load-image ] } + } case ; diff --git a/extra/graphics/tags.txt b/extra/images/tags.txt similarity index 100% rename from extra/graphics/tags.txt rename to extra/images/tags.txt diff --git a/extra/graphics/bitmap/test-images/1bit.bmp b/extra/images/test-images/1bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/1bit.bmp rename to extra/images/test-images/1bit.bmp diff --git a/extra/images/test-images/octagon.tiff b/extra/images/test-images/octagon.tiff new file mode 100644 index 0000000000..2b4ba3950d Binary files /dev/null and b/extra/images/test-images/octagon.tiff differ diff --git a/extra/graphics/tiff/rgb.tiff b/extra/images/test-images/rgb.tiff similarity index 100% rename from extra/graphics/tiff/rgb.tiff rename to extra/images/test-images/rgb.tiff diff --git a/extra/graphics/bitmap/test-images/rgb4bit.bmp b/extra/images/test-images/rgb4bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/rgb4bit.bmp rename to extra/images/test-images/rgb4bit.bmp diff --git a/extra/graphics/bitmap/test-images/rgb8bit.bmp b/extra/images/test-images/rgb8bit.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/rgb8bit.bmp rename to extra/images/test-images/rgb8bit.bmp diff --git a/extra/graphics/bitmap/test-images/thiswayup24.bmp b/extra/images/test-images/thiswayup24.bmp similarity index 100% rename from extra/graphics/bitmap/test-images/thiswayup24.bmp rename to extra/images/test-images/thiswayup24.bmp diff --git a/extra/graphics/bitmap/authors.txt b/extra/images/tiff/authors.txt similarity index 100% rename from extra/graphics/bitmap/authors.txt rename to extra/images/tiff/authors.txt diff --git a/extra/graphics/tiff/tiff-tests.factor b/extra/images/tiff/tiff-tests.factor similarity index 50% rename from extra/graphics/tiff/tiff-tests.factor rename to extra/images/tiff/tiff-tests.factor index f800b4d213..dcc4b05eab 100755 --- a/extra/graphics/tiff/tiff-tests.factor +++ b/extra/images/tiff/tiff-tests.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test graphics.tiff ; -IN: graphics.tiff.tests +USING: tools.test images.tiff ; +IN: images.tiff.tests : tiff-test-path ( -- path ) - "resource:extra/graphics/tiff/rgb.tiff" ; + "resource:extra/images/tiff/rgb.tiff" ; : tiff-test-path2 ( -- path ) - "resource:extra/graphics/tiff/octagon.tiff" ; + "resource:extra/images/tiff/octagon.tiff" ; diff --git a/extra/graphics/tiff/tiff.factor b/extra/images/tiff/tiff.factor similarity index 90% rename from extra/graphics/tiff/tiff.factor rename to extra/images/tiff/tiff.factor index 0481af8747..a220475081 100755 --- a/extra/graphics/tiff/tiff.factor +++ b/extra/images/tiff/tiff.factor @@ -3,13 +3,14 @@ USING: accessors combinators io io.encodings.binary io.files kernel pack endian tools.hexdump constructors sequences arrays sorting.slots math.order math.parser prettyprint classes -io.binary assocs math math.bitwise byte-arrays grouping ; -IN: graphics.tiff +io.binary assocs math math.bitwise byte-arrays grouping +images.backend ; +IN: images.tiff -TUPLE: tiff endianness the-answer ifd-offset ifds ; +TUPLE: tiff-image < image ; -CONSTRUCTOR: tiff ( -- tiff ) - V{ } clone >>ifds ; +TUPLE: parsed-tiff endianness the-answer ifd-offset ifds ; +CONSTRUCTOR: parsed-tiff ( -- tiff ) V{ } clone >>ifds ; TUPLE: ifd count ifd-entries next processed-tags strips buffer ; @@ -83,13 +84,13 @@ ERROR: bad-planar-configuration n ; [ bad-planar-configuration ] } case ; -ERROR: bad-sample-format n ; SINGLETONS: sample-format sample-format-unsigned-integer sample-format-signed-integer sample-format-ieee-float sample-format-undefined-data ; -: lookup-sample-format ( seq -- object ) +ERROR: bad-sample-format n ; +: lookup-sample-format ( sequence -- object ) [ { { 1 [ sample-format-unsigned-integer ] } @@ -100,12 +101,12 @@ sample-format-undefined-data ; } case ] map ; -ERROR: bad-extra-samples n ; SINGLETONS: extra-samples extra-samples-unspecified-alpha-data extra-samples-associated-alpha-data extra-samples-unassociated-alpha-data ; -: lookup-extra-samples ( seq -- object ) +ERROR: bad-extra-samples n ; +: lookup-extra-samples ( sequence -- object ) { { 0 [ extra-samples-unspecified-alpha-data ] } { 1 [ extra-samples-associated-alpha-data ] } @@ -259,13 +260,24 @@ ERROR: bad-small-ifd-type n ; : strips>buffer ( ifd -- ifd ) dup strips>> concat >>buffer ; -: (load-tiff) ( path -- tiff ) - binary [ - +: ifd>image ( ifd -- image ) + { + [ image-width find-tag ] + [ image-length find-tag ] + [ bits-per-sample find-tag sum ] + [ buffer>> ] + } cleave tiff-image new-image ; + +: parsed-tiff>images ( tiff -- sequence ) + ifds>> [ ifd>image ] map ; + +! tiff files can store several images -- we just take the first for now +M: tiff-image load-image* ( path tiff-image -- image ) + drop binary [ + read-header dup endianness>> [ read-ifds dup ifds>> [ process-ifd read-strips strips>buffer drop ] each ] with-endianness - ] with-file-reader ; - -: load-tiff ( path -- tiff ) (load-tiff) ; + ] with-file-reader + parsed-tiff>images first ; diff --git a/extra/graphics/tiff/authors.txt b/extra/images/viewer/authors.txt similarity index 100% rename from extra/graphics/tiff/authors.txt rename to extra/images/viewer/authors.txt diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor new file mode 100644 index 0000000000..4d5df4874a --- /dev/null +++ b/extra/images/viewer/viewer.factor @@ -0,0 +1,69 @@ +! Copyright (C) 2007 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators images.bitmap kernel math +math.functions namespaces opengl opengl.gl ui ui.gadgets +ui.gadgets.panes ui.render images.tiff sequences multiline +images.backend images io.pathnames strings ; +IN: images.viewer + +TUPLE: image-gadget < gadget { image image } ; + +GENERIC: draw-image ( image -- ) + +M: image-gadget pref-dim* + image>> + [ width>> ] [ height>> ] bi + [ abs ] bi@ 2array ; + +M: image-gadget draw-gadget* ( gadget -- ) + origin get [ image>> draw-image ] with-translation ; + +: ( image -- gadget ) + \ image-gadget new-gadget + swap >>image ; + +: bits>gl-params ( n -- gl-bgr gl-format ) + { + { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] } + { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } + { 8 [ GL_BGR GL_UNSIGNED_BYTE ] } + { 4 [ GL_BGR GL_UNSIGNED_BYTE ] } + } case ; + +M: bitmap-image draw-image ( bitmap -- ) + { + [ + height>> dup 0 < [ + drop + 0 0 glRasterPos2i + 1.0 -1.0 glPixelZoom + ] [ + 0 swap abs glRasterPos2i + 1.0 1.0 glPixelZoom + ] if + ] + [ width>> abs ] + [ height>> abs ] + [ depth>> bits>gl-params ] + [ buffer>> ] + } cleave glDrawPixels ; + +: image-window ( path -- gadget ) + [ dup ] [ open-window ] bi ; + +M: tiff-image draw-image ( tiff -- ) + 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom + { + [ height>> ] + [ width>> ] + [ depth>> bits>gl-params ] + [ buffer>> ] + } cleave glDrawPixels ; + +GENERIC: image. ( image -- ) + +M: string image. ( image -- ) gadget. ; + +M: pathname image. ( image -- ) gadget. ; + +M: image image. ( image -- ) gadget. ;