(* This piece of code thresholds an image by some rule *)

open Images;;
open OImages;;

let isWhite p = (p.r = 255 && p.g = 255 && p.b = 255);;

let blob_extract (bmp : rgb24) =
  let width = bmp#width in
  let height = bmp#height in
  let rgb24 = new rgb24 width height in
  let current_num = ref 0 in
  let f x y =
    let testNorth x y =
      try
	let point = rgb24#get x (y - 1) in
	  if point.r != 0
	  then
	    Some (point.r + point.g + point.b)
	  else
	    None
      with
	  Out_of_image -> None in
    let testWest x y =
      try
	let point = rgb24#get (x - 1) y in
	  if point.r != 0
	  then
	    Some (point.r + point.g + point.b)
	  else
	    None
      with
	  Out_of_image -> None in
    let color v =
      let g = v - 255 in
      let b = v - (2 * 255) in
	{ r = if v > 255 then 255 else v;
	  g = if g < 0 then 0 else if g > 255 then 255 else g;
	  b = if b < 0 then 0 else if b > 255 then 255 else b } in
    let point = bmp#get x y in
      if (isWhite point) then
	(* Search for a friend *)
	match testNorth x y with
	  | Some v -> color v
	  | None -> match testWest x y with
	      | Some v -> color v
	      | None ->
		  current_num := !current_num + 1;
		  color !current_num
      else
	{r = 0; g = 0; b = 0} in
  let clear_image rgb =
    for x = 0 to width - 1 do
      for y = 0 to height - 1 do
	rgb24#unsafe_set x y {r = 0; g = 0; b = 0}
      done
    done in
    clear_image rgb24;
    for x = 0 to width - 1 do
      for y = 0 to height - 1 do
	rgb24#unsafe_set x y (f x y)
      done
    done;
    print_string ((string_of_int !current_num) ^ "\n");
    rgb24;;

let threshold (bmp : rgb24) =
  let width = bmp#width in
  let height = bmp#height in
  let rgb24 = new rgb24 width height in

  let f x y =
    let point = bmp#get x y in
      if (point.r = 255
          && point.g = 255
          && point.b = 255)
      then
	{ r = 0; g = 0; b = 0}
      else
	{ r = 255; g = 255; b = 255} in

    for x = 0 to width -1 do
      for y = 0 to height -1 do
	rgb24#unsafe_set x y (f x y)
      done
    done;

    rgb24;;

let files = ref [] in
  Arg.parse [] (fun s -> files := s :: !files) "threshold files";
  let files = List.rev !files in
    List.iter (fun file ->
      try
	let rgb =
	  let oimage = OImages.load file [] in
	    match OImages.tag oimage with
	      | Index8 img ->
		  let rgb = img#to_rgb24 in
		    img#destroy;
		    rgb
	      | Index16 img ->
		  let rgb = img#to_rgb24 in
		    img#destroy;
		    rgb
	      | Rgb24 img -> img
	      | _ -> raise (Invalid_argument "not supported") in
	let rgb' = blob_extract (threshold rgb) in

	let get_extension s =
	  let dotpos = String.rindex s '.' in
	    String.sub s (dotpos + 1) (String.length s - dotpos - 1) in

	let ext = get_extension file in
	let body = String.sub file 0
	  (String.length file - String.length ext - 1) in
	let outfile = body ^ ".thresh.bmp" in
	  rgb'#save outfile (Some Bmp) [];
      with _ -> ()) files;;