open Coding

 (* Name of variable in r2d *)
let r2d_name = ref ""

 (* Pixel size to use to generate font bitmap *)
let pixel_size = ref 9

  (* Name of file containing font (with metrics) *)
let file_name = ref ""

let usage = "Usage: r2d_font_tool <options> [r2d font name]\noptions are:"

 (* True if embedded TI font must be used *)
let ti_font = ref false

let get_file_name name = 
 if name = "ti" then
  ti_font := true
 else file_name := name

let get_font_name name = r2d_name := name
let get_font_size the_size = pixel_size := the_size

 (* True if reverse mode (also called mirroring) *)
let reversex = ref false
let reversey = ref false

 (* True if vertical scanning mode *)
let vertical = ref true

 (* True if debug display required *)
let debug = ref false

 (* False if not color lcd *)
let color = ref false

(* Name of script to call for custom processing *)
let custom_compacter = ref false

(* Name of tool *)
let compacter_name = ref ""

(* Name of script if the tool is a script interpreter *)
let script_name = ref ""


let not_supported() = Printf.eprintf "Horizontal option not yet supported. \nWill use
vertical mode as default\n"

  (* Default blocks to use *)
let blocks = ref []

let add_new_block name =
 let add u = 
   blocks := List.rev_append [u] !blocks in
 match name with
  "BASIC_LATIN1" -> add BASIC_LATIN1;
