/usr/lib/ocaml/camlimages/fttext.mli is in libcamlimages-ocaml-dev 1:4.2.0-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | (***********************************************************************)
(* *)
(* 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: fttext.mli,v 1.1 2007/01/18 10:29:57 rousse Exp $ *)
open Color;;
open Freetype;;
(* the type for actual drawing functions and some samples *)
type 'a drawer = 'a -> int -> 'a;;
val func_darken_only : rgb drawer;;
val func_red_only : rgb drawer;;
val unicode_of_latin : string -> int array;;
val unicode_of_euc_japan : string -> int array;;
(* general drawing function *)
val draw_rotated_text :
float ->
(int -> int -> int -> unit) ->
face ->
int -> int ->
int array ->
unit;;
val draw_rotated_glyphs :
float ->
(int -> int -> int -> unit) ->
face ->
int -> int ->
char_index array ->
unit;;
val draw_text :
(int -> int -> int -> unit) ->
face ->
int -> int ->
int array ->
unit;;
val draw_glyphs :
(int -> int -> int -> unit) ->
face ->
int -> int ->
char_index array ->
unit;;
val draw_mono_rotated_text :
float ->
(int -> int -> int -> unit) ->
face ->
int -> int ->
int array ->
unit;;
val draw_mono_rotated_glyphs :
float ->
(int -> int -> int -> unit) ->
face ->
int -> int ->
char_index array ->
unit;;
val draw_mono_text :
(int -> int -> int -> unit) ->
face ->
int -> int ->
int array ->
unit;;
val draw_mono_glyphs :
(int -> int -> int -> unit) ->
face ->
int -> int ->
char_index array ->
unit;;
module type T = sig
type t
type elt
val create : int -> int -> t
val destroy : t -> unit
val get : t -> int -> int -> elt
val set : t -> int -> int -> elt -> unit
val unsafe_get : t -> int -> int -> elt
val unsafe_set : t -> int -> int -> elt -> unit
end;;
module Make(T : T) : sig
(* Draw texts *)
(* [draw face drawer image x y text] *)
(* Draw a text on image at (x,y), using drawer function *)
(* text must be encoded by some encoder and translated into int array *)
val draw_text : Freetype.face -> T.elt drawer -> T.t ->
int -> int -> int array -> unit
(* Draw rotated texts *)
(* [draw_rotated face drawer image x y r text] *)
(* Draw a text on image at (x,y) rotated r *)
(* Drawn text is automatically smoothed *)
val draw_rotated_text : Freetype.face -> T.elt drawer -> T.t->
int -> int -> float -> int array -> unit
val draw_glyphs : Freetype.face -> T.elt drawer -> T.t ->
int -> int -> char_index array -> unit
val draw_rotated_glyphs : Freetype.face -> T.elt drawer -> T.t->
int -> int -> float -> char_index array -> unit
(* Monochrome (black/white) drawing *)
val draw_mono_text : Freetype.face -> T.elt drawer -> T.t ->
int -> int -> int array -> unit
val draw_mono_rotated_text : Freetype.face -> T.elt drawer -> T.t->
int -> int -> float -> int array -> unit
val draw_mono_glyphs : Freetype.face -> T.elt drawer -> T.t ->
int -> int -> char_index array -> unit
val draw_mono_rotated_glyphs : Freetype.face -> T.elt drawer -> T.t->
int -> int -> float -> char_index array -> unit
end;;
(* Get the size information of text *)
val size :
Freetype.face -> int array -> float * float * float * float;;
val size_of_glyphs :
Freetype.face -> char_index array -> float * float * float * float;;
(* Vector based *)
val vector_gen :
(Freetype.face -> 'a -> 'b list -> float * float) ->
bool ->
float ->
(Freetype.outline_contents -> 'c) ->
Freetype.face -> float -> float -> 'a array -> unit;;
val vector_text :
bool -> (Freetype.outline_contents -> 'a) ->
Freetype.face -> float -> float -> float -> int array -> unit;;
val vector_glyphs :
bool -> (Freetype.outline_contents -> 'a) ->
Freetype.face ->
float -> float -> float -> Freetype.char_index array -> unit;;
|