basis/compression/zlib/zlib.factor

   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 byte-vectors
   4 combinators compression.zlib.ffi continuations destructors
   5 kernel libc math math.functions ranges sequences ;
   6 IN: compression.zlib
   7
   8 ERROR: zlib-failed n string ;
   9
  10 : zlib-error-message ( n -- * )
  11     dup compression.zlib.ffi:Z_ERRNO = [
  12         drop errno "native libc error"
  13     ] [
  14         dup
  15         neg ! zlib error codes are negative
  16         {
  17             "no error" "libc_error"
  18             "stream error" "data error"
  19             "memory error" "buffer error" "zlib version error"
  20         } ?nth
  21     ] if zlib-failed ;
  22
  23 : zlib-error ( n -- )
  24     dup {
  25         { compression.zlib.ffi:Z_OK [ drop ] }
  26         { compression.zlib.ffi:Z_STREAM_END [ drop ] }
  27         [ dup zlib-error-message zlib-failed ]
  28     } case ;
  29
  30 : compressed-size ( byte-array -- n )
  31     length 1001/1000 * ceiling 12 + ;
  32
  33 : compress ( byte-array -- byte-array' )
  34     [
  35         compressed-size
  36         [ <byte-vector> dup underlying>> ] keep ulong <ref>
  37     ] keep [
  38         dup length compression.zlib.ffi:compress zlib-error
  39     ] keepd ulong deref >>length B{ } like ;
  40
  41 : (uncompress) ( length byte-array -- byte-array )
  42     [
  43         [ drop [ malloc &free ] [ ulong <ref> ] bi ]
  44         [ nip dup length ] 2bi
  45         [ compression.zlib.ffi:uncompress zlib-error ] 4keep
  46         2drop ulong deref memory>byte-array
  47     ] with-destructors ;
  48
  49 : uncompress ( byte-array -- byte-array' )
  50     [ length 5 [0..b) [ 2^ * ] with map ] keep
  51     '[ _ (uncompress) ] attempt-all ;
  52
  53
  54 : zlib-inflate-init ( -- z_stream_s )
  55     z_stream new
  56     dup ZLIB_VERSION over byte-length inflateInit_ zlib-error ;
  57
  58 ! window can be 0, 15, 32, 47 (others?)
  59 : zlib-inflate-init2 ( window -- z_stream_s )
  60     [ z_stream new dup ] dip
  61     ZLIB_VERSION pick byte-length inflateInit2_ zlib-error ;
  62
  63 : zlib-inflate-end ( z_stream -- )
  64     inflateEnd zlib-error ;
  65
  66 : zlib-inflate-reset ( z_stream -- )
  67     inflateReset zlib-error ;
  68
  69 : zlib-inflate ( z_stream flush -- )
  70     inflate zlib-error ;
  71
  72 : zlib-inflate-get-header ( z_stream -- gz_header )
  73     gz_header new [ inflateGetHeader zlib-error ] keep ;