console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

mr. derpsalot derps more; refactored the ui widget thing again...

Browse Source
This commit is contained in:
cqc
2021-11-08 22:27:47 -06:00
parent 983fc326d6
commit 8ee3789cb9
3 changed files with 874 additions and 925 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
irc.ml
View File

@ -244,6 +244,9 @@ module Communicator = struct
end
module Panel = struct
open Panel
open Panel.Ui
type viewer =
{ step: string
; var: view Lwd.var
@ -355,13 +358,6 @@ module Communicator = struct
>>= fun t' -> Lwd.set root t' ; Lwt.return_unit )
>>= fun watch -> Lwt.return (watch, root)
open Nottui
module P = Nottui_pretty
let string ?attr text = P.ui (Nottui_widgets.string ?attr text)
let ( ^^ ) = P.( ^^ )
let ( ^/^ ) a b = P.(a ^^ break 1 ^^ b)
let channelview (store, path) =
storeview store path
>>= fun (_watch, root) ->
@ -382,7 +378,7 @@ module Communicator = struct
v'.node ) in
Lwd.map sub ~f:(fun sub ->
Ui.join_y
(Nottui_widgets.string
(Ui.string
( String.make indent '>' ^ " "
^ v'.step ) )
sub ) ) in
@ -433,39 +429,31 @@ module Communicator = struct
messagelist ch mlist
>>= fun watch -> update_messagelist (Some watch) () in
Lwt.async (update_messagelist None) ;
let doc =
Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
List.fold_left
(fun doc ((year, month, day, hour, sec), content) ->
F.epr "Communicator.Panel.messagelist ch.content=%s@."
content ;
doc
^^ P.group
( string
(F.str "%s.%s.%s.%s.%s" year month day hour
sec )
^^ string " | " ^^ string content )
^^ P.hardline )
P.empty mlist ) in
Lwt.return
(Panel.Nottui.scroll_area (Lwd.map doc ~f:(P.pretty 100)))
(Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
scroll
(List.fold_left
(fun doc ((year, month, day, hour, sec), content) ->
F.epr
"Communicator.Panel.messagelist ch.content=%s@."
content ;
doc
^/^ Ui.string
(F.str "%s.%s.%s.%s.%s" year month day hour
sec )
^^ Ui.string " | " ^^ string content )
Ui.empty mlist ) ) )
let commview (store, path) =
channelview (store, List.rev (List.tl (List.rev path)))
>>= fun (ch, cv) ->
messageview ch
>>= fun mv ->
Lwt.return
(Nottui_widgets.h_pane (Panel.Nottui.scroll_area cv) mv)
Lwt.return (Lwd.map2 cv mv ~f:(fun c m -> join_x c m))
open Nottui_widgets
let panel ({store; view} : Tree.t) =
let base = Lwd.var Nottui_widgets.empty_lwd in
commview (store, view)
>>= fun cv ->
Lwd.set base cv ;
Panel.Nottui.panel (Lwd.join (Lwd.get base)) ()
let panel ({store; view} : Tree.t) : (Event.t -> atom Lwt.t) Lwt.t
=
commview (store, view) >>= fun cv -> Panel.Ui.panel cv
end
end
@ -481,8 +469,26 @@ let _ =
>>= fun comm ->
Communicator.Irc.Config.make_connection comm "irc.hackint.org"
6697 "cqcaml"
>|= fun () ->
>>= fun () ->
Lwt.async (fun () -> Communicator.Irc.connect comm) ;
F.epr
"root_actor := std_actor (Communicator.Panel.panel comm)@." ;
root_actor := std_actor (Communicator.Panel.panel comm) )
Communicator.Panel.panel comm
>|= fun f ->
root_actor :=
std_actor
(Lwt.return
Panel.
{ act=
(fun _ events ->
Lwt_list.fold_left_s
(fun _ ev ->
f ev
>>= fun i ->
Lwt.return (fun s ->
( s
, ( Gg.Box2.of_pts Gg.V2.zero (snd i)
, fst i ) ) ) )
Display.pane_empty events )
; subpanels= []
; tag= "irc" } ) )