(*
* Copyright (c) 2005, 2006, 2007 Abram Hindle
*
* This file is part of CaptchaBreaker
* CaptchaBreaker is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or
* (at your option) any later version.
* Foobar is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*)
open Images;;
open OImages;;
open Abez;;
open Shape;;
open Captchas;;
open Bmatrix;;
(* TRUE IS BLACK *)
(* FALSE IS WHITE *)
(* let debugging = true ;; *)
let debugging = false ;;
let black = true ;;
let white = false ;;
type connectivity = White | Black | Fill of int ;;
let bool_to_int = function
true -> 1
| false -> 0
;;
let matrix_to_bmp matrix =
let (w,h) = Bmatrix.dims matrix in
let white = { r = 255 ; g = 255; b = 255 } in
let black = { r = 0 ; g = 0 ; b = 0 } in
let out_bmp = new rgb24 w h in
Bmatrix.for_each_i matrix
(fun x y v ->
let color = if (v) then black else white in
out_bmp#unsafe_set x y color
);
out_bmp
;;
let safe_to_remove_middle arr =
let dim = 3 in
let n = dim * dim in
let middle = 4 in
let base = Array.map (function true -> Black | false -> White) arr in
let base' = Array.copy base in
base'.(middle) <- White;
let cp = Array.copy base in
let fill4 (x:int) (y:int) (filli:connectivity) (cp:connectivity array) =
let rec fill (x:int) (y:int) (count:int) =
if (x < 0 || x >= dim || y < 0 || y >= dim) then
count
else
let index = y * dim + x in
match cp.(index) with
White -> count
| Black ->
cp.(index) <- filli;
let count = count + 1 in
let count = fill (x + 1) y count in
let count = fill (x - 1) y count in
let count = fill x (y + 1) count in
let count = fill x (y - 1) count in
count
| Fill(_) -> count
in
( (fill x y 0) : int)
in
let fillit cp =
let fill_count = ref 0 in
for i = 0 to (dim - 1) do
for j = 0 to (dim - 1) do
if (not (i = 1 && j = 1)) then
let out = fill4 i j (Fill(!fill_count)) cp in
if (out > 0) then
fill_count := !fill_count + 1
done;
done;
!fill_count
in
let debug_lines cp =
let db = function
White -> "_"
| Black -> "#"
| Fill(x) -> string_of_int x
in
let lines = [
((db cp.(0)) ^ (db cp.(1)) ^ (db cp.(2))) ;
((db cp.(3+0)) ^ (db cp.(3+1)) ^ (db cp.(3+2))) ;
((db cp.(6+0)) ^ (db cp.(6+1)) ^ (db cp.(6+2))) ]
in
lines
in
let debug base base' =
let l1 = debug_lines base in
let l2 = debug_lines base' in
(List.iter prerr_endline
(List.map2 (fun x y ->
(x ^ " " ^ y)) l1 l2))
in
let fillit1 = fillit base in
let fillit2 = fillit base' in
if (debugging) then
begin
(debug base base';
prerr_endline ((string_of_int fillit1) ^ ":"^ (string_of_int fillit2)))
end;
fillit1 = fillit2
;;
let rec rosenfeld_iter (iters:int) (matrix:bool array array) (newmatrix:bool array array) =
let (w,h) = Bmatrix.dims matrix in
Bmatrix.blit_all newmatrix matrix;
let is_black x y =
if ((x < 0 || x >= w) || (y < 0 || y >= h)) then
false
else
matrix.(x).(y)
in
let new_is_black x y =
if ((x < 0 || x >= w) || (y < 0 || y >= h)) then
false
else
newmatrix.(x).(y)
in
let here = is_black in
let new_here = new_is_black in
let is_white x y =
if ((x < 0 || x >= w) || (y < 0 || y >= h)) then
true
else
not (matrix.(x).(y))
in
let north x y = is_black x (y+1) in
let south x y = is_black x (y-1) in
let east x y = is_black (x-1) y in
let west x y = is_black (x+1) y in
let northeast x y = is_black (x-1) (y+1) in
let northwest x y = is_black (x+1) (y+1) in
let southeast x y = is_black (x-1) (y-1) in
let southwest x y = is_black (x+1) (y-1) in
let new_north x y = new_is_black x (y+1) in
let new_south x y = new_is_black x (y-1) in
let new_east x y = new_is_black (x-1) y in
let new_west x y = new_is_black (x+1) y in
let new_northeast x y = new_is_black (x-1) (y+1) in
let new_northwest x y = new_is_black (x+1) (y+1) in
let new_southeast x y = new_is_black (x-1) (y-1) in
let new_southwest x y = new_is_black (x+1) (y-1) in
let north_border x y = not (north x y )in
let south_border x y = not (south x y )in
let east_border x y = not (east x y )in
let west_border x y = not (west x y )in
let only_one a b c d =
(a && not b && not c && not d) ||
(not a && b && not c && not d) ||
(not a && not b && c && not d) ||
(not a && not b && not c && d)
in
let diag_endpoint x y =
only_one (northwest x y) (southeast x y) (northeast x y) (southwest x y)
in
let four_endpoint x y =
only_one (north x y) (south x y) (east x y) (west x y)
in
let eight_endpoint x y =
let fe = four_endpoint x y in
let de = diag_endpoint x y in
(fe && not de) || (not (fe) && de)
in
let four_isolated x y =
not((north x y) || (south x y) || (east x y) || (west x y))
in
let diag_isolated x y =
not ((northwest x y) || (southeast x y) || (northeast x y) || (southwest x y))
in
let eight_isolated x y =
(four_isolated x y) && (diag_isolated x y)
in
let gen_arr x y =
Array.map (fun f -> f x y) [| southeast; south; southwest; east; here; west;
northeast; north; northwest; |]
in
(* assume border *)
let four_simple x y =
let input = gen_arr x y in
safe_to_remove_middle input
in
let old_four_simple x y =
let n = bool_to_int ( north x y ) in
let s = bool_to_int ( south x y ) in
let e = bool_to_int ( east x y ) in
let w = bool_to_int ( west x y ) in
((n + s + e + w) = 1)
(* four_isolated x y || four_endpoint x y || eight_isolated x y || eight_simple x y *)
in
(* black to white if they are north bordered that are four_simple that
are not 4 isolated or 4 endpoints *)
let counter = ref 0 in
let set_white x y =
counter := !counter + 1;
newmatrix.(x).(y) <- false
in
let borders = [| ("north",north_border) ; ("south",south_border) ; ("east",east_border) ; ("west",west_border) |] in
let warn i j s =
prerr_endline ("[ " ^ (string_of_int i) ^ ","^(string_of_int j) ^"] "^ s)
in
let inspect i j =
let c x = if x then "#" else "_" in
prerr_endline
((c (northwest i j)) ^ (c (north i j)) ^ (c (northeast i j)) ^ "\n" ^
(c (west i j)) ^ (c (here i j)) ^ (c (east i j)) ^ "\n" ^
(c (southwest i j)) ^ (c (south i j)) ^ (c (southeast i j)) ^ "\n")
in
let inspect_new i j =
let c x = if x then "#" else "_" in
prerr_endline
((c (new_northwest i j)) ^ (c (new_north i j)) ^ (c (new_northeast i j)) ^ "\n" ^
(c (new_west i j)) ^ (c (new_here i j)) ^ (c (new_east i j)) ^ "\n" ^
(c (new_southwest i j)) ^ (c (new_south i j)) ^ (c (new_southeast i j)) ^ "\n")
in
for dir_i = 0 to 3 do
let (bname,border_fun) = borders.(dir_i) in
if (debugging) then prerr_endline bname;
(* sync matrices *)
Bmatrix.blit_all newmatrix matrix;
for i = 0 to (w - 1) do
for j = 0 to (h - 1) do
if (is_black i j) then
(* let _ = warn i j "IS BLACK" in *)
if (border_fun i j) then
(* let _ = warn i j ("IS BORDER " ^ bname) in *)
if (not ((four_endpoint i j) || (four_isolated i j))) then
if (four_simple i j) then
begin
(* let _ = warn i j ("IS 4 SIMPLE " ^ bname) in *)
if (debugging) then
begin
let _ = warn i j ("Not an endpoint " ^ bname) in
let _ = inspect i j in
()
end;
set_white i j;
if (debugging) then
begin
let _ = warn i j ("Converted to " ^ bname) in
let _ = inspect_new i j in
()
end;
end
done;
done;
done;
if (debugging) then
begin
let _ =
let bmp = matrix_to_bmp newmatrix in
let _ = bmp#save ("segments/r"^(string_of_int iters)^".jpg") (Some Jpeg) [] in
bmp#destroy
in
prerr_endline (string_of_int (!counter));
end;
if (!counter > 0) then
rosenfeld_iter (iters + 1) matrix newmatrix
else
newmatrix
;;
let rosenfeld matrix =
let m1 = Bmatrix.copy matrix in
let m2 = Bmatrix.copy matrix in
rosenfeld_iter 0 m1 m2
;;
let black_and_white bmp =
let height = bmp#height in
let width = bmp#width in
let white_tol = 3 * 255 * 3 / 4 in
let matrix = Bmatrix.convert_to_matrix width height
(fun x y ->
let pixel = bmp#get x y in
let sum = pixel.r + pixel.g + pixel.b in
(sum >= white_tol)
) in
matrix
;;
let rosenfeld_bmp_to_bmp bmp =
let matrix = black_and_white bmp in
let outmatrix = rosenfeld matrix in
matrix_to_bmp matrix
;;
let bmp_to_matrix_not_white bmp =
let height = bmp#height in
let width = bmp#width in
let white = { r = 255 ; g = 255; b = 255 } in
let white_tol = 3 * 255 * 3 / 4 in
let matrix = Bmatrix.convert_to_matrix width height
(fun x y ->
let pixel = bmp#get x y in
not (pixel = white)
) in
matrix
;;
let bmp_to_matrix_near_black bmp =
let height = bmp#height in
let width = bmp#width in
let white = { r = 255 ; g = 255; b = 255 } in
let black = { r = 0 ; g = 0; b = 0 } in
let matrix = Bmatrix.convert_to_matrix width height
(fun x y ->
let pixel = bmp#get x y in
(pixel.r + pixel.b + pixel.g < 64*3)
) in
matrix
;;
let bmp_to_matrix_min_color_is_black bmp =
let height = bmp#height in
let width = bmp#width in
let white = { r = 255 ; g = 255; b = 255 } in
let minc = Captchas.min_color bmp in
let matrix = Bmatrix.convert_to_matrix width height
(fun x y ->
let pixel = bmp#get x y in
if (pixel = minc) then true else false
) in
matrix
;;