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
|
(*
* scroll.ml
* ----------
* Copyright : (c) 2016, Andy Ray <andy.ray@ujamjar.com>
* Licence : BSD3
*
* This file is a part of Lambda-Term.
*)
open Lwt
open LTerm_widget
open LTerm_geom
(* a simple widget with scrollbar support *)
class scrollable_nums (scroll : scrollable) = object
inherit t "nums"
initializer scroll#set_range 197
method! can_focus = false
method! draw ctx _focused =
let { rows; _ } = LTerm_draw.size ctx in
for row=0 to rows-1 do
LTerm_draw.draw_string ctx row 0 (Zed_string.of_utf8 (string_of_int (row + scroll#offset)))
done
end
let main () =
let waiter, wakener = wait () in
let exit = new button "exit" in
exit#on_click (wakeup wakener);
let adj = new scrollable in
let scroll = new vscrollbar adj in
let nums = new scrollable_nums adj in
let hbox = new hbox in
hbox#add ~expand:true nums;
hbox#add ~expand:false scroll;
(* buttons to set scroll offset *)
let prev = new button "prev" in
prev#on_click (fun () -> adj#set_offset (adj#offset-1));
let next = new button "next" in
next#on_click (fun () -> adj#set_offset (adj#offset+1));
let decr = new button "decr" in
decr#on_click (fun () -> adj#set_offset adj#decr);
let incr = new button "incr" in
incr#on_click (fun () -> adj#set_offset adj#incr);
adj#on_offset_change (fun _ -> scroll#queue_draw);
let vbox = new vbox in
vbox#add hbox;
vbox#add ~expand:false (new hline);
vbox#add ~expand:false prev;
vbox#add ~expand:false next;
vbox#add ~expand:false decr;
vbox#add ~expand:false incr;
vbox#add ~expand:false exit;
Lazy.force LTerm.stdout >>= fun term ->
LTerm.enable_mouse term >>= fun () ->
Lwt.finalize
(fun () -> run term vbox waiter)
(fun () -> LTerm.disable_mouse term)
let () = Lwt_main.run (main ())
|
