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

(failed?) attempt to use Inuit with Format.symbolic_output_buffer

Browse Source
This commit is contained in:
cqc
2021-10-13 07:34:52 -05:00
parent f3d52bc506
commit 4ec076826c
3 changed files with 984 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
irc.ml
View File

@ -22,25 +22,22 @@ module Communicator = struct
type channel =
{ mutable name: string
; mutable content: msg list
; mutable sender: string -> unit }
; mutable recv: msg -> unit }
let add_msg (c : channel) msg = c.content <- msg :: c.content
type c = {mutable channel: channel; mutable subs: c list}
type t = {mutable channel: channel; mutable subs: t list}
type protocol = Irc | Email | Rss | Mublog
let make_channel (c : c) ?(sender = fun _ -> ()) name =
c.subs <-
{channel= {name; content= []; sender}; subs= []} :: c.subs
let make_channel ?(recv = add_msg) name =
let c = {name; content= []; recv= (fun _ -> ())} in
{c with recv= recv c}
let make () : c =
let c =
{ name= "top"
; content= [create_msg "Wecome to the Communicator"]
; sender= (fun _ -> ()) } in
c.sender <- (fun s -> c.content <- create_msg s :: c.content) ;
c.sender "Currently only IRC is implemented" ;
{channel= c; subs= []}
let make () : t =
let channel = make_channel "top" in
channel.recv (create_msg "Wecome to the Communicator") ;
channel.recv (create_msg "Currently only IRC is implemented") ;
{channel; subs= []}
type connection = unit Lwt.t
@ -48,7 +45,7 @@ module Communicator = struct
module C = Irc_client_tls
module M = Irc_message
let connection (c : c) server port nick channels : unit Lwt.t =
let connection (c : t) server port nick channels : unit Lwt.t =
let add_msg cn str = add_msg cn.channel (create_msg str) in
C.reconnect_loop ~after:30
~connect:(fun () ->
@ -88,12 +85,22 @@ module Communicator = struct
end
module Panel = struct
let panel c =
Panel.prettyprint ~height:20. ~tag:"Communicator" (fun pp ->
F.pf pp " <><><> COMMUNICATOR <><><> @.@." ;
List.iter
(fun msg -> F.pf pp "[%s] %s@." msg.time msg.content)
(List.rev c.channel.content) )
let panel (c : t) =
let open Panel in
let te = Textedit.make "" () in
Textedit.panel ~height:20. te
>>= fun p ->
Lwt.return
{ p with
act=
(fun panel events ->
Textedit.clear te ;
List.iter
(fun m ->
Textedit.insert te
(F.str "[%s] %s\n" m.time m.content) )
c.channel.content ;
p.act panel events ) }
end
end