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 ranges sequences system ;
9 ERROR: zlib-failed n string ;
11 : zlib-error-message ( n -- * )
12 dup compression.zlib.ffi:Z_ERRNO = [
13 drop errno "native libc error"
16 neg ! zlib error codes are negative
18 "no error" "libc_error"
19 "stream error" "data error"
20 "memory error" "buffer error" "zlib version error"
26 { compression.zlib.ffi:Z_OK [ drop ] }
27 { compression.zlib.ffi:Z_STREAM_END [ drop ] }
28 [ dup zlib-error-message zlib-failed ]
31 : compressed-size ( byte-array -- n )
32 length 1001/1000 * ceiling 12 + ;
34 : compress ( byte-array -- byte-array' )
37 [ <byte-vector> dup underlying>> ] keep ulong <ref>
39 dup length compression.zlib.ffi:compress zlib-error
40 ] keepd ulong deref >>length B{ } like ;
42 : (uncompress) ( length byte-array -- byte-array )
44 [ drop [ malloc &free ] [ ulong <ref> ] bi ]
45 [ nip dup length ] 2bi
46 [ compression.zlib.ffi:uncompress zlib-error ] 4keep
47 2drop ulong deref memory>byte-array
50 : uncompress ( byte-array -- byte-array' )
51 [ length 5 [0..b) [ 2^ * ] with map ] keep
52 '[ _ (uncompress) ] attempt-all ;
55 : zlib-inflate-init ( -- z_stream_s )
57 dup ZLIB_VERSION over byte-length inflateInit_ zlib-error ;
59 ! window can be 0, 15, 32, 47 (others?)
60 : zlib-inflate-init2 ( window -- z_stream_s )
61 [ z_stream new dup ] dip
62 ZLIB_VERSION pick byte-length inflateInit2_ zlib-error ;
64 : zlib-inflate-end ( z_stream -- )
65 inflateEnd zlib-error ;
67 : zlib-inflate-reset ( z_stream -- )
68 inflateReset zlib-error ;
70 : zlib-inflate ( z_stream flush -- )
73 : zlib-inflate-get-header ( z_stream -- gz_header )
74 gz_header new [ inflateGetHeader zlib-error ] keep ;