let make_font filename points =
Sdlttf.init () ;
let font = Sdlttf.open_font filename points in
let (_, glyphs) = generate_texture font in
let texture_size = 256 in
let h = (float (Sdlttf.font_height font)) /.
(float texture_size) in
let (spkp,_) = Sdlttf.size_text font " " in
let spaceskip = float spkp in
let render_ascii glyph_index =
let (texture, x, y, w) = glyphs.(glyph_index) in
let sw = 256.0 and sh = 256.0 in
let tex_x = x and
tex_y = y and
tex_w = w and
tex_h = h in
let s_x = 0.0 and
s_y = 0.0 and
s_w = w *. 256. and
s_h = (float (Sdlttf.font_height font)) in
GlTex.bind_texture `texture_2d texture ;
GlDraw.begins `quads ;
(* upper left *)
GlTex.coord2 (tex_x, tex_y) ;
GlDraw.vertex2 (s_x, s_y +. s_h) ;
(* lower left *)
GlTex.coord2 (tex_x , tex_y +. tex_h) ;
GlDraw.vertex2 (s_x, s_y) ;
(* lower right *)
GlTex.coord2 (tex_x +. tex_w, tex_y +. tex_h ) ;
GlDraw.vertex2 (s_x +. s_w, s_y) ;
(* upper right *)
GlTex.coord2 (tex_x +. tex_w, tex_y ) ;
GlDraw.vertex2 (s_x +. s_w, s_y +. s_h) ;
GlDraw.ends () ;
GlMat.translate ~x:s_w () ;
()
in
(* hack until I get non-opaque fonts working. *)
let lineskip = Sdlttf.font_height font in
(*Sdlttf.font_lineskip font in*)
object
method get_texture chr =
let index = (int_of_char chr) - ascii_first_printable in
let (t, _, _, _) = glyphs.(index) in
t
(* This method modifies the gl matrix. *)
method render ~x ~y str =
let rowsdown = ref 0 in
let rec f index =
if index >= String.length str then () else begin
let chr = String.get str index in
let glyph_index = (int_of_char chr) -
ascii_first_printable in
if chr = ' ' then
GlMat.translate ~x:spaceskip ~y:0.0 ~z:0.0 ()
else if chr = '\n' then begin
GlMat.pop () ;
GlMat.push () ;
incr rowsdown ;
GlMat.translate ~y:(float (-(!rowsdown) * lineskip)) () ;
()
end else if glyph_index >= 0 &&
glyph_index < (Array.length glyphs) then
render_ascii glyph_index
else () ;
f (index + 1)
end
in
GlMat.translate3 ((float x), (float (y - lineskip)), 0.0) ;
GlMat.push () ;
GlDraw.normal3 (0.0, 0.0, 1.0) ;
f 0 ;
GlMat.pop () ;
()
end