1 ! Copyright (C) 2009 Keith Lazuka.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors compression.lzw images.gif images.testing io
4 io.encodings.binary io.files kernel math math.bitwise
5 namespaces sequences tools.test ;
9 "vocab:images/testing/gif/circle.gif"
10 "vocab:images/testing/gif/checkmark.gif"
11 "vocab:images/testing/gif/monochrome.gif"
12 "vocab:images/testing/gif/alpha.gif"
13 "vocab:images/testing/gif/noise.gif"
14 "vocab:images/testing/gif/astronaut_animation.gif"
15 } [ gif-image decode-test ] each
17 : path>gif ( path -- gif )
18 binary [ input-stream get load-gif ] with-file-reader ;
20 : circle.gif ( -- gif )
21 "vocab:images/testing/gif/circle.gif" path>gif ;
23 : checkmark.gif ( -- gif )
24 "vocab:images/testing/gif/checkmark.gif" path>gif ;
26 : monochrome.gif ( -- gif )
27 "vocab:images/testing/gif/monochrome.gif" path>gif ;
29 : alpha.gif ( -- gif )
30 "vocab:images/testing/gif/alpha.gif" path>gif ;
32 : declared-num-colors ( gif -- n ) flags>> 3 bits 1 + 2^ ;
33 : actual-num-colors ( gif -- n ) global-color-table>> length ;
35 [ 2 ] [ monochrome.gif actual-num-colors ] unit-test
36 [ 2 ] [ monochrome.gif declared-num-colors ] unit-test
38 [ 16 ] [ circle.gif actual-num-colors ] unit-test
39 [ 16 ] [ circle.gif declared-num-colors ] unit-test
41 [ 256 ] [ checkmark.gif actual-num-colors ] unit-test
42 [ 256 ] [ checkmark.gif declared-num-colors ] unit-test
44 : >index-stream ( gif -- seq )
45 [ compressed-bytes>> ]
46 [ image-descriptor>> first-code-size>> ] bi
58 ] [ monochrome.gif >index-stream ] unit-test
65 ] [ alpha.gif >index-stream ] unit-test