(* 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;;