steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add a test for saving bitmaps, refactor load-bitmap a bit

db4
Doug Coleman 2009-02-06 16:40:14 -06:00
parent 9890ee27f4
commit 01f6c5a7f6
2 changed files with 38 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
extra/graphics/bitmap/bitmap-tests.factor
View File

@ -1,15 +1,27 @@
USING: graphics.bitmap graphics.viewer ; USING: graphics.bitmap graphics.viewer io.encodings.binary
io.files io.files.unique kernel tools.test ;
IN: graphics.bitmap.tests IN: graphics.bitmap.tests
: test-bitmap24 ( -- ) : test-bitmap32-alpha ( -- path )
"resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" bitmap. ; "resource:extra/graphics/bitmap/test-images/32alpha.bmp" ;
: test-bitmap8 ( -- ) : test-bitmap24 ( -- path )
"resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" bitmap. ; "resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ;
: test-bitmap4 ( -- ) : test-bitmap8 ( -- path )
"resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" bitmap. ; "resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ;
: test-bitmap1 ( -- ) : test-bitmap4 ( -- path )
"resource:extra/graphics/bitmap/test-images/1bit.bmp" bitmap. ; "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

27
extra/graphics/bitmap/bitmap.factor
View File

@ -1,11 +1,10 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays byte-arrays columns
USING: alien arrays byte-arrays combinators summary combinators fry grouping io io.binary io.encodings.binary
io io.binary io.files kernel libc math io.files kernel libc macros math math.bitwise math.functions
math.functions math.bitwise namespaces opengl opengl.gl namespaces opengl opengl.gl prettyprint sequences strings
prettyprint sequences strings ui ui.gadgets.panes fry summary ui ui.gadgets.panes ;
io.encodings.binary accessors grouping macros alien.c-types ;
IN: graphics.bitmap IN: graphics.bitmap
! Currently can only handle 24/32bit bitmaps. ! Currently can only handle 24/32bit bitmaps.
@ -14,6 +13,7 @@ IN: graphics.bitmap
TUPLE: bitmap magic size reserved offset header-length width TUPLE: bitmap magic size reserved offset header-length width
height planes bit-count compression size-image height planes bit-count compression size-image
x-pels y-pels color-used color-important rgb-quads color-index x-pels y-pels color-used color-important rgb-quads color-index
alpha-channel-zero?
array ; array ;
: array-copy ( bitmap array -- bitmap array' ) : array-copy ( bitmap array -- bitmap array' )
@ -97,12 +97,19 @@ M: bitmap-magic summary
dup rgb-quads-length read >>rgb-quads dup rgb-quads-length read >>rgb-quads
dup color-index-length read >>color-index ; dup color-index-length read >>color-index ;
: load-bitmap ( path -- bitmap ) : (load-bitmap) ( path -- bitmap )
binary [ binary [
bitmap new bitmap new
parse-file-header parse-bitmap-header parse-bitmap parse-file-header parse-bitmap-header parse-bitmap
] with-file-reader ] with-file-reader ;
dup raw-bitmap>array >>array ;
: alpha-channel-zero? ( bitmap -- ? )
array>> 4 <sliced-groups> 3 <column> [ 0 = ] all? ;
: load-bitmap ( path -- bitmap )
(load-bitmap)
dup raw-bitmap>array >>array
dup alpha-channel-zero? >>alpha-channel-zero? ;
: write2 ( n -- ) 2 >le write ; : write2 ( n -- ) 2 >le write ;
: write4 ( n -- ) 4 >le write ; : write4 ( n -- ) 4 >le write ;