Re-organize images and images.backend into images and images.loader
| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Doug Coleman
 | 
			
		||||
| 
						 | 
				
			
			@ -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 <sliced-groups> [ [ 0 3 ] dip <slice> reverse-here ] each ]
 | 
			
		||||
                [ RGBA >>component-order ] bi
 | 
			
		||||
            ] change-bitmap
 | 
			
		||||
        ] }
 | 
			
		||||
        { RGB [
 | 
			
		||||
            [ 3 <sliced-groups> [ 255 suffix ] map concat ] change-bitmap
 | 
			
		||||
        ] }
 | 
			
		||||
        { BGR [
 | 
			
		||||
            [
 | 
			
		||||
                3 <sliced-groups> dup [ [ 0 3 ] dip <slice> 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
 | 
			
		||||
| 
						 | 
				
			
			@ -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 ]
 | 
			
		||||
[
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ]
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 )
 | 
			
		||||
 | 
			
		||||
: <image> ( path -- image )
 | 
			
		||||
    load-image normalize-image ;
 | 
			
		||||
: normalize-component-order ( image -- image )
 | 
			
		||||
    dup component-order>>
 | 
			
		||||
    {
 | 
			
		||||
        { RGBA [ ] }
 | 
			
		||||
        { BGRA [
 | 
			
		||||
            [
 | 
			
		||||
                [ 4 <sliced-groups> [ [ 0 3 ] dip <slice> reverse-here ] each ]
 | 
			
		||||
                [ RGBA >>component-order ] bi
 | 
			
		||||
            ] change-bitmap
 | 
			
		||||
        ] }
 | 
			
		||||
        { RGB [
 | 
			
		||||
            [ 3 <sliced-groups> [ 255 suffix ] map concat ] change-bitmap
 | 
			
		||||
        ] }
 | 
			
		||||
        { BGR [
 | 
			
		||||
            [
 | 
			
		||||
                3 <sliced-groups> dup [ [ 0 3 ] dip <slice> 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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Doug Coleman
 | 
			
		||||
| 
						 | 
				
			
			@ -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* ;
 | 
			
		||||
 | 
			
		||||
: <image> ( path -- image )
 | 
			
		||||
    load-image normalize-image ;
 | 
			
		||||
| 
		 Before Width: | Height: | Size: 1.6 KiB After Width: | Height: | Size: 1.6 KiB  | 
| 
		 Before Width: | Height: | Size: 5.2 KiB After Width: | Height: | Size: 5.2 KiB  | 
| 
		 Before Width: | Height: | Size: 11 KiB After Width: | Height: | Size: 11 KiB  | 
| 
		 Before Width: | Height: | Size: 59 KiB After Width: | Height: | Size: 59 KiB  | 
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||