| "LATIN1_SUPPLEMENT" -> add LATIN1_SUPPLEMENT ;
| "LATIN_EXTENDED_A" -> add LATIN_EXTENDED_A ;
| "LATIN_EXTENDED_B" -> add LATIN_EXTENDED_B ;
| "IPA_EXTENSIONS" -> add IPA_EXTENSIONS ;
| "SPACING_MODIFIER_LETTERS" -> add SPACING_MODIFIER_LETTERS ;
| "COMBINING_DIACRITICAL_MARKS" -> add COMBINING_DIACRITICAL_MARKS ;
| "GREEK" -> add GREEK ;
| "CYRILLIC" -> add CYRILLIC ;
| "ARMENIAN" -> add ARMENIAN ;
| "HEBREW" -> add HEBREW ;
| "ARABIC" -> add ARABIC ;
| "SYRIAC" -> add SYRIAC ;
| "THAANA" -> add THAANA ;
| "DEVANAGARI" -> add DEVANAGARI ;
| "BENGALI" -> add BENGALI ;
| "GURMUKHI" -> add GURMUKHI ;
| "GUJARATI" -> add GUJARATI ;
| "ORIYA" -> add ORIYA ;
| "TAMIL" -> add TAMIL ;
| "TELUGU" -> add TELUGU ;
| "KANNADA" -> add KANNADA ;
| "MALAYALAM" -> add MALAYALAM ;
| "SINHALA" -> add SINHALA ;
| "THAI" -> add THAI ;
| "LAO" -> add LAO ;
| "TIBETAN" -> add TIBETAN ;
| "MYANMAR" -> add MYANMAR ;
| "GEORGIAN" -> add GEORGIAN ;
| "HANGUL_JAMO" -> add HANGUL_JAMO ;
| "ETHIOPIC" -> add ETHIOPIC ;
| "CHEROKEE" -> add CHEROKEE ;
| "UNIFIED_CANADIAN_ABORIGINAL" -> add UNIFIED_CANADIAN_ABORIGINAL ;
| "OGHAM" -> add OGHAM ;
| "RUNIC" -> add RUNIC ;
| "KHMER" -> add KHMER ;
| "MONGOLIAN" -> add MONGOLIAN ;
| "LATIN_EXTENDED_ADDITIONAL" -> add LATIN_EXTENDED_ADDITIONAL ;
| "GREEK_EXTENDED" -> add GREEK_EXTENDED ;
| "GENERAL_PUNCTUATION" -> add GENERAL_PUNCTUATION ;
| "SUPER_SUB_SCRIPTS" -> add SUPER_SUB_SCRIPTS ;
| "CURRENCY_SYMBOLS" -> add CURRENCY_SYMBOLS ;
| "COMBINING_MARKS" -> add COMBINING_MARKS ;
| "LETTERLIKE_SYMBOLS" -> add LETTERLIKE_SYMBOLS ;
| "NUMBER_FORMS" -> add NUMBER_FORMS ;
| "ARROWS" -> add ARROWS ;
| "MATHEMATICAL_OPERATORS" -> add MATHEMATICAL_OPERATORS ;
| "MISC_TECHNICAL" -> add MISC_TECHNICAL ;
| "CONTROL_PICTURES" -> add CONTROL_PICTURES ;
| "OCR" -> add OCR ;
| "ENCLOSED_ALPHA" -> add ENCLOSED_ALPHA ;
| "BOX_DRAWING" -> add BOX_DRAWING ;
| "BLOCK_ELEMENTS" -> add BLOCK_ELEMENTS ;
| "GEOMETRIC_SHAPES" -> add GEOMETRIC_SHAPES ;
| "MISC_SYMBOLS" -> add MISC_SYMBOLS ;
| "DINGBATS" -> add DINGBATS ;
| "BRAILLE" -> add BRAILLE ;
| "CJK_RADICAL_SUPPLEMENT" -> add CJK_RADICAL_SUPPLEMENT ;
| "KANGXI_RADICALS" -> add KANGXI_RADICALS ;
| "IDEOGRAPHIC_DESCRIPTION" -> add IDEOGRAPHIC_DESCRIPTION ;
| "CJK_SYMBOLS" -> add CJK_SYMBOLS ;
| "HIRAGANA" -> add HIRAGANA ;
| "KATAKANA" -> add KATAKANA ;
| "BOPOMOFO" -> add BOPOMOFO ;
| "HANGUL_COMPATIBILITY" -> add HANGUL_COMPATIBILITY ;
| "KANBUN" -> add KANBUN ;
| "BOPOFOMO_EXTENDED" -> add BOPOFOMO_EXTENDED ;
| "ENCLOSED_CJK" -> add ENCLOSED_CJK ;
| "CJK_COMPATIBLITY" -> add CJK_COMPATIBLITY ;
| "CJK_UNIFIED_A" -> add CJK_UNIFIED_A ;
| "CJK_UNIFIED" -> add CJK_UNIFIED ;
| "YI_SYLLABLES" -> add YI_SYLLABLES ;
| "YI_RADICALS" -> add YI_RADICALS ;
| "HANGUL_SYLLABLES" -> add HANGUL_SYLLABLES ;
| "HIGH_SURROGATES" -> add HIGH_SURROGATES ;
| "LOW_SURROGATES" -> add LOW_SURROGATES ;
| "PRIVATE_A" -> add PRIVATE_A ;
| "CJK_COMPATIBILITY_IDEOGRAPHS" -> add CJK_COMPATIBILITY_IDEOGRAPHS ;
| "ALPHABETIC_PRESENTATION" -> add ALPHABETIC_PRESENTATION ;
| "ARABIC_PRESENTATION_A" -> add ARABIC_PRESENTATION_A ;
| "COMBINING_HALF_MARKS" -> add COMBINING_HALF_MARKS ;
| "CJK_COMPATIBILITY_FORMS" -> add CJK_COMPATIBILITY_FORMS ;
| "SMALL_FORM_VARIANTS" -> add SMALL_FORM_VARIANTS ;
| "ARABIC_PRESENTATION_B" -> add ARABIC_PRESENTATION_B ;
| "SPECIALS" -> add SPECIALS ;
| "HALFWIDTH" -> add HALFWIDTH ;
| "OLD_ITALIC" -> add OLD_ITALIC ;
| "GOTHIC" -> add GOTHIC ;
| "DESERET" -> add DESERET ;
| "BYZANTINE_MUSICAL" -> add BYZANTINE_MUSICAL ;
| "MUSICAL_SYMBOLS" -> add MUSICAL_SYMBOLS ;
| "MATH_ALPHANUM" -> add MATH_ALPHANUM ;
| "CJK_UNIFIED_B" -> add CJK_UNIFIED_B ;
| "CJK_COMPATIBILITY_IDEOGRAPHS_SUPPLEMENT" -> add CJK_COMPATIBILITY_IDEOGRAPHS_SUPPLEMENT ;
| "TAGS" -> add TAGS ;
| "PRIVATE_B" -> add PRIVATE_B ;
| "PRIVATE_C" -> add PRIVATE_C ;
| "SPECIALS_B" -> add SPECIALS_B ;
| "HIGH_PRIVATE_SURROGATES" -> add HIGH_PRIVATE_SURROGATES ;
 | _ -> Printf.eprintf "Unrecognized unicode block : %s\n" name

