package bimage-unix

  1. Overview
  2. Docs

Source file magick.ml

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
    (* Read image size *)
    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