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 USING: accessors arrays assocs byte-vectors combinators
combinators.smart compression.huffman fry hashtables io.binary combinators.smart compression.huffman fry hashtables io.binary
kernel literals locals math math.bitwise math.order math.ranges 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 QUALIFIED-WITH: bitstreams bs
IN: compression.inflate IN: compression.inflate
@ -88,14 +88,14 @@ CONSTANT: dist-table
: nth* ( n seq -- elt ) : nth* ( n seq -- elt )
[ length 1 - swap - ] [ nth ] bi ; inline [ length 1 - swap - ] [ nth ] bi ; inline
:: inflate-lz77 ( seq -- bytes ) :: inflate-lz77 ( seq -- byte-array )
1000 <byte-vector> :> bytes 1000 <byte-vector> :> bytes
seq [ seq [
dup array? dup array?
[ first2 '[ _ 1 - bytes nth* bytes push ] times ] [ first2 '[ _ 1 - bytes nth* bytes push ] times ]
[ bytes push ] if [ bytes push ] if
] each ] each
bytes ; bytes >byte-array ;
:: inflate-huffman ( bitstream tables -- bytes ) :: inflate-huffman ( bitstream tables -- bytes )
bitstream tables [ <huffman-decoder> ] with map :> tables 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 compression.inflate fry grouping images images.loader io
io.binary io.encodings.ascii io.encodings.string kernel locals io.binary io.encodings.ascii io.encodings.string kernel locals
math math.bitwise math.ranges sequences sorting ; math math.bitwise math.ranges sequences sorting ;
QUALIFIED-WITH: bitstreams bs
IN: images.png IN: images.png
SINGLETON: png-image SINGLETON: png-image
@ -85,18 +86,17 @@ ERROR: unimplemented-color-type image ;
: inflate-data ( loading-png -- bytes ) : inflate-data ( loading-png -- bytes )
find-compressed-bytes zlib-inflate ; find-compressed-bytes zlib-inflate ;
: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline : png-components-per-pixel ( loading-png -- n )
color-type>> {
: png-bytes-per-pixel ( loading-png -- n ) { truecolor [ 3 ] }
dup color-type>> { { truecolor-alpha [ 4 ] }
{ truecolor [ scale-bit-depth 3 * ] }
{ truecolor-alpha [ scale-bit-depth 4 * ] }
[ unknown-color-type ] [ unknown-color-type ]
} case ; inline } case ; inline
: png-group-width ( loading-png -- n ) : png-group-width ( loading-png -- n )
! 1 + is for the filter type, 1 byte preceding each line ! 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 ) :: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map a b + c - { a b c } [ [ - abs ] keep 2array ] with map
@ -117,7 +117,7 @@ ERROR: unimplemented-color-type image ;
} case } case
curr width tail ; curr width tail ;
:: reverse-png-filter ( n lines -- byte-array ) :: reverse-png-filter ( lines n -- byte-array )
lines dup first length 0 <array> prefix lines dup first length 0 <array> prefix
[ n 1 - 0 <array> prepend ] map [ n 1 - 0 <array> prepend ] map
2 clump [ 2 clump [
@ -130,17 +130,36 @@ ERROR: unimplemented-color-type image ;
ERROR: unimplemented-interlace ; ERROR: unimplemented-interlace ;
: reverse-interlace ( byte-array loading-png -- byte-array ) : reverse-interlace ( byte-array loading-png -- bitstream )
{ {
{ interlace-none [ ] } { interlace-none [ ] }
{ interlace-adam7 [ unimplemented-interlace ] } { interlace-adam7 [ unimplemented-interlace ] }
[ unimplemented-interlace ] [ unimplemented-interlace ]
} case ; } case bs:<lsb0-bit-reader> ;
: png-image-bytes ( loading-png -- byte-array ) : uncompress-bytes ( loading-png -- bitstream )
[ png-bytes-per-pixel ] [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
[ [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ]
[ png-group-width ] tri group reverse-png-filter ; :: 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 ; ERROR: unknown-component-type n ;