mr. derpsalot derps more; refactored the ui widget thing again...
This commit is contained in:
5
dune
5
dune
@ -15,7 +15,12 @@
|
||||
zed
|
||||
lambda-term
|
||||
irmin-unix
|
||||
nottui
|
||||
nottui-pretty
|
||||
uuseg.string
|
||||
grenier.trope
|
||||
uutf
|
||||
uucp
|
||||
ocaml-compiler-libs.common
|
||||
ocaml-compiler-libs.bytecomp
|
||||
ocaml-compiler-libs.toplevel))
|
||||
|
||||
76
irc.ml
76
irc.ml
@ -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" } ) )
|
||||
|
||||
Reference in New Issue
Block a user