1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data alien.syntax
4 byte-arrays byte-vectors classes.struct combinators
5 compression.zlib.ffi continuations destructors fry kernel libc
6 math math.functions math.ranges sequences system ;
7 QUALIFIED: compression.zlib.ffi
10 ERROR: zlib-failed n string ;
12 : zlib-error-message ( n -- * )
13 dup compression.zlib.ffi:Z_ERRNO = [
14 drop errno "native libc error"
17 neg ! zlib error codes are negative
19 "no error" "libc_error"
20 "stream error" "data error"
21 "memory error" "buffer error" "zlib version error"
23 ] if throw-zlib-failed ;
27 { compression.zlib.ffi:Z_OK [ drop ] }
28 { compression.zlib.ffi:Z_STREAM_END [ drop ] }
29 [ dup zlib-error-message throw-zlib-failed ]
32 : compressed-size ( byte-array -- n )
33 length 1001/1000 * ceiling 12 + ;
35 : compress ( byte-array -- byte-array' )
38 [ <byte-vector> dup underlying>> ] keep ulong <ref>
40 dup length compression.zlib.ffi:compress zlib-error
41 ] 2keep drop ulong deref >>length B{ } like ;
43 : (uncompress) ( length byte-array -- byte-array )
45 [ drop [ malloc &free ] [ ulong <ref> ] bi ]
46 [ nip dup length ] 2bi
47 [ compression.zlib.ffi:uncompress zlib-error ] 4keep
48 2drop ulong deref memory>byte-array
51 : uncompress ( byte-array -- byte-array' )
52 [ length 5 [0,b) [ 2^ * ] with map ] keep
53 '[ _ (uncompress) ] attempt-all ;
56 : zlib-inflate-init ( -- z_stream_s )
57 z_stream <struct> ZLIB_VERSION over byte-length [
58 inflateInit_ zlib-error
61 ! window can be 0, 15, 32, 47 (others?)
62 : zlib-inflate-init2 ( window -- z_stream_s )
63 [ z_stream <struct> ] dip ZLIB_VERSION pick byte-length [
64 inflateInit2_ zlib-error
67 : zlib-inflate-end ( z_stream -- )
68 inflateEnd zlib-error ;
70 : zlib-inflate-reset ( z_stream -- )
71 inflateReset zlib-error ;
73 : zlib-inflate ( z_stream flush -- )
76 : zlib-inflate-get-header ( z_stream -- gz_header )
78 inflateGetHeader zlib-error