File: devfont.ml

package info (click to toggle)
advi 1.6.0-6
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 17,416 kB
  • ctags: 2,825
  • sloc: ml: 12,261; sh: 1,500; ansic: 935; makefile: 738; perl: 57; tcl: 10
file content (68 lines) | stat: -rw-r--r-- 2,680 bytes parent folder | download | duplicates (4)
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
(***********************************************************************)
(*                                                                     *)
(*                             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: devfont.ml,v 1.6 2003/10/26 20:18:40 weis Exp $ *)

module type DEVICE = sig
  type glyph
  val make_glyph : Glyph.t -> glyph
end ;;

module type DEVFONT = sig
  type glyph
  val find_metrics : string -> float -> (int * int) Table.t
  val find_glyphs : string -> float -> glyph Table.t
end ;;

module Make (Dev : DEVICE) = struct
  type glyph = Dev.glyph

  let base_dpi = 600

  let find_metrics =
    let htable = Hashtbl.create 257 in
    fun fontname dpi ->
      let sdpi = int_of_float (ldexp dpi 16) in
      let dpi = ldexp (float sdpi) (-16) in
      try Hashtbl.find htable (fontname, sdpi)
      with Not_found ->
	let font = Font.find fontname base_dpi
	and ratio = dpi /. float base_dpi in
	let build code =
	  let cdef = Font.find_char_def font code in
	  (Misc.round (ratio *. float cdef.Font.dx),
	   Misc.round (ratio *. float cdef.Font.dy)) in
	let table = Table.make build in
	Hashtbl.add htable (fontname, sdpi) table ;
	table

  let find_glyphs =
    let htable = Hashtbl.create 257 in
    fun fontname dpi ->
      let sdpi = Misc.round (ldexp dpi 16) in
      let dpi = ldexp (float sdpi) (-16) in
      try Hashtbl.find htable (fontname, sdpi)
      with Not_found ->
	let font = Font.find fontname base_dpi
	and ratio = dpi /. float base_dpi in
	let build code =
	  let cdef = Font.find_char_def font code in
          Dev.make_glyph (Glyph.from_char_def cdef ratio) in
	let table = Table.make build in
	Hashtbl.add htable (fontname, sdpi) table ;
	table
end ;;