freetype.ml

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

exception FT_Error of string
exception FT_Glyph_Error of string
exception FT_Handle_Error of string
exception FT_Driver_Error of string
exception FT_Memory_Error of string
exception FT_Stream_Error of string
exception FT_Raster_Error of string
exception FT_TrueType_Error of string
exception FT_CFF_Error of string

type library
type face
type glyph
type bitmap

type matrix_mode =
  VERTICAL_MODE
| HORIZONTAL_MODE

type 'a matrix = {
mode:matrix_mode;
size:int ; (* Width of bitmap as taken from the font file *)
aligned_size : int ; (* Realigned height to ease conversion to a long word
                          organized LCD. No limit condition to check.
                         It is the REAL height of the array *)
(* Image size *)
max_size : int;
image_width:int ;
image_height:int ;
elements:'a array}


type load_kind = 
  LOAD_NO_SCALE
| LOAD_NO_HINTING
| LOAD_RENDER
| LOAD_NO_BITMAP
| LOAD_VERTICAL_LAYOUT
| LOAD_FORCE_AUTOHINT
| LOAD_CROP_BITMAP
| LOAD_PEDANTIC
| LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH
| LOAD_NO_RECURSE
| LOAD_IGNORE_TRANSFORM
| LOAD_MONOCHROME
| LOAD_LINEAR_DESIGN
| LOAD_DEFAULT

let _ = Callback.register_exception "freetype exception" (FT_Error "any string")
let _ = Callback.register_exception "freetype glyph exception" (FT_Glyph_Error "any string")
let _ = Callback.register_exception "freetype handle exception" (FT_Handle_Error "any string")
let _ = Callback.register_exception "freetype driver exception" (FT_Driver_Error "any string")
let _ = Callback.register_exception "freetype memory exception" (FT_Memory_Error "any string")
let _ = Callback.register_exception "freetype stream exception" (FT_Stream_Error "any string")
let _ = Callback.register_exception "freetype raster exception" (FT_Raster_Error "any string")
let _ = Callback.register_exception "freetype truetype exception" (FT_TrueType_Error "any string")
let _ = Callback.register_exception "freetype cff exception" (FT_CFF_Error "any string")


external init_freetype : unit -> library = "c_init_freetype"


external new_face : library -> font_path:string -> face_index:int -> face = "c_new_face"

external done_face : face -> unit = "c_done_face"

external set_pixel_sizes : face -> width:int -> height:int -> unit = "c_set_pixel_sizes"
external get_char_index : face -> char_index:int -> int = "c_get_char_index"

let rec int_of_load_kind l = 
  let value_of_kind = function
      LOAD_NO_SCALE -> 1
    | LOAD_NO_HINTING -> 2
    | LOAD_RENDER -> 4
    | LOAD_NO_BITMAP -> 8
    | LOAD_VERTICAL_LAYOUT -> 16
    | LOAD_FORCE_AUTOHINT -> 32
    | LOAD_CROP_BITMAP -> 64
    | LOAD_PEDANTIC -> 128
    | LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH -> 512
    | LOAD_NO_RECURSE -> 1024
    | LOAD_IGNORE_TRANSFORM -> 2048
    | LOAD_MONOCHROME -> 4096
    | LOAD_LINEAR_DESIGN -> 8192
    | LOAD_DEFAULT -> 0 in
  match l with 
      [] -> 0
    | h::t -> (value_of_kind h) + (int_of_load_kind t)

external internal_load_glyph : face -> glyph_index : int -> int -> unit = "c_load_glyph"

let load_glyph face glyph_index kind = internal_load_glyph face glyph_index (int_of_load_kind kind)


external get_glyph : face -> glyph = "c_get_glyph"
external get_face_height : face -> int = "c_get_face_height"
external get_ascent : face -> int = "c_get_ascent"
external get_descent : face -> int = "c_get_descent"
external get_leading : face -> int = "c_get_leading"
external get_underline : face -> int = "c_get_underline"

external get_width : glyph -> int = "c_get_width"
external get_height : glyph -> int = "c_get_height"
external get_x_advance : glyph -> int = "c_get_x_advance"
external get_y_advance : glyph -> int = "c_get_y_advance"
external get_left_origin : glyph -> int = "c_get_left_origin"
external get_top_origin : glyph -> int = "c_get_top_origin"




external get_bitmap : glyph -> bitmap = "c_get_bitmap"

external expand_bitmap : glyph -> int -> reversex:bool -> reversey:bool -> vertical:bool -> int matrix = "c_expand_bitmap"



(* The matrix may have a real width in memory which is higher than the value
given by width because of padding.

Width should not reflect the chard width but only the bitmapd width
TO Be  MODIFIER*)
let get_matrix_size w = w.size 

let get_matrix_aligned_size w = w.aligned_size

let get_matrix_max_size w = w.max_size

let get_matrix_image_width w = w.image_width 

let get_matrix_image_height w = w.image_height 

(* i is column *)
let get_matrix_element w i j = 
  match w.mode with
    VERTICAL_MODE -> w.elements.(i*w.aligned_size + j)
  | HORIZONTAL_MODE -> w.elements.(i + j*w.aligned_size)


let list_of_matrix m = 
  let l = ref [] in
  match m.mode with
    VERTICAL_MODE -> 
       for i=0 to m.size-1 do
          for j=0 to (m.aligned_size)-1 do
            l := List.rev_append [(get_matrix_element m i j)] !l;
          done
       done;
       List.rev !l
  | HORIZONTAL_MODE -> 
       for i=0 to (m.aligned_size)-1 do
          for j=0 to m.size-1 do
             l := List.rev_append [(get_matrix_element m i j)] !l;
          done
       done;
       List.rev !l


let new_matrix w h iw ih vertical =
  if (vertical) then
  begin
    let aligned_size = ((h lsr 5) + 1) in
    let ns =  aligned_size * 32 in
    {
      mode=VERTICAL_MODE;
      size=w;
      aligned_size = ns;
      max_size=h;
      image_width=iw;
      image_height=ih;
      elements=Array.make (w*ns) 0
    }
  end else
  begin
    let aligned_size = ((w lsr 5) + 1) in
    let ns =  aligned_size * 32 in
    {
      mode=HORIZONTAL_MODE;
      size=h;
      aligned_size = ns;
      max_size=w;
      image_width=iw;
      image_height=ih;
      elements=Array.make (h*ns) 0
    }
  end

let set_matrix_element m i j v =
  match m.mode with
    VERTICAL_MODE -> m.elements.(i*m.aligned_size + j) <- v
  | HORIZONTAL_MODE -> m.elements.(i + j*m.aligned_size) <- v

let empty_matrix =
 {
  mode=VERTICAL_MODE;
  max_size=0;
  size=0;
  aligned_size=0;
  image_width=0;
  image_height=0;
  elements=Array.make 0 0
 }