(* This piece of code thresholds an image by some rule *) (* Todo: - Code for coloring corners. Easy as hell. - Cut out and push to a matrix. - Consider changing color channels. RGB -> YIQ. May be there is something to exploit here. - Consider DCT'ing each block. Would be good for the matching algo. Larger items: - Edge matching is probably weak. Use sinusoids from the DCT. Will make much better probability calculations. - Consider how to rebuild in 2d. An 1d reassembly is there already based on a vertex-cover problem selection. So see if this can be adapted to a 2d world. If not, there are some papers on other methods. *) 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 testCoord x y = try let point = rgb24#get x 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 (* Note this is a maybe monad *) match List.fold_left (fun res (x, y) -> match res with | Some v -> Some v | None -> match testCoord x y with | Some v -> Some v | None -> None) None [(x + 1, y - 1); (x, y - 1); (x - 1, y - 1); (x - 1, y)] with | None -> current_num := !current_num +1; color !current_num | Some v -> color v 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;;