; - zlib.lsp
;
; version 1.1, April 26th 2006, L.M.
;
; functions for compression/decompression with zlib from http://www.zlib.net/
;
; Fast in memory compression:
;
; example compressing a string in str:
;	(set 'str-z  (zlib:squeeze str))
;
; example un-compressing a string:
;	(set 'str (zlib:unsqueeze str-z))
;
; GZ compatible file compression and decompression:
;
; example uncompressing from a file into a memory buffer:
;   (set 'buff (zlib:gz-read-file "myfile.gz"))
;
; example compressing fro a memory buffer to a file
;   (zlib:gz-write-file "myfile.gz" buff) 
;

(context 'zlib)

; see http://www.zlib.net for libraries for different OS platforms

; for Mac OS X:w
,
(if 
	;; LINUX and FreeBSD (on NetBSD it is libcurses.so.5 or 6)
	(< (& 0xF (sys-info -1)) 3)	(set 'library "libz.so") 
	;; Mac OSX / Darwin
	(= (& 0xF (sys-info -1)) 3) (set 'library "libz.dylib")
	;; Solaris
	(= (& 0xF (sys-info -1)) 4)	(set 'library "libz.so") 
	;; Win32
	(> (& 0xF (sys-info -1)) 4) (set 'library "libz1.dll")
	true (println "Cannot load library, OS not supported"))

(import library "compress")
(import library "uncompress")
(import library "gzopen")
(import library "gzread")
(import library "gzclose")
(import library "gzwrite")

; compresses a string buffer in src and returns a compressed buffer
;
(define (squeeze src)
	(letn (	(srclen (length src)) 
			(destlen (int (add (mul 1.01 srclen) 12))) 
			(dest (dup "\000" destlen))
			(destlenp (pack "ld" destlen))
			)
	(compress dest destlenp src srclen)
	(set 'destlen (first (unpack "ld" destlenp)))
	(slice dest 0 destlen)))


; un-compresses a string buffer in src and returns the original
;
(define (unsqueeze src)
	(letn (	(srclen (length src)) 
			(destlen (* srclen 3)) 
			(dest (dup "\000" destlen))
			(destlenp (pack "ld" destlen))
			)
		(while (= -5 (uncompress dest destlenp src srclen))
			(set 'destlen (* 2 destlen))	
			(set 'dest (dup "\000" destlen))
			(set 'destlenp (pack "ld" destlen)))
		(set 'destlen (first (unpack "ld" destlenp)))
		(slice dest 0 destlen)))

; GZ compatible un-compress from a file to memory
; 
(define (gz-read-file file-name)
	(let ( (fno (gzopen file-name "rb"))
	       (buff (dup "\000" 0x1000))
	       (result ""))
		(if (!= fno 0)
			(begin
				(while (> (set 'bytes (gzread fno buff 0x1000)) 0)
					(write-buffer result buff bytes))
				(gzclose fno)
				result))))

; GZ compatible compress a memory buffer to a file
;			
(define (gz-write-file file-name buff)
    (let ( (fno (gzopen file-name "wb"))
		   (result nil))
    	(if (!= fno 0)	
			(begin
				(set 'result (gzwrite fno buff (length buff)))
				(gzclose fno)
				result))))
	
(context MAIN) 

;; eof