inprogress
This commit is contained in:
cqc
146
ogui.ml
146
ogui.ml
@ -440,7 +440,6 @@ module Event = struct
|
||||
|
||||
let pp_event : event F.t =
|
||||
fun ppf e ->
|
||||
let open Glfw_types in
|
||||
match e with
|
||||
| Key (a, k, m) ->
|
||||
F.pf ppf "%a %a %a" pp_key_action a pp_key k pp_mods m
|
||||
@ -723,7 +722,7 @@ module Ui = struct
|
||||
enabled : bool;
|
||||
gv : Gv.t;
|
||||
glfw_window : GLFW.window option;
|
||||
bindings : (int * action list Event.t) Lwd.var;
|
||||
bindings : (int * action list Event.resolver) Lwd.var;
|
||||
}
|
||||
|
||||
and action = Custom of string * (unit -> unit Lwt.t)
|
||||
@ -741,7 +740,9 @@ module Ui = struct
|
||||
gv;
|
||||
glfw_window = window;
|
||||
bindings =
|
||||
Lwd.var ~eq:(fun (a, _) (b, _) -> a = b) (0, Event.empty);
|
||||
Lwd.var
|
||||
~eq:(fun (a, _) (b, _) -> a = b)
|
||||
(0, Event.[ pack Fun.id empty ]);
|
||||
}
|
||||
|
||||
let pp_action : action F.t =
|
||||
@ -766,11 +767,8 @@ module Ui = struct
|
||||
let res =
|
||||
match resolver with
|
||||
| Event.Rejected | Event.Accepted _ ->
|
||||
[
|
||||
t.bindings |> Lwd.peek
|
||||
(*Lwd.get |> Lwd.observe |> Lwd.quick_sample *) |> snd
|
||||
|> Event.pack Fun.id;
|
||||
]
|
||||
t.bindings |> Lwd.get |> Lwd.observe |> Lwd.quick_sample
|
||||
|> snd
|
||||
| Event.Continue r -> r
|
||||
in
|
||||
let res = Event.resolve (Key (state, key, mods)) res in
|
||||
@ -785,11 +783,13 @@ module Ui = struct
|
||||
| Event.Continue _ | Event.Rejected -> Lwt.return_unit)
|
||||
>>= fun () -> Lwt.return res
|
||||
|
||||
let update_bindings ui
|
||||
(f : action list Event.t -> action list Event.t) =
|
||||
let append_bindings ui (f : action list Event.resolver) =
|
||||
Lwd.set ui.bindings
|
||||
( Lwd.peek ui.bindings |> fst |> Int.add 1,
|
||||
f (Lwd.peek ui.bindings |> snd) )
|
||||
List.append f (Lwd.peek ui.bindings |> snd) )
|
||||
|
||||
let reset_bindings ui =
|
||||
Lwd.set ui.bindings (Lwd.peek ui.bindings |> fst |> Int.add 1, [])
|
||||
|
||||
let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref =
|
||||
ref (fun _c ->
|
||||
@ -814,11 +814,11 @@ module Ui = struct
|
||||
| Accepted _ -> "Accepted"
|
||||
| Continue _ -> "Continue"
|
||||
| Rejected -> "Rejected"));
|
||||
|
||||
(* junk the `Char that is sent with a `Key that has no mods *)
|
||||
(match res with
|
||||
| Accepted _ when mods = [] || mods == [ Shift ] -> (
|
||||
(* junk the `Char that is sent with a `Key that has no mods *)
|
||||
Lwt_stream.peek events
|
||||
>>= function
|
||||
Lwt_stream.peek events >>= function
|
||||
| Some (`Char _) ->
|
||||
F.epr "process_events: junking next event@.";
|
||||
Lwt_stream.junk events
|
||||
@ -830,7 +830,6 @@ module Ui = struct
|
||||
(Uchar.of_int char);
|
||||
process_char char >>= fun () -> proc (Event.Accepted [])
|
||||
in
|
||||
|
||||
proc Event.Rejected >>= fun _ -> Lwt.return_unit)
|
||||
|
||||
module Style = struct
|
||||
@ -962,12 +961,15 @@ module TextEdit = struct
|
||||
let cursor_set (t : t) (index : int) : unit Lwt.t =
|
||||
cursor_update t (Fun.const index)
|
||||
|
||||
let default_bindings (t : t) (ui : Ui.t) : unit =
|
||||
let default_bindings (t : t) : Ui.action list Event.pack =
|
||||
let open GLFW in
|
||||
let open Event in
|
||||
let open Ui in
|
||||
Ui.update_bindings ui (fun a ->
|
||||
a
|
||||
(Ui.chrcallback_ref :=
|
||||
fun c ->
|
||||
TextBuffer.insert_uchar t.text (Lwd.peek t.cursor).index c
|
||||
>>= fun _ -> cursor_move t 1);
|
||||
empty
|
||||
|> adds
|
||||
[
|
||||
[ Key (Press, F, [ Control ]) ];
|
||||
@ -983,9 +985,7 @@ module TextEdit = struct
|
||||
[ Key (Press, Left, []) ];
|
||||
[ Key (Repeat, Left, []) ];
|
||||
]
|
||||
[
|
||||
Custom ("char_backward", fun () -> cursor_move t (-1));
|
||||
]
|
||||
[ Custom ("char_backward", fun () -> cursor_move t (-1)) ]
|
||||
|> adds
|
||||
[
|
||||
[ Key (Press, N, [ Control ]) ];
|
||||
@ -999,25 +999,17 @@ module TextEdit = struct
|
||||
fun () ->
|
||||
TextBuffer.fold_string t.text (fun s ->
|
||||
let sn = String.length s in
|
||||
let seol =
|
||||
Str.search_forward (Str.regexp "$")
|
||||
in
|
||||
let seol = Str.search_forward (Str.regexp "$") in
|
||||
let next_bol =
|
||||
min sn
|
||||
(seol s (Lwd.peek t.cursor).index + 1)
|
||||
in
|
||||
let next_line_len =
|
||||
seol s next_bol - next_bol
|
||||
min sn (seol s (Lwd.peek t.cursor).index + 1)
|
||||
in
|
||||
let next_line_len = seol s next_bol - next_bol in
|
||||
next_bol
|
||||
+
|
||||
if
|
||||
(Lwd.peek t.cursor).last_col
|
||||
> next_line_len
|
||||
if (Lwd.peek t.cursor).last_col > next_line_len
|
||||
then next_line_len
|
||||
else
|
||||
min next_line_len
|
||||
(Lwd.peek t.cursor).last_col)
|
||||
min next_line_len (Lwd.peek t.cursor).last_col)
|
||||
>>= cursor_set t );
|
||||
]
|
||||
|> adds
|
||||
@ -1046,9 +1038,7 @@ module TextEdit = struct
|
||||
t.cursor.index bol prev_bol prev_line_len; *)
|
||||
prev_bol
|
||||
+
|
||||
if
|
||||
(Lwd.peek t.cursor).last_col
|
||||
> prev_line_len
|
||||
if (Lwd.peek t.cursor).last_col > prev_line_len
|
||||
then prev_line_len
|
||||
else
|
||||
min prev_line_len
|
||||
@ -1057,10 +1047,7 @@ module TextEdit = struct
|
||||
>>= cursor_set t );
|
||||
]
|
||||
|> adds (* EOL *)
|
||||
[
|
||||
[ Key (Press, E, [ Control ]) ];
|
||||
[ Key (Press, End, []) ];
|
||||
]
|
||||
[ [ Key (Press, E, [ Control ]) ]; [ Key (Press, End, []) ] ]
|
||||
[
|
||||
Custom
|
||||
( "end_of_line",
|
||||
@ -1075,13 +1062,12 @@ module TextEdit = struct
|
||||
(Lwd.peek t.cursor).index
|
||||
in
|
||||
Lwd.set t.cursor
|
||||
@@ TextLayout.cursor ~last_col:(eol - bol)
|
||||
eol) );
|
||||
@@ TextLayout.cursor ~last_col:(eol - bol) eol)
|
||||
);
|
||||
]
|
||||
|> adds (* BOL *)
|
||||
[
|
||||
[ Key (Press, A, [ Control ]) ];
|
||||
[ Key (Press, Home, []) ];
|
||||
[ Key (Press, A, [ Control ]) ]; [ Key (Press, Home, []) ];
|
||||
]
|
||||
[
|
||||
Custom
|
||||
@ -1108,8 +1094,7 @@ module TextEdit = struct
|
||||
(mark, (Lwd.peek t.cursor).index)
|
||||
>>= fun _ ->
|
||||
Lwd.set t.mark None;
|
||||
cursor_set t
|
||||
(min mark (Lwd.peek t.cursor).index)
|
||||
cursor_set t (min mark (Lwd.peek t.cursor).index)
|
||||
| None ->
|
||||
if (Lwd.peek t.cursor).index > 0 then
|
||||
TextBuffer.remove_uchar t.text
|
||||
@ -1141,9 +1126,7 @@ module TextEdit = struct
|
||||
>>= fun u -> u );
|
||||
]
|
||||
|> adds
|
||||
[
|
||||
[ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ];
|
||||
]
|
||||
[ [ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ] ]
|
||||
[
|
||||
Custom
|
||||
( "new_line",
|
||||
@ -1176,21 +1159,12 @@ module TextEdit = struct
|
||||
|> adds
|
||||
[
|
||||
[
|
||||
Key (Press, X, [ Control ]);
|
||||
Key (Press, S, [ Control ]);
|
||||
Key (Press, X, [ Control ]); Key (Press, S, [ Control ]);
|
||||
];
|
||||
]
|
||||
(* Save *)
|
||||
[
|
||||
Custom ("save_buffer", fun () -> TextBuffer.save t.text);
|
||||
]);
|
||||
|
||||
Ui.chrcallback_ref :=
|
||||
fun c ->
|
||||
TextBuffer.insert_uchar t.text (Lwd.peek t.cursor).index c
|
||||
>>= fun _ -> cursor_move t 1
|
||||
(* This creates a giant stack of calls lol
|
||||
>>= fun () -> !Ui.chrcallback_ref c *)
|
||||
[ Custom ("save_buffer", fun () -> TextBuffer.save t.text) ]
|
||||
|> Event.pack Fun.id
|
||||
|
||||
let multiline ui ?(text_format = TextLayout.format_default)
|
||||
(text : TextBuffer.t) : t =
|
||||
@ -1218,7 +1192,7 @@ module TextEdit = struct
|
||||
(* return_key = keyboard_shortcut; *)
|
||||
}
|
||||
in
|
||||
default_bindings t ui;
|
||||
Ui.append_bindings ui [ default_bindings t ];
|
||||
t
|
||||
end
|
||||
|
||||
@ -1355,16 +1329,31 @@ end
|
||||
module WindowManager = struct
|
||||
open Layout
|
||||
|
||||
type t =
|
||||
[ `T of dir * (t * dim) list
|
||||
| `TextEdit of TextEdit.t
|
||||
| `Frame of frame ]
|
||||
type content = [ `TextEdit of TextEdit.t | `Frame of frame ]
|
||||
type bindings = Event.event Event.resolver
|
||||
|
||||
type t = [ `T of dir * tt list | content ]
|
||||
and tt = { t : t; dim : dim; bindings : bindings }
|
||||
|
||||
let rec length : t -> int = function
|
||||
| `T (_, tl) ->
|
||||
List.fold_left (fun a (t', _) -> a + length t') 0 tl
|
||||
List.fold_left (fun a { t; _ } -> a + length t) 0 tl
|
||||
| _ -> 1
|
||||
|
||||
let rec nth (n : int) : t -> content option = function
|
||||
| `T (_, tl) ->
|
||||
let rec nl n' : tt list -> content option = function
|
||||
| { t; _ } :: tl' -> (
|
||||
match nth n' t with
|
||||
| Some t -> Some t
|
||||
| None -> nl (n - 1) tl')
|
||||
| [] -> None
|
||||
in
|
||||
nl n tl
|
||||
| (`TextEdit _ | `Frame _) as t ->
|
||||
F.epr "nth: %d@." n;
|
||||
if n == 0 then Some t else None
|
||||
|
||||
let rec fold_left ?(dir = `X)
|
||||
~(f :
|
||||
dir ->
|
||||
@ -1416,6 +1405,12 @@ module WindowManager = struct
|
||||
~size:(`Ratio 1.0, `Pixels 30.)
|
||||
(F.str "window/%d" n, status_format (n == cursor))))
|
||||
|
||||
let frame_default_bindings ui f = Event.empty |> Event.pack Fun.id
|
||||
|
||||
let default_bindings ui = function
|
||||
| `TextEdit t -> [ TextEdit.default_bindings t ]
|
||||
| `Frame f -> [ frame_default_bindings ui f ]
|
||||
|
||||
let make ui ?(style = textedit_style)
|
||||
?(_mode : [ `Tiling | `FullScreen | `Floating ] = `Tiling)
|
||||
(telist : t Lwd.var) =
|
||||
@ -1434,9 +1429,9 @@ module WindowManager = struct
|
||||
< (Lwd.peek telist |> length) - 1
|
||||
then Lwd.peek cursor + 1
|
||||
else 0);
|
||||
(*TextEdit.default_bindings
|
||||
(List.nth (Lwd.peek telist) (Lwd.peek cursor))
|
||||
ui; *)
|
||||
default_bindings
|
||||
(nth (Lwd.peek cursor) (Lwd.peek telist))
|
||||
ui;
|
||||
Lwt.return_unit );
|
||||
]
|
||||
|> Event.adds
|
||||
@ -1634,7 +1629,7 @@ module Painter = struct
|
||||
Gg.Box2.union ra rb |> Lwt.return
|
||||
| `TextEdit tt ->
|
||||
F.epr "`TextEdit";
|
||||
text_layout ui.gv box' tt
|
||||
text_layout ui.gv box' tt >>= fun _ -> Lwt.return box'
|
||||
| `None ->
|
||||
F.epr "`None";
|
||||
Lwt.return Gg.Box2.(v (o box') Gg.V2.zero)
|
||||
@ -1645,12 +1640,7 @@ module Painter = struct
|
||||
>>= fun r ->
|
||||
F.epr "@]";
|
||||
|
||||
let r' =
|
||||
(*Box2.add_pt r
|
||||
V2.(Box2.max r + v style.margin.right style.margin.bottom)
|
||||
|> *)
|
||||
Margin.outer style.margin r
|
||||
in
|
||||
let r' = Margin.outer style.margin r in
|
||||
|
||||
(*F.epr "layout: box=%a box'=%a r=%a r'=%a@." Gg.Box2.pp box
|
||||
Gg.Box2.pp box' Gg.Box2.pp r Gg.Box2.pp r'; *)
|
||||
|
||||
Reference in New Issue
Block a user