121 lines
3.9 KiB
OCaml
121 lines
3.9 KiB
OCaml
(*
|
|
when all you can do is type, making things more complicated than a list is hard?
|
|
we need to design this somehow before implementing it
|
|
really the graphical drawing / window management funcitons i think at this point.
|
|
|
|
features:
|
|
- message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
|
|
- i mean really what you want is an editable stream, so you can stage messages for later
|
|
- because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
|
|
*)
|
|
|
|
open Lwt
|
|
open Lwt_react
|
|
module F = Fmt
|
|
|
|
module Communicator = struct
|
|
type msg = {content: string; time: string; mutable seen: bool}
|
|
|
|
let create_msg ?(time = "<ts>") content =
|
|
{content; time; seen= false}
|
|
|
|
type channel =
|
|
{ mutable name: string
|
|
; mutable content: msg list
|
|
; mutable recv: msg -> unit }
|
|
|
|
let add_msg (c : channel) msg = c.content <- msg :: c.content
|
|
|
|
type t = {mutable channel: channel; mutable subs: t list}
|
|
type protocol = Irc | Email | Rss | Mublog
|
|
|
|
let make_channel ?(recv = add_msg) name =
|
|
let c = {name; content= []; recv= (fun _ -> ())} in
|
|
{c with recv= recv c}
|
|
|
|
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
|
|
|
|
module Irc = struct
|
|
module C = Irc_client_tls
|
|
module M = Irc_message
|
|
|
|
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 () ->
|
|
Lwt_io.printl "Connecting..."
|
|
>>= fun () ->
|
|
C.connect_by_name ~server ~port ~nick ()
|
|
>>= fun c ->
|
|
Lwt_io.printl "connect_by_name returned"
|
|
>>= fun () -> Lwt.return c )
|
|
~f:(fun connection ->
|
|
Lwt_io.printl "Connected"
|
|
>>= fun () ->
|
|
Lwt_list.iter_p
|
|
(fun channel ->
|
|
let joiner = C.send_join ~connection ~channel in
|
|
(* make_channel c ~sender:(fun s ->
|
|
C.send_privmsg ~target:channel ~message:s) channel ; *)
|
|
joiner )
|
|
channels )
|
|
~callback:(fun _connection result ->
|
|
match result with
|
|
| Result.Ok ({M.command= M.Other _; _} as msg) ->
|
|
add_msg c
|
|
(F.str "Got unknown message: %s\n" (M.to_string msg)) ;
|
|
Lwt.return_unit
|
|
| Result.Ok ({M.command= M.PRIVMSG (target, data); _} as msg)
|
|
->
|
|
add_msg c
|
|
(F.str "Got PRIVMSG: target=%s, data=%s; %s\n" target
|
|
data (M.to_string msg) ) ;
|
|
Lwt.return_unit
|
|
| Result.Ok msg ->
|
|
add_msg c (M.to_string msg) ;
|
|
Lwt.return_unit
|
|
| Result.Error e -> Lwt_io.printl e )
|
|
()
|
|
end
|
|
|
|
module Panel = struct
|
|
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
|
|
|
|
let _ =
|
|
let comm = Communicator.make () in
|
|
let hackint =
|
|
Communicator.Irc.connection comm "irc.hackint.org" 6697 "cqcaml"
|
|
["#CQC"] in
|
|
Lwt.async (fun () -> hackint) ;
|
|
root_actor := std_actor (Communicator.Panel.panel comm)
|
|
|
|
(**
|
|
program starts...
|
|
- spawn connections to servers
|
|
- these connections will populate the Channel.t in a Channel.tree
|
|
|
|
**)
|