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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
(***********************************************************************)
(* *)
(* Active-DVI *)
(* *)
(* Projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2002 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Lesser General Public License. *)
(* *)
(* Jun Furuse, Didier Rmy and Pierre Weis. *)
(* Contributions by Roberto Di Cosmo, Didier Le Botlan, *)
(* Xavier Leroy, and Alan Schmitt. *)
(* *)
(* Based on Mldvi by Alexandre Miquel. *)
(***********************************************************************)
(* $Id: font.ml,v 1.3 2011-08-04 13:25:59 remy Exp $ *)
type char_def = {
code : int;
dx : int;
dy : int;
width : int;
height : int;
hoffset : int;
voffset : int;
bitmap : string
};;
type t = {
name : string;
dpi : int;
table : char_def Table.t
};;
(*** Converting PK fonts to abstract fonts ***)
let make_def_from_pk cdef =
Pkfont.unpack cdef;
let bitmap =
match cdef.Pkfont.bitmap with
| Pkfont.Unpacked s -> s
| Pkfont.Packed _ -> assert false in
{ code = cdef.Pkfont.code;
dx = cdef.Pkfont.dx;
dy = cdef.Pkfont.dy;
width = cdef.Pkfont.width;
height = cdef.Pkfont.height;
hoffset = cdef.Pkfont.hoffset;
voffset = cdef.Pkfont.voffset;
bitmap = bitmap };;
let make_font_from_pk font name dpi =
let build code =
make_def_from_pk (Pkfont.find_char_def font code) in
{ name = name;
dpi = dpi;
table = Table.make build }
(*** Finding a given font ***)
let find =
let htable = Hashtbl.create 257 in
fun fontname dpi ->
try Hashtbl.find htable (fontname, dpi)
with Not_found ->
try
let filename = Search.font_path fontname dpi in
let pk_font = Pkfont.load filename in
let font = make_font_from_pk pk_font fontname dpi in
Hashtbl.add htable (fontname, dpi) font;
font
with _ -> raise Not_found;;
module Japanese = struct
(* Temporal hack for Japanese DVI (of pTeX)
This is really inefficient because we convert
freetype -[rendering]-> abstract font -[grayscale]-> graymap -> screen
even though we can create graymap directly from freetype
*)
type jfonttype = Mincho | Gothic
let default_japanese_fontfiles = [
"min", Mincho, "msmincho.ttc";
"goth", Gothic, "msgothic.ttc"
]
;;
let japanese_fontfiles =
let sys_conffile = Filename.concat Config.etc_advi_loc "jpfonts.conf" in
let user_conffile =
Filename.concat Userfile.user_advi_dir "jpfonts.conf" in
try
let jffiles = ref [] in
let ic,conffile =
try open_in user_conffile, user_conffile
with _ -> open_in sys_conffile, sys_conffile in
try while true do
let line = input_line ic in
if not (String.length line = 0 || line.[0] = '#') then begin
let tks =
Misc.split_string line
(function ' ' | '\t' -> true | _ -> false) 0
in
match tks with
| [fname; ftype; ffile] ->
begin try
let ftype =
match ftype with
| "Mincho" -> Mincho
| "Gothic" -> Gothic
| _ ->
Misc.warning (conffile ^ ": illegal font type: " ^ line);
raise Exit
in
jffiles := (fname, ftype, ffile) :: !jffiles
with
| _ -> ()
end
| _ -> Misc.warning (conffile ^ ": parse failure: " ^ line)
end;
done; raise Exit with End_of_file ->
close_in ic;
List.rev !jffiles
with
| _ ->
default_japanese_fontfiles
;;
let make_font =
let facetable = Hashtbl.create 17 in
fun fontname dpi ->
let face,typ,pt,jfm =
try Hashtbl.find facetable fontname
with Not_found ->
let rec search = function
| [] -> raise Not_found
| (pref, typ, file) :: xs ->
try
let name = String.sub fontname 0 (String.length pref) in
let pt =
int_of_string (String.sub fontname (String.length name)
(String.length fontname - String.length name)) in
if name = pref then file, typ, pt
else raise Exit
with
| _ -> search xs
in
let fontfile, typ, pt = search japanese_fontfiles in
let face =
let path =
try
Search.true_file_name [] fontfile
with
| e ->
Misc.warning
(Printf.sprintf "Font file %s for %s is not found"
fontfile fontname);
raise e
in
try
Ttfont.load_face path
with
| e ->
Misc.warning
(Printf.sprintf "Failed to load font file %s for %s"
path fontname);
raise e
in
let jfmname =
let jfm = fontname ^ ".tfm" in
Search.true_file_name [] jfm
in
let jfm = Jfm.load_jfm_file jfmname in
Hashtbl.add facetable fontname (face,typ,pt,jfm);
face,typ,pt,jfm
in
let build jiscode =
let unicode = Ttfont.jis2uni jiscode in
(* metrics *)
let width = Jfm.find_width jfm jiscode in
let dx =
Pervasives.truncate (float width *. float pt *. float dpi
/. 1152.0) (* 72x16 *)
in
let x_fix, y_fix =
let fix =
try List.assoc jiscode
(match typ with
| Mincho -> Jfm.monospace_fix
| Gothic -> Jfm.monospace_fix)
with _ -> 0.0
in
(* width min10 (mincho 10pt) is 9.62216pt
(http://www.matsusaka-u.ac.jp/~okumura/jsclasses/jfm.html) *)
Pervasives.truncate (float pt *. 0.962216 *.
float dpi /. 72.0 *. fix /. 1000.0),
(* baseline fix is quite ad-hoc. I took 10% without reason *)
Pervasives.truncate (float pt *. float dpi /. 72.0 *. 0.10)
in
(* drawing using ttfont.build *)
let chardef = Ttfont.build face dpi pt unicode in
{ code= chardef.Ttfont.code;
dx= chardef.Ttfont.dx + dx;
dy= chardef.Ttfont.dy;
width= chardef.Ttfont.width;
height= chardef.Ttfont.height;
hoffset= chardef.Ttfont.hoffset - x_fix;
voffset= chardef.Ttfont.voffset - y_fix;
bitmap= chardef.Ttfont.bitmap }
in
{ name= fontname; dpi= dpi; table= Table.make build }
;;
(* wrapper : any error returns dumb font *)
let make_font fontname dpi =
try make_font fontname dpi with _ -> raise Not_found
;;
end;;
let find =
let htable = Hashtbl.create 257 in
fun fontname dpi ->
try Hashtbl.find htable (fontname, dpi) with Not_found ->
try
let font = Japanese.make_font fontname dpi in
Hashtbl.add htable (fontname, dpi) font;
font
with Not_found ->
try
let filename = Search.font_path fontname dpi in
let pk_font = Pkfont.load filename in
let font = make_font_from_pk pk_font fontname dpi in
Hashtbl.add htable (fontname, dpi) font;
font
with _ -> raise Not_found;;
(*** Searching for a char_def in a given font ***)
let find_char_def font code = Table.get font.table code;;
|