Merge branch 'master' into new_ui

db4
Slava Pestov 2009-02-12 02:48:19 -06:00
commit 5d2c60dacd
15 changed files with 73 additions and 78 deletions

View File

@ -1 +0,0 @@
Doug Coleman

View File

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

View File

@ -3,16 +3,16 @@ io.files io.files.unique kernel tools.test ;
IN: images.bitmap.tests IN: images.bitmap.tests
: test-bitmap24 ( -- path ) : test-bitmap24 ( -- path )
"resource:extra/images/test-images/thiswayup24.bmp" ; "resource:basis/images/test-images/thiswayup24.bmp" ;
: test-bitmap8 ( -- path ) : test-bitmap8 ( -- path )
"resource:extra/images/test-images/rgb8bit.bmp" ; "resource:basis/images/test-images/rgb8bit.bmp" ;
: test-bitmap4 ( -- path ) : test-bitmap4 ( -- path )
"resource:extra/images/test-images/rgb4bit.bmp" ; "resource:basis/images/test-images/rgb4bit.bmp" ;
: test-bitmap1 ( -- path ) : test-bitmap1 ( -- path )
"resource:extra/images/test-images/1bit.bmp" ; "resource:basis/images/test-images/1bit.bmp" ;
[ t ] [ t ]
[ [

View File

@ -4,7 +4,7 @@ USING: accessors alien alien.c-types arrays byte-arrays columns
combinators fry grouping io io.binary io.encodings.binary combinators fry grouping io io.binary io.encodings.binary
io.files kernel libc macros math math.bitwise math.functions io.files kernel libc macros math math.bitwise math.functions
namespaces opengl opengl.gl prettyprint sequences strings namespaces opengl opengl.gl prettyprint sequences strings
summary ui ui.gadgets.panes images.backend ; summary ui ui.gadgets.panes images ;
IN: images.bitmap IN: images.bitmap
TUPLE: bitmap-image < image ; TUPLE: bitmap-image < image ;
@ -102,7 +102,7 @@ ERROR: unknown-component-order bitmap ;
[ unknown-component-order ] [ unknown-component-order ]
} case ; } case ;
M: bitmap >image ( bitmap -- bitmap-image ) : >image ( bitmap -- bitmap-image )
{ {
[ [ width>> ] [ height>> ] bi 2array ] [ [ width>> ] [ height>> ] bi 2array ]
[ bitmap>component-order ] [ bitmap>component-order ]

View File

@ -1,21 +1,46 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: constructors kernel splitting unicode.case combinators USING: kernel accessors grouping sequences combinators ;
accessors images.bitmap images.tiff images.backend io.backend
io.pathnames ;
IN: images IN: images
ERROR: unknown-image-extension extension ; SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
: image-class ( path -- class ) TUPLE: image dim component-order bitmap ;
file-extension >lower {
{ "bmp" [ bitmap-image ] }
{ "tiff" [ tiff-image ] }
[ unknown-image-extension ]
} case ;
: load-image ( path -- image ) GENERIC: load-image* ( path tuple -- image )
dup image-class new load-image* ;
: <image> ( path -- image ) : normalize-component-order ( image -- image )
load-image normalize-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

View File

@ -0,0 +1 @@
Doug Coleman

View File

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

View File

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

Before

Width:  |  Height:  |  Size: 5.2 KiB

After

Width:  |  Height:  |  Size: 5.2 KiB

View File

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 11 KiB

View File

Before

Width:  |  Height:  |  Size: 59 KiB

After

Width:  |  Height:  |  Size: 59 KiB

View File

@ -3,7 +3,7 @@
USING: accessors combinators io io.encodings.binary io.files kernel USING: accessors combinators io io.encodings.binary io.files kernel
pack endian constructors sequences arrays math.order math.parser pack endian constructors sequences arrays math.order math.parser
prettyprint classes io.binary assocs math math.bitwise byte-arrays prettyprint classes io.binary assocs math math.bitwise byte-arrays
grouping images.backend ; grouping images ;
IN: images.tiff IN: images.tiff
TUPLE: tiff-image < image ; TUPLE: tiff-image < image ;
@ -268,15 +268,15 @@ ERROR: unknown-component-order ifd ;
[ unknown-component-order ] [ unknown-component-order ]
} case ; } case ;
M: ifd >image ( ifd -- image ) : ifd>image ( ifd -- image )
{ {
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
[ ifd-component-order ] [ ifd-component-order ]
[ bitmap>> ] [ bitmap>> ]
} cleave tiff-image new-image ; } cleave tiff-image new-image ;
M: parsed-tiff >image ( image -- image ) : tiff>image ( image -- image )
ifds>> [ >image ] map first ; ifds>> [ ifd>image ] map first ;
: load-tiff ( path -- parsed-tiff ) : load-tiff ( path -- parsed-tiff )
binary [ binary [
@ -289,4 +289,4 @@ M: parsed-tiff >image ( image -- image )
! tiff files can store several images -- we just take the first for now ! tiff files can store several images -- we just take the first for now
M: tiff-image load-image* ( path tiff-image -- image ) M: tiff-image load-image* ( path tiff-image -- image )
drop load-tiff >image ; drop load-tiff tiff>image ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 namespaces opengl opengl.gl sequences strings ui ui.gadgets
ui.gadgets.panes ui.render ; ui.gadgets.panes ui.render ;
IN: images.viewer IN: images.viewer