(* P6 wid ht maxcolor data *) type ppm = { width : int; height : int; data : string; } let rec find_next ic = let c = input_char ic in if c = '#' then (ignore(input_line ic); find_next ic) else if c = ' ' || c = '\n' || c = '\t' || c = '\r' then find_next ic else c let read_int ic = let c = find_next ic in let rec iter n c = if c < '0' || c > '9' then raise Exit; let n = n * 10 + (Char.code c - Char.code '0') in let c = input_char ic in if c = ' ' || c = '\n' || c = '\t' || c = '\r' then n else iter n c in iter 0 c let load_ppm filename = try let ic = open_in filename in let c1 = input_char ic in let c2 = input_char ic in if c1 <> 'P' || c2 <> '6' then raise Exit; let w = read_int ic in let h = read_int ic in let colors = read_int ic in let len = w * h * 3 in let data = String.create len in really_input ic data 0 len; close_in ic; { width= w; height = h; data = data } with _ -> failwith (Printf.sprintf "Error while reading %s" filename) let xor_color i1 i2 pos = let c1 = i1.data.[pos] in let c2 = i2.data.[pos] in (* Char.chr ((Char.code c1) lxor (Char.code c2)) *) abs ((Char.code c1) - (Char.code c2)) let compare_ppm file i1 i2 prop = if i1.width <> i2.width || i1.height <> i2.height then failwith "The two images have different sizes"; let diffs = ref 0 in let filename = Filename.basename (Filename.chop_extension file) in let ext = if prop then "-prop" else "-diff" in let oc = open_out (filename ^ ext ^ ".ppm") in let oc_r = open_out (filename ^ ext ^ "-r.ppm") in let oc_g = open_out (filename ^ ext ^ "-g.ppm") in let oc_b = open_out (filename ^ ext ^ "-b.ppm") in output_string oc (Printf.sprintf "P6 %d %d 255\n" i1.width i1.height); output_string oc_r (Printf.sprintf "P6 %d %d 255\n" i1.width i1.height); output_string oc_g (Printf.sprintf "P6 %d %d 255\n" i1.width i1.height); output_string oc_b (Printf.sprintf "P6 %d %d 255\n" i1.width i1.height); let pos = ref 0 in let dist = ref 0 in for y = 1 to i1.height do for x = 1 to i1.width do let r = xor_color i1 i2 !pos in incr pos; let g = xor_color i1 i2 !pos in incr pos; let b = xor_color i1 i2 !pos in incr pos; if r+b+g <> 0 then incr diffs; dist := !dist + r * r + b * b + g * g; output_byte oc (if prop then r else if r <> 0 then 255 else 0); output_byte oc (if prop then g else if g <> 0 then 255 else 0); output_byte oc (if prop then b else if b <> 0 then 255 else 0); output_byte oc_r (if prop then r else if r <> 0 then 255 else 0); output_byte oc_g 0; output_byte oc_b 0; output_byte oc_r 0; output_byte oc_g (if prop then g else if g <> 0 then 255 else 0); output_byte oc_b 0; output_byte oc_r 0; output_byte oc_g 0; output_byte oc_b (if prop then b else if b <> 0 then 255 else 0); done done; close_out oc; close_out oc_r; close_out oc_g; close_out oc_b; let points = i1.width * i1.height in Printf.printf "There were %d/%d differences" !diffs points; print_newline (); Printf.printf "Difference moyenne: %f bogobits/bogopixels" ((sqrt (float_of_int !dist)) /. (float_of_int points) /. 3.); print_newline (); !diffs let _ = if Array.length Sys.argv < 3 then failwith "You should specify at least two filenames"; let i1 = load_ppm Sys.argv.(1) in let i2 = load_ppm Sys.argv.(2) in if compare_ppm Sys.argv.(1) i1 i2 true <> 0 then ignore (compare_ppm Sys.argv.(1) i1 i2 false)