open Tk
open Jtk

(*****************************************************************************)

let debug = ref false

exception Found of int

let kanji_conv code s =
  let cod = Kanji.code s in
  if code = ANY then s else Kanji.conversion cod code s

let to_euc s = kanji_conv EUC s
let to_jis s = kanji_conv JIS s

(* read a file and convert it to EUC				*)
(* only convert full lines -> need of input and output buffer	*)
let read read_fd =
  if not !Version.japan then read_fd else
  let buf_in,buf_out = Ebuffer.create 128, Ebuffer.create 128 in
  let s1 = String.create 4096 in
  fun s n1 n2 ->
  begin
  try while Ebuffer.used buf_out = 0 do
    let n3 = read_fd s1 0 (min n2 4095) in
    if n3 = 0 then raise Not_found;
    Ebuffer.output buf_in s1 0 n3;
    let l_in = ref 99999999 in
    while Ebuffer.used buf_in < !l_in do
      l_in := Ebuffer.used buf_in;
      let s_in = Ebuffer.get buf_in in
      try for i = 0 to !l_in - 1 do
        if s_in.[i] = '\n' or s_in.[i] = '\r' then raise (Found i) done
      with Found n ->
      Ebuffer.reset buf_in;
      Ebuffer.output buf_in s_in (n+1) (!l_in - n - 1);
      let s2 = String.create (n+1) in 
      String.blit s_in 0 s2 0 (n+1);
      Ebuffer.output_string buf_out (to_euc s2)
(*      Ebuffer.output_string buf_out (to_jis s2) *) 
    done
    done
  with Not_found ->
    Ebuffer.output_string buf_out (to_euc (Ebuffer.get buf_in));
    Ebuffer.reset buf_in
  end;
  let s_out = Ebuffer.get buf_out and l_out = Ebuffer.used buf_out in
  if l_out >= 0 then
  begin
    let n = min l_out n2 in
    String.blit s_out 0 s n1 n;
    Ebuffer.reset buf_out;
    Ebuffer.output buf_out s_out n (l_out - n);
    n
  end
  else
  0  

(* For EUC strings --- Jacques *)
let length s =
  if not !Version.japan then String.length s else
  let n = ref 0 and b = ref false in
  for i = 0 to String.length s - 1 do
    if !b then b := false else
    begin
	incr n;
	b := s.[i] >= '\160'
    end
  done;
  !n

(* TK based Japanised string length 
   maybe inefficient but can be used for JIS also *)
(*
  let length s = Kanji.string_length s
*)

(*****************************************************************************)
  
(* 
 * Finding fonts. Inspired by code in Ical by Sanjay Ghemawat.
 * Possibly bogus because some families use "i" for italic where others
 * use "o".
 * wght: bold, medium
 * slant: i, o, r
 * pxlsz: 8, 10, ...
*)

exception Done of string
exception DonePxlsz of int

let font_table = Hashtbl.create 11

let font_find fmly wght slant pxlsz =
  let frndry = "*" in (* sometimes it is "misc", otherwise "jis" *)
  let fmly = "*" 
  and rgst = "jisx0208.1983" 
  and wght = "*" 
  and slant = "*" 
  and avail_pxlsz = [12; 14; 16; 24] (* increasing order *) 
  in
  (* Fix pxlsz *)
  let pxlsz_cands =
    (* if pxlsz = 17 then produce a list [16; 14; 12; 24] *)
    Sort.list (fun x y -> abs (x - pxlsz) < abs ( y - pxlsz )) avail_pxlsz
  in
  try
  List.iter (fun pxlsz' ->  
    if !debug then Log.f (string_of_int pxlsz ^ " -> " ^ string_of_int pxlsz');
    let fontspec =
       "-"^frndry^"-"^fmly^"-"^wght^"-"^slant^
          "-normal-*-"^string_of_int pxlsz'^"-*-*-*-*-*-"^rgst^"-*" 
    in
    (* Japanese font loading is expensive. Use a cache... *)
    try
      let x = Hashtbl.find font_table pxlsz' in
        if !debug then Log.f ("Font is cached as "^x);
        raise (Done x)
    with
      Not_found ->
	begin
	  if !debug then Log.f ("Try to use "^fontspec);
	  let c = Canvas.create Widget.default_toplevel [] in
	  try
	    (* make a string "foo" *)
	    Kanji.canvas_item c 
	      (Canvas.create_text c (Pixels 0) (Pixels 0) [Text "¤Õ¡¼"]) 
	        [KanjiFont fontspec];
	    destroy c;
	    raise (Done fontspec)
	  with
            Done s -> 
	      Hashtbl.add font_table pxlsz s;
	      raise (Done s)
          | _ -> 
	      destroy c
	end) pxlsz_cands;
    (* If all candidates are tried but failed... *)
    raise (Invalid_argument ("JFont failed : for size "^(string_of_int pxlsz)))
  with
    Done s -> s
