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

fix images tests

db4
Doug Coleman 2009-02-09 21:15:57 -06:00
parent 4ff9557351
commit 72b343ce03
3 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/images/bitmap/bitmap-tests.factor
View File

@ -2,23 +2,20 @@ 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" ;
"resource:extra/images/test-images/thiswayup24.bmp" ;
: test-bitmap16 ( -- path )
"resource:extra/images/bitmap/test-images/rgb16bit.bmp" ;
"resource:extra/images/test-images/rgb16bit.bmp" ;
: test-bitmap8 ( -- path )
"resource:extra/images/bitmap/test-images/rgb8bit.bmp" ;
"resource:extra/images/test-images/rgb8bit.bmp" ;
: test-bitmap4 ( -- path )
"resource:extra/images/bitmap/test-images/rgb4bit.bmp" ;
"resource:extra/images/test-images/rgb4bit.bmp" ;
: test-bitmap1 ( -- path )
"resource:extra/images/bitmap/test-images/1bit.bmp" ;
"resource:extra/images/test-images/1bit.bmp" ;
[ t ]
[

11
extra/images/bitmap/bitmap.factor
View File

@ -97,7 +97,7 @@ M: bitmap-magic summary
dup rgb-quads-length read >>rgb-quads
dup color-index-length read >>color-index ;
: load-bitmap ( path -- bitmap )
: load-bitmap-data ( path -- bitmap )
binary [
bitmap new
parse-file-header parse-bitmap-header parse-bitmap
@ -106,14 +106,19 @@ M: bitmap-magic summary
: alpha-channel-zero? ( bitmap -- ? )
buffer>> 4 <sliced-groups> 3 <column> [ 0 = ] all? ;
: process-bitmap-data ( bitmap -- bitmap )
dup raw-bitmap>buffer >>buffer
dup alpha-channel-zero? >>alpha-channel-zero? ;
: load-bitmap ( path -- bitmap )
load-bitmap-data process-bitmap-data ;
: 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 ;

5
extra/images/tiff/tiff-tests.factor
View File

@ -4,8 +4,7 @@ USING: tools.test images.tiff ;
IN: images.tiff.tests
: tiff-test-path ( -- path )
"resource:extra/images/tiff/rgb.tiff" ;
"resource:extra/images/test-images/rgb.tiff" ;
: tiff-test-path2 ( -- path )
"resource:extra/images/tiff/octagon.tiff" ;
"resource:extra/images/test-images/octagon.tiff" ;