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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
open Bimage
let pixel_type : [< gray | rgb | rgba] Color.t -> string =
fun c ->
match Color.t c with
| `Gray ->
"gray"
| `Rgb ->
"rgb"
| `Rgba ->
"rgba"
let interlace = function
| Image.Planar ->
"Plane"
| Image.Interleaved ->
"None"
let convert_command = ref "convert"
let identify_command = ref "identify"
let use_graphicsmagick () =
convert_command := "gm convert";
identify_command := "gm identify"
let read ?(create = fun _name -> Image.create)
?(layout = Image.Interleaved) t color ?format filename =
let format =
match format with
| Some f ->
f
| None ->
Filename.extension filename
|> fun s -> String.sub s 1 (String.length s - 1)
in
try
let read_image_data filename img =
let f = pixel_type img.Image.color in
let channels = Image.channels img in
let interlace = interlace layout in
let cmd =
Printf.sprintf "%s %s:'%s' -depth 8 -interlace %s %s:-"
!convert_command format filename interlace f
in
let input = Unix.open_process_in cmd in
let kind = Kind.of_float t in
for i = 0 to (Image.(img.width * img.height) * channels) - 1 do
let x = Kind.to_float u8 (input_byte input) in
let x = Kind.normalize u8 x in
let x = Kind.denormalize t x in
Bigarray.Array1.set img.Image.data i (kind x)
done;
close_in input
in
let cmd =
Printf.sprintf "%s -format \"%%w %%h\" '%s'" !identify_command filename
in
let identify = Unix.open_process_in cmd in
let s = input_line identify in
let () = close_in identify in
let shape = String.split_on_char ' ' (String.trim s) in
match List.map int_of_string shape with
| [x; y] ->
let img = create filename ~layout t color x y in
let () = read_image_data filename img in
Ok img
| _ ->
Error `Invalid_shape
with
| End_of_file ->
Error (`Msg "end of file")
| Failure msg ->
Error (`Msg msg)
let read_all ?create ?layout kind color ?format filenames =
try
Ok
(Array.map
(fun f -> read?create ?layout kind color ?format f |> Error.unwrap)
filenames)
with Error.Exc err -> Error err
let write ?quality ?format filename img =
let format =
match format with
| Some f ->
f
| None ->
Filename.extension filename
|> fun s -> String.sub s 1 (String.length s - 1)
in
let width, height, channels = Image.shape img in
let f = pixel_type img.Image.color in
let quality =
match quality with
| None ->
""
| Some q ->
Printf.sprintf "-quality %d" q
in
let cmd =
Printf.sprintf "%s -depth 8 -interlace %s -size %dx%d %s:- %s %s:'%s'"
!convert_command (interlace img.layout) width height f quality format
filename
in
let output = Unix.open_process_out cmd in
let kind = Image.kind img in
for i = 0 to (Image.(img.width * img.height) * channels) - 1 do
let x = Kind.to_float kind (Bigarray.Array1.get img.Image.data i) in
let x = Kind.normalize kind x in
let x = Kind.denormalize u8 x in
output_byte output (Kind.of_float u8 x)
done;
close_out output