basis/compression/zlib/zlib.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types alien.syntax byte-arrays combinators
   4 kernel math math.functions sequences system accessors
   5 libc ;
   6 QUALIFIED: compression.zlib.ffi
   7 IN: compression.zlib
   8
   9 TUPLE: compressed data length ;
  10
  11 : <compressed> ( data length -- compressed )
  12     compressed new
  13         swap >>length
  14         swap >>data ;
  15
  16 ERROR: zlib-failed n string ;
  17
  18 : zlib-error-message ( n -- * )
  19     dup compression.zlib.ffi:Z_ERRNO = [
  20         drop errno "native libc error"
  21     ] [
  22         dup {
  23             "no error" "libc_error"
  24             "stream error" "data error"
  25             "memory error" "buffer error" "zlib version error"
  26         } ?nth
  27     ] if zlib-failed ;
  28
  29 : zlib-error ( n -- )
  30     dup compression.zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
  31
  32 : compressed-size ( byte-array -- n )
  33     length 1001/1000 * ceiling 12 + ;
  34
  35 : compress ( byte-array -- compressed )
  36     [
  37         [ compressed-size <byte-array> dup length <ulong> ] keep [
  38             dup length compression.zlib.ffi:compress zlib-error
  39         ] 3keep drop *ulong head
  40     ] keep length <compressed> ;
  41
  42 : uncompress ( compressed -- byte-array )
  43     [
  44         length>> [ <byte-array> ] keep <ulong> 2dup
  45     ] [
  46         data>> dup length
  47         compression.zlib.ffi:uncompress zlib-error
  48     ] bi *ulong head ;