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

images.gif: unit tests now use a PAM reference image to verify decoding

db4
Keith Lazuka 2009-09-30 16:35:51 -04:00
parent 19107de7d8
commit 7484bb73ae
8 changed files with 47 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
basis/images/testing/gif/alpha.pam Normal file
View File

Binary file not shown.

BIN
basis/images/testing/gif/astronaut_animation.pam Normal file
View File

Binary file not shown.

BIN
basis/images/testing/gif/checkmark.pam Normal file
View File

Binary file not shown.

BIN
basis/images/testing/gif/circle.pam Normal file
View File

Binary file not shown.

BIN
basis/images/testing/gif/monochrome.pam Normal file
View File

Binary file not shown.

BIN
basis/images/testing/gif/noise.pam Normal file
View File

Binary file not shown.

21
basis/images/testing/testing.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Keith Lazuka.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings.binary io.files
io.streams.byte-array kernel quotations sequences tools.test ;
USING: fry images.loader io io.encodings.binary io.files
io.pathnames io.streams.byte-array kernel locals quotations
sequences tools.test ;
IN: images.testing
:: encode-test ( path image-class -- )
@ -11,3 +12,19 @@ IN: images.testing
path load-image image-class image>stream
] with-output-stream B{ } like
] unit-test ;
<PRIVATE
: pam-name ( path -- newpath )
[ parent-directory canonicalize-path ]
[ file-stem ".pam" append ] bi
append-path ;
: save-as-reference-image ( path -- )
[ load-image ] [ pam-name ] bi save-graphic-image ;
PRIVATE>
: decode-test ( path -- )
[ load-image 1quotation ] [ '[ _ pam-name load-image ] ] bi
unit-test ;

86
extra/images/gif/gif-tests.factor
View File

@ -1,50 +1,45 @@
! Copyright (C) 2009 Keith Lazuka.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors bitstreams compression.lzw images.gif io
io.encodings.binary io.files kernel math math.bitwise
math.parser namespaces prettyprint sequences tools.test images.viewer ;
USING: accessors bitstreams compression.lzw fry images.gif
images.loader images.viewer images.testing io io.encodings.binary io.files
io.pathnames kernel math math.bitwise math.parser namespaces
prettyprint quotations sequences tools.test ;
QUALIFIED-WITH: bitstreams bs
IN: images.gif.tests
: path>gif ( path -- loading-gif )
"vocab:images/testing/gif/circle.gif" decode-test
"vocab:images/testing/gif/checkmark.gif" decode-test
"vocab:images/testing/gif/monochrome.gif" decode-test
"vocab:images/testing/gif/alpha.gif" decode-test
! "vocab:images/testing/gif/noise.gif" decode-test
"vocab:images/testing/gif/astronaut_animation.gif" decode-test
: path>gif ( path -- gif )
binary [ input-stream get load-gif ] with-file-reader ;
: gif-example1 ( -- loading-gif )
"resource:extra/images/testing/circle.gif" path>gif ;
: circle.gif ( -- gif )
"vocab:images/testing/gif/circle.gif" path>gif ;
: gif-example2 ( -- loading-gif )
"resource:extra/images/testing/checkmark.gif" path>gif ;
: checkmark.gif ( -- gif )
"vocab:images/testing/gif/checkmark.gif" path>gif ;
: gif-example3 ( -- loading-gif )
"resource:extra/images/testing/monochrome.gif" path>gif ;
: monochrome.gif ( -- gif )
"vocab:images/testing/gif/monochrome.gif" path>gif ;
: gif-example4 ( -- loading-gif )
"resource:extra/images/testing/noise.gif" path>gif ;
: gif-example5 ( -- loading-gif )
"resource:extra/images/testing/alpha.gif" path>gif ;
: gif-example6 ( -- loading-gif )
"resource:extra/images/testing/astronaut_animation.gif" path>gif ;
: gif-all. ( -- )
{
gif-example1 gif-example2 gif-example3 gif-example4 gif-example5
gif-example6
}
[ execute( -- gif ) gif>image image. ] each ;
: alpha.gif ( -- gif )
"vocab:images/testing/gif/alpha.gif" path>gif ;
: declared-num-colors ( gif -- n ) flags>> 3 bits 1 + 2^ ;
: actual-num-colors ( gif -- n ) global-color-table>> length ;
[ 16 ] [ gif-example1 actual-num-colors ] unit-test
[ 16 ] [ gif-example1 declared-num-colors ] unit-test
[ 2 ] [ monochrome.gif actual-num-colors ] unit-test
[ 2 ] [ monochrome.gif declared-num-colors ] unit-test
[ 256 ] [ gif-example2 actual-num-colors ] unit-test
[ 256 ] [ gif-example2 declared-num-colors ] unit-test
[ 16 ] [ circle.gif actual-num-colors ] unit-test
[ 16 ] [ circle.gif declared-num-colors ] unit-test
[ 2 ] [ gif-example3 actual-num-colors ] unit-test
[ 2 ] [ gif-example3 declared-num-colors ] unit-test
[ 256 ] [ checkmark.gif actual-num-colors ] unit-test
[ 256 ] [ checkmark.gif declared-num-colors ] unit-test
: >index-stream ( gif -- seq )
[ compressed-bytes>> ]
@ -60,36 +55,11 @@ IN: images.gif.tests
1 0 1 1 0 1
1 0 0 0 0 1
}
] [ gif-example3 >index-stream ] unit-test
[
B{
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 255
0 0 0 255 0 0 0 255 255 255 255 255 255 255 255 255 0 0 0 255 0 0 0 255
0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255
0 0 0 255 255 255 255 255 0 0 0 255 0 0 0 255 255 255 255 255 0 0 0 255
0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 255
}
] [ gif-example3 gif>image bitmap>> ] unit-test
] [ monochrome.gif >index-stream ] unit-test
[
BV{
0 1
1 0
}
] [ gif-example5 >index-stream ] unit-test
[
B{
255 000 000 255 000 000 000 000
000 000 000 000 255 000 000 255
}
] [ gif-example5 gif>image bitmap>> ] unit-test
[ 100 ] [ gif-example1 >index-stream length ] unit-test
[ 870 ] [ gif-example2 >index-stream length ] unit-test
[ 16384 ] [ gif-example4 >index-stream length ] unit-test
! example6 is a GIF animation and the first frame contains 1768 pixels
[ 1768 ] [ gif-example6 >index-stream length ] unit-test
] [ alpha.gif >index-stream ] unit-test