let use_custom_compacter compacter =
  custom_compacter := true;
  compacter_name := compacter

let use_script script =
  script_name := script

let get_font() =
      (* Get font file name *)
    let name= !file_name in
      (* Init freetype library *)
    let lib = Freetype.init_freetype() in
      (* Get face table 0 corresponding generally to unicode encoding *)
    let face = Freetype.new_face lib name 0 in
      (* Set pixel sizes wanted *)
    Freetype.set_pixel_sizes face !pixel_size 0;
      (* Compute the metrics for the face *)
    let metrics=Processing.compute_metrics !blocks face  ~vertical:!vertical in
     (* Print debug glyphs for the face given the metrics *)
    if !debug then Processing.debug_display !blocks face metrics
      ~reversex:!reversex ~reversey:!reversey ~vertical:!vertical; 
      (* Create new R2D font *)
    let result=R2d_font.process_font metrics !blocks face
       ~reversex:!reversex ~reversey:!reversey  
      ~vertical:!vertical in
        
(* Close face *)
    Freetype.done_face(face);
    result

  

let get_ti_font() = 
       (* Get TI metrics *)
    let metrics=Processing.ti_metrics ~vertical:!vertical  in 
    (* Print debug glyphs for the face given the metrics *)
    if !debug then Processing.debug_ti_display metrics
      ~reversex:!reversex ~reversey:!reversey  ~vertical:!vertical; 
       (* Create ti_font *)
    R2d_font.process_ti_font metrics 
     ~reversex:!reversex ~reversey:!reversey  ~vertical:!vertical

let _ = 
  Arg.parse [
  ("-size",Arg.Int(get_font_size),"Set the size of the font");
  ("-name",Arg.String(get_font_name),"Set the name of the r2d font");
  ("-reversex",Arg.Set(reversex),"Use reverse mode for horizontal");
  ("-reversey",Arg.Set(reversey),"Use reverse mode for vertical");
  ("-debug",Arg.Set(debug),"Use debug mode");
  ("-horizontal",Arg.Clear(vertical),"Use horizontal mode");
  ("-block",Arg.String(add_new_block),"Add a new unicode block");
  ("-color",Arg.Set(color),"Use color LCD");
  ("-custom",Arg.String(use_custom_compacter),"Name of tool for custom LCD");
  ("-script",Arg.String(use_script),"Name of script for custom LCD");
  ]
  get_file_name
  usage;

  if (!custom_compacter) then
   Lcd.select_compacter (Lcd.LCD_CUSTOM(!compacter_name,!script_name,!r2d_name ^ "_tmp",!vertical))
  else begin
    if (!color) then Lcd.select_compacter (Lcd.LCD_COLOR(!vertical)) else
    Lcd.select_compacter (Lcd.LCD_SIMPLE(!vertical));
  end;

  (* Default blocks to use *)
  if (List.length !blocks = 0) then
    blocks :=  [BASIC_LATIN1;LATIN1_SUPPLEMENT;GENERAL_PUNCTUATION];

  let the_font = if (not !ti_font) then get_font() else get_ti_font() in
  
  let f_metrics = open_out ("font_metrics_" ^ !r2d_name ^ ".h") 
  and f_bitmap = open_out ("font_bitmap_" ^ !r2d_name ^ ".h") 
  and f_table = open_out ("font_table_" ^ !r2d_name ^ ".h") in
    (* Generate font *)
  (try
    Processing.generate_font the_font ~metric_channel:f_metrics 
      ~bitmap_channel:f_bitmap ~table_channel:f_table !r2d_name
      ~vertical:!vertical; 
    close_out f_metrics;
    close_out f_bitmap;
    close_out f_table;
  with _ -> 
     close_out f_metrics;
     close_out f_bitmap;
     close_out f_table;
  );