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
open Images
open Color
open Util
external read : string -> int * int * string array * int array
= "read_xpm_file"
let load file _opts =
let w, h, cmap, imap = read file in
let cmap, transparent = colormap_parse cmap in
if Array.length cmap <= 256 then begin
let buf = Bytes.create (w * h) in
for i = 0 to w * h - 1 do
buf << i & char_of_int imap.(i)
done;
Index8 (Index8.create_with w h []
{ map = cmap; max = 256 - 1; } transparent buf)
end else begin
let buf = Bytes.create (w * h * 2) in
for i = 0 to w * h - 1 do
let (&) = (@@) in
buf << i * 2 & char_of_int (imap.(i) / 256);
buf << i * 2 + 1 & char_of_int (imap.(i) mod 256)
done;
Index16 (Index16.create_with w h []
{ map = cmap; max = 256 * 256 - 1; }
transparent buf)
end
let filename =
let len = 9 in
let ic = open_in_bin filename in
try
let str = Bytes.create len in
really_input ic str 0 len;
close_in ic;
if Bytes.to_string str = "/* XPM */" then
{ header_width = -1;
header_height = -1;
header_infos = []; }
else raise Wrong_file_type
with
| _ -> raise Wrong_file_type
let () = add_methods Xpm {
check_header = check_header;
load = Some load;
save = None;
load_sequence = None;
save_sequence = None;
}