Source file ftlow.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
(***********************************************************************)
(*                                                                     *)
(*                           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: ftlow.ml,v 1.1 2007/01/18 10:29:57 rousse Exp $ *)

(* The lower interface *)

type library

type face

type face_info = {
    num_faces : int;
    num_glyphs : int;
    family_name : string;
    style_name : string;
    has_horizontal : bool;
    has_vertical : bool;
    has_kerning : bool;
    is_scalable : bool;
    is_sfnt : bool;
    is_fixed_width : bool;
    has_fixed_sizes : bool;
    has_fast_glyphs : bool;
    has_glyph_names : bool;
    has_multiple_masters : bool;
  }

type charmap = { platform_id : int; encoding_id : int; }

type render_mode =
   | Render_Normal (* default *)
   | Render_Mono

type load_flag =
   | Load_no_scale
   | Load_no_hinting

type flags = int

type bitmap_info = {
    bitmap_left : int;
    bitmap_top : int;
    bitmap_width : int;
    bitmap_height : int;
  }

(* glyph metrics *)
type bbox = {
    xmin : int; (* 26.6 *)
    ymin : int; (* 26.6 *)
    xmax : int; (* 26.6 *)
    ymax : int;  (* 26.6 *)
  }

type bearing_advance = {
    bearingx : int; (* 26.6 *)
    bearingy : int; (* 26.6 *)
    advance : int; (* 26.6 *)
  }

type glyph_metrics = {
    gm_width : int (* 26.6 *);
    gm_height : int (* 26.6 *);
    gm_hori : bearing_advance;
    gm_vert : bearing_advance;
  }

(* size metrics *)
type size_metrics = {
    x_ppem : int;
    y_ppem : int;
    x_scale : int; (* 16.16 *)
    y_scale : int; (* 16.16 *)
  }

(* outline info *)
type outline_tag = On_point | Off_point_conic | Off_point_cubic

type outline_contents = {
    n_contours : int;
    n_points : int;
    points : (int * int) array;
    tags : outline_tag array;
    contours : int array;
  }

module C = struct
  external init : unit -> library = "init_FreeType"
  external close : library -> unit = "done_FreeType"
  external new_face : library -> string -> int -> face = "new_Face"
  external face_info : face -> face_info = "face_info"
  external done_face : face -> unit = "done_Face"
  external get_num_glyphs : face -> int = "get_num_glyphs"
  external set_char_size :
    face -> int -> int -> int -> int -> unit = "set_Char_Size"
  external set_pixel_sizes : face -> int -> int -> unit = "set_Pixel_Sizes"
  external get_charmaps : face -> charmap list = "get_CharMaps"
  external set_charmap : face -> charmap -> unit = "set_CharMap"
  external get_char_index : face -> int -> int = "get_Char_Index"
  external load_glyph_raw : face -> int -> flags -> int * int = "load_Glyph"
  external load_char_raw : face -> int -> flags -> int * int = "load_Char"
  external render_glyph_of_face :
    face -> render_mode -> unit = "render_Glyph_of_Face"
  external render_char_raw :
    face -> int -> flags -> render_mode -> int * int = "render_Char"
  external set_transform :
    face -> (int * int * int * int) -> (int * int) -> unit = "set_Transform"
  external get_bitmap_info : face -> bitmap_info = "get_Bitmap_Info"
  external read_bitmap : face -> int -> int -> int = "read_Bitmap"
  external get_glyph_metrics : face -> glyph_metrics = "get_Glyph_Metrics"
  external get_size_metrics : face -> size_metrics = "get_Size_Metrics"
  external get_outline_contents :
    face -> outline_contents = "get_Outline_Contents"
end

include C

let encode_flags flags =
  let int_of_flag = function
    | Load_no_scale -> 1
    | Load_no_hinting -> 2 in
  List.fold_left (fun v f -> v lor int_of_flag f) 0 flags

let load_glyph face code flags = load_glyph_raw face code (encode_flags flags)

let load_char face code flags = load_char_raw face code (encode_flags flags)

let render_glyph face idx flags render_mode =
  let adv = load_glyph face idx flags in
  render_glyph_of_face face render_mode;
  adv

let render_char face code flags render_mode =
  render_char_raw face code (encode_flags flags) render_mode