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

Merge branch 'master' of http://factorcode.org/git/factor

db4
Joe Groff 2009-09-27 11:07:08 -05:00
parent 449695c8fe de2c097ec9
commit 8965d04c0d
2 changed files with 47 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,10 +1,9 @@
! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays
byte-vectors combinators fry grouping hashtables
compression.huffman images io.binary kernel locals
math math.bitwise math.order math.ranges multiline sequences
sorting ;
USING: accessors arrays assocs byte-vectors combinators
compression.huffman fry hashtables io.binary kernel locals math
math.bitwise math.order math.ranges sequences sorting ;
QUALIFIED-WITH: bitstreams bs
IN: compression.inflate
QUALIFIED-WITH: bitstreams bs
@ -177,42 +176,9 @@ CONSTANT: dist-table
case
]
[ produce ] keep call suffix concat ;
! [ produce ] keep dip swap suffix
:: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
sort-keys first second ;
:: png-unfilter-line ( prev curr filter -- curr' )
prev :> c
prev 3 tail-slice :> b
curr :> a
curr 3 tail-slice :> x
x length [0,b)
filter {
{ 0 [ drop ] }
{ 1 [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
{ 2 [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
{ 3 [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
{ 4 [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
} case
curr 3 tail ;
PRIVATE>
: reverse-png-filter' ( lines -- byte-array )
[ first ] [ 1 tail ] [ map ] bi-curry@ bi nip
concat [ 128 + ] B{ } map-as ;
: reverse-png-filter ( lines -- byte-array )
dup first length 0 <array> prefix
[ { 0 0 } prepend ] map
2 clump [
first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
png-unfilter-line
] map B{ } concat-as ;
: zlib-inflate ( bytes -- bytes )
bs:<lsb0-bit-reader>
[ check-zlib-header ] [ inflate-loop ] bi

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

@ -1,9 +1,9 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors images io io.binary io.encodings.ascii
io.encodings.binary io.encodings.string io.files io.files.info kernel
sequences io.streams.limited fry combinators arrays math checksums
checksums.crc32 compression.inflate grouping byte-arrays images.loader ;
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 ;
IN: images.png
SINGLETON: png-image
@ -78,27 +78,52 @@ ERROR: bad-checksum ;
ERROR: unknown-color-type n ;
ERROR: unimplemented-color-type image ;
ERROR: unknown-filter-method image ;
: inflate-data ( loading-png -- bytes )
find-compressed-bytes zlib-inflate ;
: png-group-width ( loading-png -- n )
dup color-type>> {
{ 2 [ [ bit-depth>> 8 / 3 * ] [ width>> ] bi * 1 + ] }
{ 6 [ [ bit-depth>> 8 / 4 * ] [ width>> ] bi * 1 + ] }
[ unknown-color-type ]
} case ;
: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
: filter-png ( groups loading-png -- byte-array )
filter-method>> {
{ filter-none [ reverse-png-filter ] }
[ unknown-filter-method ]
} case ;
: png-bytes-per-pixel ( loading-png -- n )
dup color-type>> {
{ 2 [ scale-bit-depth 3 * ] }
{ 6 [ scale-bit-depth 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 + ;
:: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
sort-keys first second ;
:: png-unfilter-line ( prev curr filter -- curr' )
prev :> c
prev 3 tail-slice :> b
curr :> a
curr 3 tail-slice :> x
x length [0,b)
filter {
{ filter-none [ drop ] }
{ filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
{ filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
{ filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
{ filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
} case
curr 3 tail ;
: reverse-png-filter ( lines -- byte-array )
dup first length 0 <array> prefix
[ { 0 0 } prepend ] map
2 clump [
first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
png-unfilter-line
] map B{ } concat-as ;
: png-image-bytes ( loading-png -- byte-array )
[ [ inflate-data ] [ png-group-width ] bi group ]
[ filter-png ] bi ;
[ inflate-data ] [ png-group-width ] bi group reverse-png-filter ;
: decode-greyscale ( loading-png -- loading-png )
unimplemented-color-type ;