Rewrite in ocaml

Author: dmtrKovalenko

…m_override/files/ocamlbuild-0.14.2.patch .ocamlformatesy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/ocamlbuild-0.14.2.patch renamed to .ocamlformat esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/ocamlbuild-0.14.2.patch renamed to .ocamlformat

@@ -0,0 +1,21 @@
+let ofHexString s =
+  if String.length s = 4 || String.length s = 7 then
+    let short = String.length s = 4 in
+    let r' =
+      match short with true -> String.sub s 1 1 | false -> String.sub s 1 2
+    in
+    let g' =
+      match short with true -> String.sub s 2 1 | false -> String.sub s 3 2
+    in
+    let b' =
+      match short with true -> String.sub s 3 1 | false -> String.sub s 5 2
+    in
+    let r = int_of_string_opt ("0x" ^ r') in
+    let g = int_of_string_opt ("0x" ^ g') in
+    let b = int_of_string_opt ("0x" ^ b') in
+    match (r, g, b) with
+    | Some r, Some g, Some b when short ->
+        Some ((16 * r) + r, (16 * g) + g, (16 * b) + b)
+    | Some r, Some g, Some b -> Some (r, g, b)
+    | _ -> None
+  else None

bin/Color.ml

@@ -0,0 +1,45 @@
+open Odiff.ImageIO
+open Odiff.Diff
+
+let getIOModule filename =
+  Filename.extension filename |> function
+  | ".png" -> (module ODiffIO.Png.IO : ImageIO)
+  | ".jpg" | ".jpeg" -> (module ODiffIO.Jpg.IO : ImageIO)
+  | ".bmp" -> (module ODiffIO.Bmp.IO : ImageIO)
+  | ".tiff" -> (module ODiffIO.Tiff.IO : ImageIO)
+  | f -> failwith ("This format is not supported: " ^ f)
+
+type 'output diffResult = { exitCode : int; diff : 'output option }
+
+let main img1Path img2Path diffPath threshold outputDiffMask failOnLayoutChange
+    diffColorHex stdoutParsableString antialiasing ignoreRegions diffLines =
+  let module IO1 = (val getIOModule img1Path) in
+  let module IO2 = (val getIOModule img2Path) in
+  let module Diff = MakeDiff (IO1) (IO2) in
+  let img1 = IO1.loadImage img1Path in
+  let img2 = IO2.loadImage img2Path in
+  let { diff; exitCode } =
+    Diff.diff img1 img2 ~outputDiffMask ~threshold ~failOnLayoutChange
+      ~antialiasing ~ignoreRegions ~diffLines
+      ~diffPixel:
+        (Color.ofHexString diffColorHex |> function
+         | Some col -> col
+         | None -> (255, 0, 0))
+      ()
+    |> Print.printDiffResult stdoutParsableString
+    |> function
+    | Layout -> { diff = None; exitCode = 21 }
+    | Pixel (diffOutput, diffCount, stdoutParsableString, _) when diffCount = 0
+      ->
+        { exitCode = 0; diff = Some diffOutput }
+    | Pixel (diffOutput, diffCount, diffPercentage, _) ->
+        IO1.saveImage diffOutput diffPath;
+        { exitCode = 22; diff = Some diffOutput }
+  in
+  IO1.freeImage img1;
+  IO2.freeImage img2;
+  (match diff with
+  | ((Some output) [@explicit_arity]) when outputDiffMask ->
+      IO1.freeImage output
+  | _ -> ());
+  exit exitCode

bin/Color.re

@@ -0,0 +1,98 @@
+open Cmdliner
+
+let diffPath =
+  let open Arg in
+  value & pos 2 string ""
+  & info [] ~docv:"DIFF" ~doc:"Diff output path (.png only)"
+
+let base =
+  let open Arg in
+  value & pos 0 file "" & info [] ~docv:"BASE" ~doc:"Path to base image"
+
+let comp =
+  let open Arg in
+  value & pos 1 file ""
+  & info [] ~docv:"COMPARING" ~doc:"Path to comparing image"
+
+let threshold =
+  let open Arg in
+  value & opt float 0.1
+  & info [ "t"; "threshold" ] ~docv:"THRESHOLD"
+      ~doc:"Color difference threshold (from 0 to 1). Less more precise."
+
+let diffMask =
+  let open Arg in
+  value & flag
+  & info [ "dm"; "diff-mask" ] ~docv:"DIFF_IMAGE"
+      ~doc:"Output only changed pixel over transparent background."
+
+let failOnLayout =
+  let open Arg in
+  value & flag
+  & info [ "fail-on-layout" ] ~docv:"FAIL_ON_LAYOUT"
+      ~doc:
+        "Do not compare images and produce output if images layout is \
+         different."
+
+let parsableOutput =
+  let open Arg in
+  value & flag
+  & info [ "parsable-stdout" ] ~docv:"PARSABLE_OUTPUT"
+      ~doc:"Stdout parsable output"
+
+let diffColor =
+  let open Arg in
+  value & opt string ""
+  & info [ "diff-color" ]
+      ~doc:
+        "Color used to highlight different pixels in the output (in hex format \
+         e.g. #cd2cc9)."
+
+let antialiasing =
+  let open Arg in
+  value & flag
+  & info [ "aa"; "antialiasing" ]
+      ~doc:
+        "With this flag enabled, antialiased pixels are not counted to the \
+         diff of an image"
+
+let diffLines =
+  let open Arg in
+  value & flag
+  & info [ "output-diff-lines" ]
+      ~doc:
+        "With this flag enabled, output result in case of different images \
+         will output lines for all the different pixels"
+
+let ignoreRegions =
+  let open Arg in
+  value
+  & opt
+      (list ~sep:',' (t2 ~sep:'-' (t2 ~sep:':' int int) (t2 ~sep:':' int int)))
+      []
+  & info [ "i"; "ignore" ]
+      ~doc:
+        "An array of regions to ignore in the diff. One region looks like \
+         \"x1:y1-x2:y2\". Multiple regions are separated with a ','."
+
+let cmd =
+  let man =
+    [
+      `S Manpage.s_description;
+      `P "$(tname) is the fastest pixel-by-pixel image comparison tool.";
+      `P "Supported image types: .png, .jpg, .jpeg, .bitmap";
+    ]
+  in
+  ( (let open Term in
+     const Main.main $ base $ comp $ diffPath $ threshold $ diffMask
+     $ failOnLayout $ diffColor $ parsableOutput $ antialiasing $ ignoreRegions
+     $ diffLines),
+    Term.info "odiff" ~version:"2.6.1" ~doc:"Find difference between 2 images."
+      ~exits:
+        (Term.exit_info 0 ~doc:"on image match"
+        :: Term.exit_info 21 ~doc:"on layout diff when --fail-on-layout"
+        :: Term.exit_info 22 ~doc:"on image pixel difference"
+        :: Term.default_error_exits)
+      ~man )
+
+let () = Term.eval cmd |> Term.exit