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

make pngs read scanlines in terms of bits instead of bytes

db4
Doug Coleman 2009-10-08 16:58:24 -05:00
parent 37d0f29e4b
commit 7403bcef0c
2 changed files with 36 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compression/inflate/inflate.factor
View File

@ -3,7 +3,7 @@
USING: accessors arrays assocs byte-vectors combinators
combinators.smart compression.huffman fry hashtables io.binary
kernel literals locals math math.bitwise math.order math.ranges
sequences sorting memoize combinators.short-circuit ;
sequences sorting memoize combinators.short-circuit byte-arrays ;
QUALIFIED-WITH: bitstreams bs
IN: compression.inflate
@ -88,14 +88,14 @@ CONSTANT: dist-table
: nth* ( n seq -- elt )
[ length 1 - swap - ] [ nth ] bi ; inline
:: inflate-lz77 ( seq -- bytes )
:: inflate-lz77 ( seq -- byte-array )
1000 <byte-vector> :> bytes
seq [
dup array?
[ first2 '[ _ 1 - bytes nth* bytes push ] times ]
[ bytes push ] if
] each
bytes ;
bytes >byte-array ;
:: inflate-huffman ( bitstream tables -- bytes )
bitstream tables [ <huffman-decoder> ] with map :> tables

47
basis/images/png/png.factor
View File

@ -4,6 +4,7 @@ USING: accessors arrays checksums checksums.crc32 combinators
compression.inflate fry grouping images images.loader io
io.binary io.encodings.ascii io.encodings.string kernel locals
math math.bitwise math.ranges sequences sorting ;
QUALIFIED-WITH: bitstreams bs
IN: images.png
SINGLETON: png-image
@ -85,18 +86,17 @@ ERROR: unimplemented-color-type image ;
: inflate-data ( loading-png -- bytes )
find-compressed-bytes zlib-inflate ;
: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
: png-bytes-per-pixel ( loading-png -- n )
dup color-type>> {
{ truecolor [ scale-bit-depth 3 * ] }
{ truecolor-alpha [ scale-bit-depth 4 * ] }
: png-components-per-pixel ( loading-png -- n )
color-type>> {
{ truecolor [ 3 ] }
{ truecolor-alpha [ 4 ] }
[ unknown-color-type ]
} case ; inline
: png-group-width ( loading-png -- n )
! 1 + is for the filter type, 1 byte preceding each line
[ png-bytes-per-pixel ] [ width>> ] bi * 1 + ;
[ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
[ width>> ] bi * 1 + ;
:: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
@ -117,7 +117,7 @@ ERROR: unimplemented-color-type image ;
} case
curr width tail ;
:: reverse-png-filter ( n lines -- byte-array )
:: reverse-png-filter ( lines n -- byte-array )
lines dup first length 0 <array> prefix
[ n 1 - 0 <array> prepend ] map
2 clump [
@ -130,17 +130,36 @@ ERROR: unimplemented-color-type image ;
ERROR: unimplemented-interlace ;
: reverse-interlace ( byte-array loading-png -- byte-array )
: reverse-interlace ( byte-array loading-png -- bitstream )
{
{ interlace-none [ ] }
{ interlace-adam7 [ unimplemented-interlace ] }
[ unimplemented-interlace ]
} case ;
} case bs:<lsb0-bit-reader> ;
: png-image-bytes ( loading-png -- byte-array )
[ png-bytes-per-pixel ]
[ [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ]
[ png-group-width ] tri group reverse-png-filter ;
: uncompress-bytes ( loading-png -- bitstream )
[ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
:: png-image-bytes ( loading-png -- byte-array )
loading-png uncompress-bytes :> bs
loading-png width>> :> width
loading-png height>> :> height
loading-png png-components-per-pixel :> #components
loading-png bit-depth>> :> bit-depth
bit-depth :> depth!
#components width * :> count!
! Only read up to 8 bits at a time
bit-depth 16 = [
8 depth!
count 2 * count!
] when
height [
8 bs bs:read
count [ depth bs bs:read ] replicate swap prefix
] replicate
#components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
ERROR: unknown-component-type n ;