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         neg ! zlib error codes are negative
  24         {
  25             "no error" "libc_error"
  26             "stream error" "data error"
  27             "memory error" "buffer error" "zlib version error"
  28         } ?nth
  29     ] if zlib-failed ;
  30
  31 : zlib-error ( n -- )
  32     dup compression.zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
  33
  34 : compressed-size ( byte-array -- n )
  35     length 1001/1000 * ceiling 12 + ;
  36
  37 : compress ( byte-array -- compressed )
  38     [
  39         [ compressed-size <byte-array> dup length ulong <ref> ] keep [
  40             dup length compression.zlib.ffi:compress zlib-error
  41         ] 3keep drop ulong deref head
  42     ] keep length <compressed> ;
  43
  44 : uncompress ( compressed -- byte-array )
  45     [
  46         length>> [ <byte-array> ] keep ulong <ref> 2dup
  47     ] [
  48         data>> dup length
  49         compression.zlib.ffi:uncompress zlib-error
  50     ] bi ulong deref head ;