1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: UFFI Example file for zlib compression
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
12 ;;;; $Id: compress.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $
14 ;;;; This file is part of UFFI.
16 ;;;; UFFI is free software; you can redistribute it and/or modify
17 ;;;; it under the terms of the GNU General Public License (version 2) as
18 ;;;; published by the Free Software Foundation.
20 ;;;; UFFI is distributed in the hope that it will be useful,
21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;;;; GNU General Public License for more details.
25 ;;;; You should have received a copy of the GNU General Public License
26 ;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
27 ;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 ;;;; *************************************************************************
32 (unless (uffi:load-foreign-library "/usr/lib/libz.so" "zlib" '("c"))
33 (warn "Unable to load zlib"))
35 (uffi:def-function ("compress" c-compress)
36 ((dest (* :unsigned-char))
43 (defun compress (source)
44 "Returns two values: array of bytes containing the compressed data
45 and the numbe of compressed bytes"
46 (let* ((sourcelen (length source))
47 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
48 (dest (uffi:allocate-foreign-string destsize))
49 (destlen (uffi:allocate-foreign-object :long)))
50 (setf (uffi:deref-pointer destlen :long) destsize)
51 (uffi:with-c-string (source-native source)
52 (let ((result (c-compress dest destlen source-native sourcelen))
53 (newdestlen (uffi:deref-pointer destlen :long)))
56 (values (uffi:convert-from-foreign-string
59 :null-terminated-p nil)
61 (error "zlib error, code ~D" result))
63 (uffi:free-foreign-object destlen)
64 (uffi:free-foreign-object dest)))))))
69 (flet ((print-results (str)
70 (multiple-value-bind (compressed len) (compress str)
71 (format t "~&(compress ~S) => ~S,~D" str compressed len))))
73 (print-results "test")
74 (print-results "test2")))