lcd.ml

是一个手机功能的模拟程序

open Freetype


type kind =
  LCD_COLOR of bool
| LCD_SIMPLE of bool
| LCD_CUSTOM of string*string*string*bool


(* Due to garbage collection, numbers are on 31 bits the 32nd
   being used for GC typing. So, to manage 32 bits a new type is defined *)
type number = WORD32 of int*int

let number_of_int x = 
  WORD32(x lsr 16, x land 0xFFFF)

let left_shift a =
  match(a) with 
   WORD32(ah,al) -> if (al land 0x8000) != 0 then
      WORD32(((ah lsl 1) lor 1), (al lsl 1))
      else
      WORD32((ah lsl 1), al lsl 1)

let right_shift a =
  match(a) with 
   WORD32(ah,al) -> if (ah land 0x1) != 0 then
      WORD32((ah lsr 1) , (al lsr 1) lor 0x8000)
      else
      WORD32(ah lsr 1, al lsr 1)

let set_high_bit a =
   match a with
     WORD32(ah,al) -> WORD32(ah lor 0x8000,al)

(* For following conversion - in vertical mode - all bitmap for all
   glyphs must have the SAME size to get_matrix_height is used.
   But for width, get_matrix_image_width is used since one only needs
   the real width. It is consistent with the size of the font framebuffer
*)
(* Convert the bitmap representing a glyph to a list of word32 *)
let simple_vertical_compact_matrix m  = 
  let r = ref [] 
  and k = ref 0 
  and d = ref (WORD32(0,0)) in
  (* Scanning done column per column : iterate on pixels *)
  for i=0 to (get_matrix_image_width m) - 1 do
    (* Iterate on long words *)
    for j=0 to ((get_matrix_aligned_size m) lsr 5) - 1 do
      k:=0;
      while !k != 32 do
        d:= right_shift !d;
        if (get_matrix_element m i (j*32 + !k) ) != 0 then
          d := set_high_bit !d; 
        k := !k + 1;
      done;
      r := List.rev_append [!d] !r ;
      d := WORD32(0,0)
    done;
  done;
 !r

let simple_horizontal_compact_matrix m  = 
  let r = ref [] 
  and k = ref 0 
  and d = ref (WORD32(0,0)) in
  (* Scanning done line per line : iterate on pixels *)
  for j=0 to (get_matrix_image_height m) - 1 do
    for i=0 to ((get_matrix_aligned_size m) lsr 5) - 1 do
    (* Iterate on long words *)
      k:=0;
      while !k != 32 do
        d:= right_shift !d;
        if (get_matrix_element m (i*32 + !k) j) != 0 then
          d := set_high_bit !d; 
        k := !k + 1;
      done;
      r := List.rev_append [!d] !r ;
      d := WORD32(0,0)
    done;
  done;
 !r

(* Convert the bitmap representing a glyph to a list of word32 :
   all bitmap MUST have the same height so the argument height
   give the max height value computed on all glyphs and in PIXELS*)
let color_vertical_compact_matrix m  = 
  let r = ref [] 
  and k = ref 0 
  and d = ref (WORD32(0,0)) in

  (* Scanning done column per column : iteration done on pixels *)
  for i=0 to (get_matrix_image_width m) - 1 do
    for j=0 to (get_matrix_max_size m) - 1 do
      
      let value = if (get_matrix_element m i j) = 0 then WORD32(0,0)
      else WORD32(0xFF,0xFFFF) in
         r := List.rev_append [value] !r;
    done;
  done;
 !r

let color_horizontal_compact_matrix m  = 
  let r = ref [] 
  and k = ref 0 
  and d = ref (WORD32(0,0)) in

  (* Scanning done column per column : iteration done on pixels *)
   for j=0 to (get_matrix_image_height m) - 1 do
     for i=0 to (get_matrix_max_size m) - 1 do

      
      let value = if (get_matrix_element m i j) = 0 then WORD32(0,0)
      else WORD32(0xFF,0xFFFF) in
         r := List.rev_append [value] !r;
    done;
  done;
 !r

let script_alignment s script_name f v =
(* Return number of memory words required to contain x pixels.
It is LCD dependent *)
 let get_align x =
    let nv = if v then "vertical" else "horizontal" in
    let pid= if (String.length script_name = 0) then
        Unix.create_process s [|" ";nv;f;"ALIGN";(string_of_int x)|] Unix.stdin Unix.stdout Unix.stderr 
    else Unix.create_process s [|" ";script_name;nv;f;"ALIGN";(string_of_int x)|] Unix.stdin Unix.stdout Unix.stderr in
    let (npid,status)=Unix.waitpid [] pid in
    let fin = open_in f in
    let l =  int_of_string(input_line fin) in
    close_in fin;
    l in
  get_align

let script_compacter s script_name f v =
(* f is file for data transfer *)
  let print_an_int fout a =
    output_string fout (string_of_int a) ; output_string fout "\n" in
  let compact_matrix m =
    let nv = if v then "vertical" else "horizontal" in
    let fout= open_out f in
    print_an_int fout (get_matrix_size m); 
    print_an_int fout (get_matrix_aligned_size m); 
    print_an_int fout (get_matrix_max_size m); 
    print_an_int fout (get_matrix_image_width m); 
    print_an_int fout (get_matrix_image_height m); 
    List.iter (print_an_int fout) (list_of_matrix m);
    close_out fout;
    let pid= if (String.length script_name = 0) then
        Unix.create_process s [|" ";nv;f|] Unix.stdin Unix.stdout Unix.stderr 
    else Unix.create_process s [|" ";script_name;nv;f|] Unix.stdin Unix.stdout Unix.stderr in
    let (npid,status)=Unix.waitpid [] pid in
    let fin = open_in f in
    let l = ref [] in
    try
       while true do
          l := List.rev_append [number_of_int (int_of_string(input_line fin))] !l;
       done;
       []
    with End_of_file ->
    close_in fin;
    !l in
  compact_matrix

(* Return the size in long words of the original bitmap - from the
   true type font - containing the glyph image. That image is always
   in 2 bpp mode. *)
let get_lcd_size_in_memory_words x =
  ((x lsr 5) + 1)

let get_lcd_size_in_pixels x = x

let current_compacter = ref simple_vertical_compact_matrix
let current_alignment = ref get_lcd_size_in_memory_words

let select_compacter = function
  LCD_SIMPLE(true) -> current_compacter := simple_vertical_compact_matrix;
                      current_alignment := get_lcd_size_in_memory_words;
| LCD_COLOR(true) -> current_compacter := color_vertical_compact_matrix;
                     current_alignment := get_lcd_size_in_pixels;
| LCD_CUSTOM(tool,sn,f,v) -> current_compacter := script_compacter tool sn f v;
                       current_alignment := script_alignment tool sn f v;
| LCD_SIMPLE(false) -> current_compacter := simple_horizontal_compact_matrix;
                      current_alignment := get_lcd_size_in_memory_words;
| LCD_COLOR(false) -> current_compacter := color_horizontal_compact_matrix;
                      current_alignment := get_lcd_size_in_pixels
 

let compact_matrix m  =
  !current_compacter m 

let get_lcd_size_in_words x =
  !current_alignment x