Source file `b_label.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
(* This file is part of BOGUE, by San Vu Ngoc *)

(* A simple text display in one line *)

open B_utils
open Tsdl_ttf
module Theme = B_theme
module Var = B_var
module Draw = B_draw

type font =
  | File of string
  | Font of Ttf.font

type style = Ttf.Style.t

type t =
  { text : string Var.t;
    align : Draw.align;
    render : (Draw.texture option) Var.t;
    font : font Var.t;
    style : Ttf.Style.t;
    size : int; (* font size *)
    fg : (Draw.color option) Var.t; (* foreground color *)
  }

let create ?(size = Theme.label_font_size) ?(font = File !Theme.label_font)
    ?(style = Ttf.Style.normal) ?fg ?(align = Draw.Center) text =
  Draw.ttf_init (); (* we init here so that one can get the size of the widget *)
  { text = Var.create text;
    align;
    render = Var.create None;
    font = Var.create font;
    style;
    size;
    fg = Var.create fg}

let font_from_file file = File file

let style s = s

(* see https://lab.artlung.com/font-awesome-sample/*)
let icon ?size ?fg name =
  create ?size ?fg ~font:(File Theme.fa_font) (Theme.fa_symbol name)

let unload l =
  match Var.get l.render with
  | None -> ()
  | Some tex -> begin
      Draw.forget_texture tex;
      Var.set l.render None
    end

(* TODO *)
let free = unload
(* TODO free font ? *)

let text l = Var.get l.text

let set l text =
  if Var.get l.text <> text
  then begin
    Var.set l.text text;
    let texo = Var.get l.render in
    Var.set l.render None;
    do_option texo Draw.forget_texture
  end

let set_fg_color l color =
  Var.set l.fg (Some color)

(************* display ***********)

(* let default_size = (128,32);;*)
(* "/home/san/public_html/7h09/sites/all/themes/drupal_7h09/css/museo.ttf";; *)


(* physical size *)
let physical_size_text font text =
  (* Attention, SDL_ttf n'est peut-être pas encore initialisé... *)
  go (Ttf.size_utf8 font text)

(* Not used. The init is now done at [create]. *)
let size_text_init font text =
   if not (Ttf.was_init ())
   then (go (Ttf.init ());
         printd debug_graphics "SDL TTF initialized";
         Draw.at_cleanup (fun () ->
             printd debug_graphics "Quitting SDL TTF";
             Ttf.quit ()));
   go (Ttf.size_utf8 font text)

(* Not used. After benchmarking, this function is faster than size_text_init
   after TTF initialization. *)
let size_text_exn font text =
  try go (Ttf.size_utf8 font text) with
  | Failure _ -> size_text_init font text
  | e -> raise e

let render_text_surf ?fg font style text =
  let text = if text = "" then " " else text in
  printd debug_graphics "render_text:%s" text;
  let color = Draw.create_color (default fg (10,11,12,255)) in
  Draw.ttf_set_font_style font style;
  Draw.ttf_render font text color

let render_text renderer ?fg font style text =
  let surf = render_text_surf ?fg font style text in
  printd debug_graphics "convert to texture";
  let tex = Draw.create_texture_from_surface renderer surf in
  Draw.free_surface surf;
  tex


(* open font with specified size. Here this is the true size, it will not be
   scaled. *)
(* This can be used by all widgets requiring a font. *)
let get_font_var v size =
  match Var.get v with
    | Font f -> f
    | File file -> let f = Draw.open_font file size in
      Var.set v (Font f); f

let font l = get_font_var l.font (Theme.scale_int l.size)

let physical_size l =
  match Var.get l.render with
    | Some tex -> Draw.tex_size tex
    | None -> physical_size_text (font l) (text l)

(* a first order approximation of the "logical" size is obtained by dividing by
   the scale; this is not ideal because the final physical scale of the layout
   will be calculated by multiplying this by the scale, resulting in a +/- 1
   pixel error. The size can be larger than the geometry, see
   [center_tex_to_layer]. *)
let size l =
  physical_size l |> Draw.unscale_size

(* Resizing has no effect, since the size of the widget is entirely dictated by
   the font size and possibly the geometry of the housing layout. *)
let resize _size _l =
  ()

let display canvas layer l g =
  let tex = match Var.get l.render with
    | Some t -> t
    | None ->
      let fg = default (Var.get l.fg) Draw.(opaque label_color) in
      let tex = render_text canvas.Draw.renderer (font l) l.style (text l) ~fg in
      Var.set l.render (Some tex); tex in
  [Draw.center_tex_to_layer ~horiz:l.align canvas layer tex g]