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

extra/graphics/bitmap/bitmap-tests.factor

@@ -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

extra/graphics/viewer/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/graphics/viewer/viewer.factor

@@ -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 ;
-
-: <graphics-gadget> ( 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 <graphics-gadget> gadget. ;
-
-: bitmap-window ( path -- gadget )
-    load-bitmap <graphics-gadget> [ "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 ;

extra/images/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/images/backend/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

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

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

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 ;
+summary ui ui.gadgets.panes images.backend ;
-IN: graphics.bitmap
+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 <sliced-groups> [ 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 <sliced-groups> 3 <column> [ 0 = ] all? ;
+    buffer>> 4 <sliced-groups> 3 <column> [ 0 = ] all? ;
 
-: load-bitmap ( path -- bitmap )
+: bitmap>image ( bitmap -- bitmap-image )
-    (load-bitmap)
+    { [ width>> ] [ height>> ] [ bit-count>> ] [ buffer>> ] } cleave
-    dup raw-bitmap>array >>array
+    bitmap-image new-image ;
-    dup alpha-channel-zero? >>alpha-channel-zero? ;
+
+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

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
+
+: <image> ( path -- image )
+    normalize-path dup "." split1-last nip >lower
+    {
+        { "bmp" [ bitmap-image load-image ] }
+        { "tiff" [ tiff-image load-image ] }
+    } case ;

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 ;
+USING: tools.test images.tiff ;
-IN: graphics.tiff.tests
+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" ;
 

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 ;
+io.binary assocs math math.bitwise byte-arrays grouping
-IN: graphics.tiff
+images.backend ;
+IN: images.tiff
 
-TUPLE: tiff endianness the-answer ifd-offset ifds ;
+TUPLE: tiff-image < image ;
 
-CONSTRUCTOR: tiff ( -- tiff )
+TUPLE: parsed-tiff endianness the-answer ifd-offset ifds ;
-    V{ } clone >>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 )
+: ifd>image ( ifd -- image )
-    binary [
+    {
-        <tiff>
+        [ 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 [
+        <parsed-tiff>
         read-header dup endianness>> [
             read-ifds
             dup ifds>> [ process-ifd read-strips strips>buffer drop ] each
         ] with-endianness
-    ] with-file-reader ;
+    ] with-file-reader
-
+    parsed-tiff>images first ;
-: load-tiff ( path -- tiff ) (load-tiff) ;

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 )
+    \ 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 )
+    [ <image> <image-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 -- ) <image> <image-gadget> gadget. ;
+
+M: pathname image. ( image -- ) <image> <image-gadget> gadget. ;
+
+M: image image. ( image -- ) <image-gadget> gadget. ;