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
73
74
75
76
77
78
79
|
(* From CamlZip. See README.md *)
exception Error of string * string
let _ =
Callback.register_exception "Pdfflate.Error" (Error("",""))
type stream
type flush_command = Z_NO_FLUSH | Z_SYNC_FLUSH | Z_FULL_FLUSH | Z_FINISH
external deflate_init: int -> bool -> stream = "camlpdf_camlzip_deflateInit"
external deflate:
stream -> bytes -> int -> int -> bytes -> int -> int -> flush_command
-> bool * int * int
= "camlpdf_camlzip_deflate_bytecode" "camlpdf_camlzip_deflate"
external deflate_end: stream -> unit = "camlpdf_camlzip_deflateEnd"
external inflate_init: bool -> stream = "camlpdf_camlzip_inflateInit"
external inflate:
stream -> bytes -> int -> int -> bytes -> int -> int -> flush_command
-> bool * int * int
= "camlpdf_camlzip_inflate_bytecode" "camlpdf_camlzip_inflate"
external inflate_end: stream -> unit = "camlpdf_camlzip_inflateEnd"
let buffer_size = 1024
let compress ?(level = 6) ?(header = true) refill flush =
let inbuf = Bytes.create buffer_size
and outbuf = Bytes.create buffer_size in
let zs = deflate_init level header in
let rec compr inpos inavail =
if inavail = 0 then begin
let incount = refill inbuf in
if incount = 0 then compr_finish() else compr 0 incount
end else begin
let (_, used_in, used_out) =
deflate zs inbuf inpos inavail outbuf 0 buffer_size Z_NO_FLUSH in
flush outbuf used_out;
compr (inpos + used_in) (inavail - used_in)
end
and compr_finish () =
let (finished, _, used_out) =
deflate zs inbuf 0 0 outbuf 0 buffer_size Z_FINISH in
flush outbuf used_out;
if not finished then compr_finish()
in
compr 0 0;
deflate_end zs
let uncompress ?(header = true) refill flush =
let inbuf = Bytes.create buffer_size
and outbuf = Bytes.create buffer_size in
let zs = inflate_init header in
let rec uncompr inpos inavail =
if inavail = 0 then begin
let incount = refill inbuf in
if incount = 0 then uncompr_finish true else uncompr 0 incount
end else begin
let (finished, used_in, used_out) =
inflate zs inbuf inpos inavail outbuf 0 buffer_size Z_SYNC_FLUSH in
flush outbuf used_out;
if not finished then uncompr (inpos + used_in) (inavail - used_in)
end
and uncompr_finish first_finish =
(* Gotcha: if there is no header, inflate requires an extra "dummy" byte
after the compressed stream in order to complete decompression
and return finished = true. *)
let dummy_byte = if first_finish && not header then 1 else 0 in
let (finished, _, used_out) =
inflate zs inbuf 0 dummy_byte outbuf 0 buffer_size Z_SYNC_FLUSH in
flush outbuf used_out;
if not finished then uncompr_finish false
in
uncompr 0 0;
inflate_end zs
|
