(* * Only Abram's changes are under the GPL V3 * Copyright (c) 2005, 2006, 2007 Abram Hindle * Copyright (c) 1999-2004 Jun Furuse, projet Cristal, INRIA Rocquencourt * 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 . *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Jun Furuse, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1999-2004, *) (* Institut National de Recherche en Informatique et en Automatique. *) (* Distributed only by permission. *) (* *) (***********************************************************************) (* $Id: ttfimg.ml,v 1.11 2004/09/21 18:15:50 weis Exp $ *) open Images;; open OImages;; open Freetype;; open OFreetype;; open Fttext;; let pi = 4.0 *. atan 1.0;; let fonts = ref [];; let message = ref None;; let csize = ref 100.0;; let outfile = ref None;; let fg = ref {r = 0; g = 0; b = 0};; let bg = ref {r = 255; g = 255; b = 255};; let kanjimode = ref false;; let dumpmode = ref false;; let verbosemode = ref false;; let rotation = ref 0. ;; Arg.parse [ "-o", Arg.String (fun s -> outfile := Some s), ": outputfile" ; "-message", Arg.String (fun s -> message := Some s), ": message" ; "-charsize", Arg.Float (fun f -> csize := f), ": charsize (in 72dpi)" ; "-bg", Arg.String (fun s -> bg := Color.color_parse s), ": color"; "-fg", Arg.String (fun s -> fg := Color.color_parse s), ": color"; "-k", Arg.Unit (fun () -> kanjimode := true), "(japanese mode)" ; "-r", Arg.Float (fun f -> rotation := (2.0*.pi*.f)/.(360.0)), " (rotation)" ; "-dump", Arg.Unit (fun () -> dumpmode := true), "(dump mode)"; "-verbose", Arg.Unit (fun () -> verbosemode := true), "(verbose mode)"; ] (fun s -> fonts := s :: !fonts) "ttfimg font";; let fonts = match !fonts with | [] -> failwith "specify font file!" | l -> List.rev l in begin match !outfile, fonts with | None, _ -> () | Some x, [ _ ] -> () | Some x, _ -> failwith "just one font if you specify -o !" end; let treat_font font = if !verbosemode then prerr_endline (Printf.sprintf "Processing %s" font); try let out = match !outfile with | None -> let out = font ^ ".jpg" in prerr_endline (Printf.sprintf "%s: will be written in %s" font out); out | Some s -> s in let format = guess_format out in if !verbosemode then prerr_endline "opening font..."; let face = new OFreetype.face font 0 in face#set_char_size !csize !csize 72 72; if !verbosemode then List.iter (fun cmap -> prerr_endline (Printf.sprintf "charmap: { platform_id = %d; encoding_id = %d}" cmap.platform_id cmap.encoding_id) ) face#charmaps; begin try face#set_charmap { platform_id = 3; encoding_id = 1 } with | _ -> try face#set_charmap { platform_id = 3; encoding_id = 0 } with | _ -> face#set_charmap (List.hd face#charmaps) end; (* let mbbox = get_maximum_bbox inst#face in *) let smetrics = face#size_metrics in if !dumpmode then begin let plus = 2 in let num_glyphs = face#num_glyphs in let rec digit x = if x < 10 then 1 else digit (x / 10) + 1 in let digit_num = digit num_glyphs in let numid n = let s = string_of_int n in String.make (digit_num - String.length s) '0' ^ s in for i = 0 to num_glyphs do if !verbosemode then prerr_endline (Printf.sprintf "glyph #%d..." i); let x1,y1,x2,y2 = face#size_of_glyphs [|char_index_of_int i|] in let w = truncate x2 - truncate x1 + plus * 2 in let h = truncate y2 - truncate y1 + plus * 2 in let rgb = new rgb24_filled w h {r = 255; g = 255; b = 255} in OFreetype.draw_glyphs face Fttext.func_darken_only (rgb :> rgb map) (plus-(truncate x1)) (truncate y2 + plus) [|char_index_of_int i|]; rgb#save (out ^ "-" ^ numid i) (Some format) [Save_Quality 95] done end else begin match !message with | None -> () | Some s -> if !verbosemode then prerr_endline (Printf.sprintf "drawing %s..." s); let plus = 8 in let encoded = if !kanjimode then unicode_of_euc_japan s else unicode_of_latin s in let x1, y1, x2, y2 = face#size encoded in let h = truncate (ceil y2) - truncate y1 + 1 + plus in let d = int_of_float (if (x2>y2) then x2 else y2) in let d = d * 5 / 4 in prerr_endline (Printf.sprintf "height = %d" h); let w = 2 * d in let h = 2 * d in let rgb = new rgb24_filled w h !bg in face#set_transform (Freetype.matrix_rotate !rotation) {ft_x=(float_of_int d) ; ft_y = (float_of_int d)}; OFreetype.draw_rotated_text face (fun org level -> let level' = 255 - level in { r = (org.r * level' + !fg.r * level) / 255; g = (org.g * level' + !fg.g * level) / 255; b = (org.b * level' + !fg.b * level) / 255 }) (rgb :> rgb map) d d (!rotation) encoded; let outfile = match !outfile with | Some f -> f | None -> prerr_endline "Output to out.png"; "out.png" in let x1 = ref (2*d) in let y1 = ref (2*d) in let x2 = ref 0 in let y2 = ref 0 in for y = 0 to (2 * d - 1) do for x = 0 to (2 * d - 1) do if ((rgb#get x y).r < 255) then begin if (x < !x1) then x1 := x; if (x > !x2) then x2 := x; if (y < !y1) then y1 := y; if (y > !y2) then y2 := y; end done done; let rgb = rgb#sub !x1 !y1 (!x2 - !x1) (!y2 - !y1) in rgb#save outfile None [] end with | Failure e -> prerr_endline (font ^ ": Failure " ^ e) in List.iter treat_font fonts;;