Source file lTerm_widget.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
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
open CamomileLibraryDefault.Camomile
open LTerm_geom
open LTerm_draw
class t = LTerm_widget_base_impl.t
let newline = UChar.of_char '\n'
let text_size str =
let rec loop ofs rows cols max_cols =
if ofs = String.length str then
{ rows; cols = max cols max_cols }
else
let chr, ofs = Zed_utf8.unsafe_extract_next str ofs in
if chr = newline then
if ofs = String.length str then
{ rows; cols = max cols max_cols }
else
loop ofs (rows + 1) 0 (max cols max_cols)
else
loop ofs rows (cols + 1) max_cols
in
loop 0 1 0 0
class label initial_text = object(self)
inherit t "label"
val mutable text = initial_text
val mutable size_request = text_size initial_text
method! size_request = size_request
val mutable style = LTerm_style.none
method! update_resources =
style <- LTerm_resources.get_style self#resource_class self#resources
method text = text
method set_text t =
text <- t;
size_request <- text_size t;
self#queue_draw
val mutable alignment = H_align_center
method set_alignment a = alignment <- a
method! draw ctx _focused =
let { rows ; _ } = LTerm_draw.size ctx in
let row = (rows - size_request.rows) / 2 in
LTerm_draw.fill_style ctx style;
LTerm_draw.draw_string_aligned ctx row alignment text
end
exception Out_of_range = LTerm_containers_impl.Out_of_range
class type box = LTerm_containers_impl.box
class hbox = LTerm_containers_impl.hbox
class vbox = LTerm_containers_impl.vbox
class frame = LTerm_containers_impl.frame
class modal_frame = LTerm_containers_impl.modal_frame
class spacing ?(rows=0) ?(cols=0) () = object
inherit t "glue"
val size_request = { rows; cols }
method! size_request = size_request
end
class hline = object(self)
inherit t "hline"
val size_request = { rows = 1; cols = 0 }
method! size_request = size_request
val mutable style = LTerm_style.none
val mutable connection = LTerm_draw.Light
method! update_resources =
let rc = self#resource_class and resources = self#resources in
style <- LTerm_resources.get_style rc resources;
connection <- LTerm_resources.get_connection (rc ^ ".connection") resources
method! draw ctx _focused =
let { rows ; _ } = LTerm_draw.size ctx in
LTerm_draw.fill_style ctx style;
draw_hline ctx (rows / 2) 0 (LTerm_draw.size ctx).cols connection
end
class vline = object(self)
inherit t "vline"
val size_request = { rows = 0; cols = 1 }
method! size_request = size_request
val mutable style = LTerm_style.none
val mutable connection = LTerm_draw.Light
method! update_resources =
let rc = self#resource_class and resources = self#resources in
style <- LTerm_resources.get_style rc resources;
connection <- LTerm_resources.get_connection (rc ^ ".connection") resources
method! draw ctx _focused =
let { cols ; _ } = LTerm_draw.size ctx in
LTerm_draw.fill_style ctx style;
draw_vline ctx 0 (cols / 2) (LTerm_draw.size ctx).rows connection
end
class button = LTerm_buttons_impl.button
class checkbutton = LTerm_buttons_impl.checkbutton
class type ['a] radio = ['a] LTerm_buttons_impl.radio
class ['a] radiogroup = ['a] LTerm_buttons_impl.radiogroup
class ['a] radiobutton = ['a] LTerm_buttons_impl.radiobutton
class adjustment = LTerm_scroll_impl.adjustment
(** Interface between an adjustment and a scrollbar widget. *)
class type scrollable_adjustment = object
inherit adjustment
method incr : int
method decr : int
method mouse_scroll : int -> int
method set_scroll_bar_mode : [ `fixed of int | `dynamic of int ] -> unit
method set_mouse_mode : [ `middle | `ratio | `auto ] -> unit
method set_min_scroll_bar_size : int -> unit
method set_max_scroll_bar_size : int -> unit
method on_scrollbar_change : ?switch:LTerm_widget_callbacks.switch ->
(unit -> unit) -> unit
end
class type scrollable_document = object
method page_size : int
method set_page_size : int -> unit
method document_size : int
method set_document_size : int -> unit
method page_next : int
method page_prev : int
method calculate_range : int -> int -> int
end
class type scrollable_private = object
method set_scroll_window_size : int -> unit
method get_render_params : int * int * int
end
class type default_scroll_events = object
method mouse_event : LTerm_event.t -> bool
method scroll_key_event : LTerm_event.t -> bool
end
class scrollable = LTerm_scroll_impl.scrollable_adjustment
class vscrollbar = LTerm_scroll_impl.vscrollbar
class hscrollbar = LTerm_scroll_impl.hscrollbar
class vslider = LTerm_scroll_impl.vslider
class hslider = LTerm_scroll_impl.hslider
let run = LTerm_running_impl.run
let run_modal = LTerm_running_impl.run_modal
let prepare_simple_run = LTerm_running_impl.prepare_simple_run