mirror of
https://github.com/reynir/banawa-chat.git
synced 2024-09-27 19:09:38 +00:00
Compare commits
4 commits
53e54b5b9b
...
3f43398866
Author | SHA1 | Date | |
---|---|---|---|
Reynir Björnsson | 3f43398866 | ||
Reynir Björnsson | 1724e5c994 | ||
Reynir Björnsson | fdbc198939 | ||
Reynir Björnsson | 8598f7011f |
21
prompt.ml
21
prompt.ml
|
@ -2,13 +2,14 @@ open Nottui
|
||||||
open Notty
|
open Notty
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
|
quit : unit -> unit;
|
||||||
message : string -> unit;
|
message : string -> unit;
|
||||||
cursor : Rp.Cursor.cursor;
|
cursor : Rp.Cursor.cursor;
|
||||||
}
|
}
|
||||||
|
|
||||||
let make message =
|
let make quit message =
|
||||||
let cursor = Rp.Cursor.create Rp.empty 0 in
|
let cursor = Rp.Cursor.create Rp.empty 0 in
|
||||||
{ message; cursor }
|
{ quit; message; cursor }
|
||||||
|
|
||||||
let map_cursor f state =
|
let map_cursor f state =
|
||||||
{ state with cursor = f state.cursor }
|
{ state with cursor = f state.cursor }
|
||||||
|
@ -63,7 +64,9 @@ module User_prompt = struct
|
||||||
let text, position =
|
let text, position =
|
||||||
Utils.render_cursor ~width:(max 0 (w - 3)) state.cursor
|
Utils.render_cursor ~width:(max 0 (w - 3)) state.cursor
|
||||||
in
|
in
|
||||||
Lwd.set cursor (position + 1, y);
|
let new_cursor = (position + 1, y) in
|
||||||
|
if new_cursor <> (Lwd.peek cursor) then
|
||||||
|
Lwd.set cursor new_cursor;
|
||||||
I.hcat [ I.char A.empty ' ' 1 1 ; text ]
|
I.hcat [ I.char A.empty ' ' 1 1 ; text ]
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -104,15 +107,21 @@ let handler ~hook state = function
|
||||||
state.message msg;
|
state.message msg;
|
||||||
hook { state with cursor = Rp.Cursor.create Rp.empty 0 };
|
hook { state with cursor = Rp.Cursor.create Rp.empty 0 };
|
||||||
`Handled
|
`Handled
|
||||||
|
| `ASCII ('C'..'D'), [`Ctrl] ->
|
||||||
|
state.quit ();
|
||||||
|
`Handled
|
||||||
| _ -> `Unhandled
|
| _ -> `Unhandled
|
||||||
|
|
||||||
let make ~message cursor =
|
let make ~quit ~message cursor =
|
||||||
let ( let* ) x f = Lwd.bind x ~f in
|
let ( let* ) x f = Lwd.bind x ~f in
|
||||||
let ( let+ ) x f = Lwd.map ~f x in
|
let ( let+ ) x f = Lwd.map ~f x in
|
||||||
let ( and+ ) = Lwd.map2 ~f:(fun x y -> (x, y)) in
|
let ( and+ ) = Lwd.map2 ~f:(fun x y -> (x, y)) in
|
||||||
let state = Lwd.var (make message) in
|
let state = Lwd.var (make quit message) in
|
||||||
let position = Lwd.var (0, 0) in
|
let position = Lwd.var (0, 0) in
|
||||||
let hook = Lwd.set state in
|
let hook state' =
|
||||||
|
if (Lwd.peek state).cursor != state'.cursor then
|
||||||
|
Lwd.set state state'
|
||||||
|
in
|
||||||
let update_prompt state (y, w) =
|
let update_prompt state (y, w) =
|
||||||
let user = User_prompt.render ~cursor ~y ~w state in
|
let user = User_prompt.render ~cursor ~y ~w state in
|
||||||
Ui.keyboard_area (handler ~hook state) (Ui.atom user)
|
Ui.keyboard_area (handler ~hook state) (Ui.atom user)
|
||||||
|
|
2
rope.ml
2
rope.ml
|
@ -162,7 +162,7 @@ module Make (S : STRING) (C : CONTROL) = struct
|
||||||
if len = 0 then empty else mksub ofs stop t
|
if len = 0 then empty else mksub ofs stop t
|
||||||
|
|
||||||
let rec safe_iter_range f i n = function
|
let rec safe_iter_range f i n = function
|
||||||
| Str (s, ofs, _) -> S.iter_range f s (ofs + i) n
|
| Str (s, ofs, _) -> S.iter_range f s (max 0 (ofs + i)) n
|
||||||
| App (t1, t2, _, _) ->
|
| App (t1, t2, _, _) ->
|
||||||
let n1 = length t1 in
|
let n1 = length t1 in
|
||||||
if i + n <= n1 then safe_iter_range f i n t1
|
if i + n <= n1 then safe_iter_range f i n t1
|
||||||
|
|
|
@ -43,10 +43,15 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
|
||||||
let msg = Message.make ~nickname:username m in
|
let msg = Message.make ~nickname:username m in
|
||||||
Lwd.set buffer_var (Rb.push buffer msg; buffer);
|
Lwd.set buffer_var (Rb.push buffer msg; buffer);
|
||||||
in
|
in
|
||||||
Rb.push buffer (Message.msgf "Welcome, %s!" username);
|
let quit () =
|
||||||
|
let msg = Message.msgf "%s tried to quit, but it is not implemented" username in
|
||||||
|
Lwd.set buffer_var (Rb.push buffer msg; buffer);
|
||||||
|
in
|
||||||
|
Lwd.set buffer_var
|
||||||
|
(Rb.push buffer (Message.msgf "Welcome, %s!" username); buffer);
|
||||||
let ui =
|
let ui =
|
||||||
let ( let* ) x f = Lwd.bind x ~f in
|
let ( let* ) x f = Lwd.bind x ~f in
|
||||||
let* prompt = Prompt.make ~message cursor in
|
let* prompt = Prompt.make ~quit ~message cursor in
|
||||||
let* window = Window.make buffer_var in
|
let* window = Window.make buffer_var in
|
||||||
Lwd.return (Nottui.Ui.vcat [window; prompt])
|
Lwd.return (Nottui.Ui.vcat [window; prompt])
|
||||||
in
|
in
|
||||||
|
|
18
window.ml
18
window.ml
|
@ -1,7 +1,7 @@
|
||||||
open Nottui
|
open Nottui
|
||||||
open Notty
|
open Notty
|
||||||
|
|
||||||
type t = { w : int; h : int; p : int }
|
type t = { w : int; h : int; }
|
||||||
|
|
||||||
let render_message ~width ~width_nicknames msg =
|
let render_message ~width ~width_nicknames msg =
|
||||||
(* (* FIXME: split doesn't work *)
|
(* (* FIXME: split doesn't work *)
|
||||||
|
@ -9,6 +9,7 @@ let render_message ~width ~width_nicknames msg =
|
||||||
max 1 (width - width_nicknames - 1)
|
max 1 (width - width_nicknames - 1)
|
||||||
in
|
in
|
||||||
let message = Message.split_at ~len:width_message msg in *)
|
let message = Message.split_at ~len:width_message msg in *)
|
||||||
|
let _ = width in
|
||||||
let message = [Message.message msg] in
|
let message = [Message.message msg] in
|
||||||
let color = A.white in
|
let color = A.white in
|
||||||
let rest =
|
let rest =
|
||||||
|
@ -33,8 +34,8 @@ let width_nicknames msgs =
|
||||||
let f msg acc = max (String.length (Message.nickname msg)) acc in
|
let f msg acc = max (String.length (Message.nickname msg)) acc in
|
||||||
Rb.iter ~f msgs 0
|
Rb.iter ~f msgs 0
|
||||||
|
|
||||||
let render { w; h; p } msgs =
|
let render { w; h } msgs =
|
||||||
let idx = ref (Rb.length msgs - 1 - p) in
|
let idx = ref (Rb.length msgs - 1) in
|
||||||
let image = ref I.empty in
|
let image = ref I.empty in
|
||||||
let message = ref I.empty in
|
let message = ref I.empty in
|
||||||
let width_nicknames = width_nicknames msgs in
|
let width_nicknames = width_nicknames msgs in
|
||||||
|
@ -50,27 +51,22 @@ let render { w; h; p } msgs =
|
||||||
done;
|
done;
|
||||||
Ui.atom (I.vsnap ~align:`Bottom h !image)
|
Ui.atom (I.vsnap ~align:`Bottom h !image)
|
||||||
|
|
||||||
let handler ~hook:_ _state _buffer _key = `Unhandled
|
|
||||||
|
|
||||||
let make w =
|
let make w =
|
||||||
let ( let* ) x f = Lwd.bind ~f x in
|
let ( let* ) x f = Lwd.bind ~f x in
|
||||||
let ( let+ ) x f = Lwd.map ~f x in
|
let ( let+ ) x f = Lwd.map ~f x in
|
||||||
let ( and+ ) = Lwd.map2 ~f:(fun x y -> (x, y)) in
|
let ( and+ ) = Lwd.map2 ~f:(fun x y -> (x, y)) in
|
||||||
|
|
||||||
let state = Lwd.var { w = 0; h = 0; p = 0 } in
|
let state = Lwd.var { w = 0; h = 0 } in
|
||||||
let hook = Lwd.set state in
|
|
||||||
|
|
||||||
let* document =
|
let* document =
|
||||||
let+ state = Lwd.get state
|
let+ state = Lwd.get state
|
||||||
and+ buffer = Lwd.get w in
|
and+ buffer = Lwd.get w in
|
||||||
Ui.keyboard_area
|
render state buffer
|
||||||
(handler ~hook state buffer)
|
|
||||||
(render state buffer)
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let update_size ~w ~h =
|
let update_size ~w ~h =
|
||||||
let state' = Lwd.peek state in
|
let state' = Lwd.peek state in
|
||||||
if state'.w <> w || state'.h <> h then Lwd.set state { state' with w; h }
|
if state'.w <> w || state'.h <> h then Lwd.set state { w; h }
|
||||||
in
|
in
|
||||||
|
|
||||||
let measure_size document =
|
let measure_size document =
|
||||||
|
|
Loading…
Reference in a new issue