Source file oFreetype.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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
(***********************************************************************)
(*                                                                     *)
(*                           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: oFreetype.ml,v 1.2 2008/06/16 22:35:42 furuse Exp $ *)

open Images
open Freetype

let library = ref None (* We do not want more than 1 engine, don't we ? *)

let get_library () =
  match !library with
  | None ->
      let e = init () in
      library := Some e;
      e
  | Some e -> e

class face file id =
  let library = get_library () in
  let face, _info = new_face library file id in

  object

  method library = library
  method face = face

  method set_char_size = set_char_size face
  method set_pixel_sizes = set_pixel_sizes face

  method num_glyphs = get_num_glyphs face

  method charmaps = get_charmaps face
  method set_charmap = set_charmap face
  method char_index = get_char_index face

  method load_glyph = load_glyph face
  method load_char = load_char face
  method render_glyph_of_face = render_glyph_of_face face
  method render_glyph = render_glyph face
  method render_char = render_char face

  method set_transform = set_transform face

  method glyph_metrics = get_glyph_metrics face

  method size_metrics = get_size_metrics face

  method outline_contents = get_outline_contents face

  method size string = Fttext.size face string
  method size_of_glyphs string = Fttext.size_of_glyphs face string
end

let draw_gen render_mode renderf rot func face px py string =
  let face = face#face in
  let matrix = matrix_rotate rot in
  let curx = ref (0.0) and cury = ref (0.0) in

  for i = 0 to Array.length string - 1 do
    set_transform face matrix {ft_x= !curx; ft_y= !cury};
    let advx, advy = renderf face string.(i) [] render_mode in
    let binfo = get_bitmap_info face in

    for y = 0 to binfo.bitmap_height - 1 do
      for x = 0 to binfo.bitmap_width - 1 do
  	let z = read_bitmap face x y in
  	let level =
  	  if z < 0 then 0 else
  	  if z > 255 then 255 else z
  	in
	let px = px + binfo.bitmap_left + x
	and py = py - (binfo.bitmap_top - binfo.bitmap_height + y)
	in
	func px py level
      done;
    done;
    curx := !curx +. advx;
    cury := !cury +. advy
  done

let draw_rotated_gen render_mode face (func : 'a -> int -> 'a)
    (image : 'a OImages.map) px py rot renderf string =

  (*let putpixel px py level =
    try
      let orgcolor = image#get px py in
      image#set px py (func orgcolor level);
    with
      Out_of_image -> ()
  in*)

  let face = face#face in
  let matrix = matrix_rotate rot in
  let curx = ref (0.0) and cury = ref (0.0) in

  for i = 0 to Array.length string - 1 do
    set_transform face matrix {ft_x= !curx; ft_y= !cury};
    let advx, advy = renderf face string.(i) [] render_mode in
    let binfo = get_bitmap_info face in

    for y = 0 to binfo.bitmap_height - 1 do
      for x = 0 to binfo.bitmap_width - 1 do
  	let z = read_bitmap face x y in
  	let level =
  	  if z < 0 then 0 else
  	  if z > 255 then 255 else z
  	in
  	try
	  let px = px + binfo.bitmap_left + x
	  and py = py - (binfo.bitmap_top - binfo.bitmap_height + y)
	  in
  	  let orgcolor = image#get px py in
  	  image#set px py (func orgcolor level);
  	with
  	  Out_of_image -> ()
      done;
    done;
    curx := !curx +. advx;
    cury := !cury +. advy
  done

let draw_rotated_text face func image x y rot string =
  draw_rotated_gen Render_Normal face func image x y rot render_char string

let draw_rotated_glyphs face func image x y rot string =
  draw_rotated_gen Render_Normal face func image x y rot render_glyph string

let draw_text face func image x y string =
  draw_rotated_text face func image x y 0.0 string

let draw_glyphs face func image x y string =
  draw_rotated_glyphs face func image x y 0.0 string

(* mono *)
let draw_mono_rotated_text face func image x y rot string =
  draw_rotated_gen Render_Mono face func image x y rot render_char string

let draw_mono_rotated_glyphs face func image x y rot string =
  draw_rotated_gen Render_Mono face func image x y rot render_glyph string

let draw_mono_text face func image x y string =
  draw_mono_rotated_text face func image x y 0.0 string

let draw_mono_glyphs face func image x y string =
  draw_mono_rotated_glyphs face func image x y 0.0 string

(* Vector based *)

let vector_text turn_y func face px py rot string =
  Fttext.vector_gen load_char turn_y rot func face#face px py string

let vector_glyphs turn_y func face px py rot string =
  Fttext.vector_gen load_glyph turn_y rot func face#face px py string