File: zlib-lw.lisp

package info (click to toggle)
cl-pdf 166-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 1,520 kB
  • ctags: 639
  • sloc: lisp: 6,902; makefile: 39
file content (72 lines) | stat: -rw-r--r-- 2,804 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
;;; cl-pdf copyright (c) 2002 Marc Battyani see license.txt for the details
;;; You can reach me at marc.battyani@fractalconcept.com or marc@battyani.net
;;; The homepage of cl-pdf is here: http://www.fractalconcept.com/asp/html/cl-pdf.html

;;; Lispworks bindings of the zlib compress function
;;; Should be replaced by calls to deflate to avoid those big buffers

(in-package pdf)

;;; Derived from file : "zlib.h"

(fli:register-module "ZLIB" :real-name (if (string= (software-type) "Linux") "zlib.so" "zlib.dll"))

(fli:define-foreign-function (zlib-compress "compress")
    ((dest :pointer)(dest-len (:pointer :long))
     (source :pointer)(source-len :long))
  :language :c
  :calling-convention :cdecl
  :result-type :long
  :module "ZLIB")

(defun compress-string (source)
  (fli:with-dynamic-foreign-objects ()
    (let* ((source-length (length source))
	   (source-fli (fli:convert-to-dynamic-foreign-string source
				      :external-format '(:latin-1 :eol-style :lf)
				      :null-terminated-p nil))
	   (dest-size (+ 12 (ceiling (* source-length 1.01))))
	   (dest-len (fli:allocate-dynamic-foreign-object :type :long
							  :initial-element dest-size))
	   (dest (fli:allocate-dynamic-foreign-object :type '(:unsigned :byte) :nelems dest-size)))
      (let ((res (zlib-compress dest dest-len source-fli source-length)))
	(if (zerop res)
	  (fli:convert-from-foreign-string dest
					   :external-format '(:latin-1 :eol-style :lf)
					   :length (fli:dereference dest-len)
					   :null-terminated-p nil)
	  (error "zlib compress error, code ~d" res))))))


#|
;;;for test only

(fli:define-foreign-function (zlib-uncompress "uncompress")
    ((dest :pointer)(dest-len (:pointer :long))
     (source :pointer)(source-len :long))
  :language :c
  :calling-convention :cdecl
  :result-type :long
  :module "ZLIB")

(defun uncompress-string (source)
  (fli:with-dynamic-foreign-objects ()
    (let* ((source-length (length source))
	   (source-fli (fli:convert-to-dynamic-foreign-string source :external-format '(:latin-1 :eol-style :lf)
							      :null-terminated-p nil))
	   (dest-size 200000) ;adjust as needed
	   (dest-len (fli:allocate-dynamic-foreign-object :type :long :nelems 1
							  :initial-element dest-size))
	   (dest (fli:allocate-dynamic-foreign-object :type '(:unsigned :byte) :nelems dest-size)))
      (fli:with-coerced-pointer (temp) source-fli
	(setf c (loop for i below source-length
		      collect (fli:dereference temp)
			do (fli:incf-pointer temp))))
      (let ((res (zlib-uncompress dest dest-len source-fli source-length)))
	(if (zerop res)
	  (fli:convert-from-foreign-string dest
					   :external-format '(:latin-1 :eol-style :lf)
					   :length (fli:dereference dest-len)
					   :null-terminated-p nil)
	  (error "zlib error, code ~d" res))))))
|#