initial, non-stream-based zlib binding
							parent
							
								
									938d459b5c
								
							
						
					
					
						commit
						c8c427ec15
					
				| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Doug Coleman
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Doug Coleman
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1,30 @@
 | 
			
		|||
! Copyright (C) 2009 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.syntax combinators system ;
 | 
			
		||||
IN: zlib.ffi
 | 
			
		||||
 | 
			
		||||
<< "zlib" {
 | 
			
		||||
    { [ os winnt? ] [ "zlib1.dll" ] }
 | 
			
		||||
    { [ os macosx? ] [ "libz.dylib" ] }
 | 
			
		||||
    { [ os unix? ] [ "libz.so" ] }
 | 
			
		||||
} cond "cdecl" add-library >>
 | 
			
		||||
 | 
			
		||||
LIBRARY: zlib
 | 
			
		||||
 | 
			
		||||
CONSTANT: Z_OK 0
 | 
			
		||||
CONSTANT: Z_STREAM_END 1
 | 
			
		||||
CONSTANT: Z_NEED_DICT 2
 | 
			
		||||
CONSTANT: Z_ERRNO -1
 | 
			
		||||
CONSTANT: Z_STREAM_ERROR -2
 | 
			
		||||
CONSTANT: Z_DATA_ERROR -3
 | 
			
		||||
CONSTANT: Z_MEM_ERROR -4
 | 
			
		||||
CONSTANT: Z_BUF_ERROR -5
 | 
			
		||||
CONSTANT: Z_VERSION_ERROR -6
 | 
			
		||||
 | 
			
		||||
TYPEDEF: void Bytef
 | 
			
		||||
TYPEDEF: ulong uLongf
 | 
			
		||||
TYPEDEF: ulong uLong
 | 
			
		||||
 | 
			
		||||
FUNCTION: int compress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
 | 
			
		||||
FUNCTION: int compress2 ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen, int level ) ;
 | 
			
		||||
FUNCTION: int uncompress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1,9 @@
 | 
			
		|||
! Copyright (C) 2009 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel tools.test zlib classes ;
 | 
			
		||||
IN: zlib.tests
 | 
			
		||||
 | 
			
		||||
: compress-me ( -- byte-array ) B{ 1 2 3 4 5 } ;
 | 
			
		||||
 | 
			
		||||
[ t ] [ compress-me [ compress uncompress ] keep = ] unit-test
 | 
			
		||||
[ t ] [ compress-me compress compressed instance? ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1,50 @@
 | 
			
		|||
! Copyright (C) 2009 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.c-types alien.syntax byte-arrays combinators
 | 
			
		||||
kernel math math.functions sequences system accessors
 | 
			
		||||
libc ;
 | 
			
		||||
QUALIFIED: zlib.ffi
 | 
			
		||||
IN: zlib
 | 
			
		||||
 | 
			
		||||
TUPLE: compressed data length ;
 | 
			
		||||
 | 
			
		||||
: <compressed> ( data length -- compressed )
 | 
			
		||||
    compressed new
 | 
			
		||||
        swap >>length
 | 
			
		||||
        swap >>data ;
 | 
			
		||||
 | 
			
		||||
ERROR: zlib-failed n string ;
 | 
			
		||||
 | 
			
		||||
: zlib-error-message ( n -- * )
 | 
			
		||||
    dup zlib.ffi:Z_ERRNO = [
 | 
			
		||||
        drop errno "native libc error"
 | 
			
		||||
    ] [
 | 
			
		||||
        dup {
 | 
			
		||||
            "no error" "libc_error"
 | 
			
		||||
            "stream error" "data error"
 | 
			
		||||
            "memory error" "buffer error" "zlib version error"
 | 
			
		||||
        } ?nth
 | 
			
		||||
    ] if zlib-failed ;
 | 
			
		||||
 | 
			
		||||
: zlib-error ( n -- )
 | 
			
		||||
    dup zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
 | 
			
		||||
 | 
			
		||||
! Compressed size is up to .001% larger plus 12
 | 
			
		||||
 | 
			
		||||
: compressed-size ( byte-array -- n )
 | 
			
		||||
    length 1001/1000 * ceiling 12 + ;
 | 
			
		||||
 | 
			
		||||
: compress ( byte-array -- compressed )
 | 
			
		||||
    [
 | 
			
		||||
        [ compressed-size <byte-array> dup length <ulong> ] keep [
 | 
			
		||||
            dup length zlib.ffi:compress zlib-error
 | 
			
		||||
        ] 3keep drop *ulong head
 | 
			
		||||
    ] keep length <compressed> ;
 | 
			
		||||
 | 
			
		||||
: uncompress ( compressed -- byte-array )
 | 
			
		||||
    [
 | 
			
		||||
        length>> [ <byte-array> ] keep <ulong> 2dup
 | 
			
		||||
    ] [
 | 
			
		||||
        data>> dup length
 | 
			
		||||
        zlib.ffi:uncompress zlib-error
 | 
			
		||||
    ] bi *ulong head ;
 | 
			
		||||
		Loading…
	
		Reference in New Issue