145 lines
4.6 KiB
OCaml
145 lines
4.6 KiB
OCaml
(* for tls support replace [Irc_client_lwt] with [Irc_client_tls] *)
|
|
open Lwt
|
|
open Irccolors
|
|
open Connection
|
|
module C = Conn(Irc_client_lwt)
|
|
|
|
let logf : string -> unit Lwt.t = Lwt_io.printl
|
|
let formatf = Printf.sprintf
|
|
|
|
(***********************************)
|
|
(** * Options *)
|
|
|
|
let host = ref "localhost"
|
|
let port = ref 6667
|
|
let realname = ":3"
|
|
let botnick = ref "vantabot"
|
|
(* let channel = ref "#bots" *)
|
|
let username = botnick
|
|
let sleeptime = ref 30.
|
|
let countdown = ref 5
|
|
let db_file = ref "toke.db"
|
|
|
|
let smolchannels = ["#tildetown"]
|
|
let bigchannels = ["#bots"]
|
|
|
|
let options = Arg.align
|
|
[ "-host", Arg.Set_string host, " server host name (default: " ^ !host ^ ")"
|
|
; "-port", Arg.Set_int port, " server port (default: " ^ string_of_int !port ^ ")"
|
|
(* ; "-chan", Arg.Set_string channel, " target channel (default: " ^ !channel ^ ")" *)
|
|
; "-nick", Arg.Set_string botnick, " nick prefix (default: " ^ !botnick ^ ")"
|
|
; "-sleeptime", Arg.Set_float sleeptime, " time period for joining the toke call, in seconds (default: " ^ string_of_float !sleeptime ^ ")"
|
|
; "-countdown", Arg.Set_int countdown, " countdown, in seconds (default: " ^ string_of_int !countdown ^ ")"
|
|
; "-db", Arg.Set_string db_file, " database file, will be created if does not exist (default: " ^ !db_file ^ ")"
|
|
]
|
|
|
|
(** * BUSINESS LOGIC HEH *)
|
|
|
|
let toke_in_progress = ref false
|
|
let tokers = ref []
|
|
|
|
let push_toker t =
|
|
let contents = !tokers in
|
|
let cnd = not (List.mem t contents) in
|
|
if cnd then tokers := t::contents;
|
|
cnd
|
|
|
|
let tokeplz () =
|
|
let r = String.concat " " !tokers in
|
|
bold_text (color_text ~fg:Green ~bg:Black "SMOKE NOW ") ^ r
|
|
|
|
let inc_tokers_count () =
|
|
List.iter (fun n -> Store.register_nick n (Store.DB !db_file)) !tokers
|
|
|
|
|
|
let leaf = [
|
|
" W ";
|
|
"WWW";
|
|
" | "]
|
|
|
|
(* let leaf = [
|
|
* " W ";
|
|
* " WWW ";
|
|
* " WWW ";
|
|
* " WWWWW ";
|
|
* "W WWWWW W";
|
|
* "WWW WWWWW WWW";
|
|
* " WWW WWWWW WWW ";
|
|
* " WWW WWW WWW ";
|
|
* " WWW WWW WWW ";
|
|
* " WWWWWWW ";
|
|
* " WWWW | WWWW ";
|
|
* " | ";
|
|
* " | "] *)
|
|
|
|
let show_leaf connection =
|
|
leaf |> Lwt_list.iter_s (fun l ->
|
|
C.send_msg connection ~is_big:false (bold_text (color_text ~fg:Green ~bg:Black l)))
|
|
|
|
let start_toke connection =
|
|
toke_in_progress := true;
|
|
let rec toker_thread n conn =
|
|
if n = 0
|
|
then begin
|
|
let msg = tokeplz () in
|
|
inc_tokers_count ();
|
|
tokers := [];
|
|
C.send_msg connection ~is_big:false msg >>= fun () ->
|
|
toke_in_progress := false;
|
|
show_leaf connection
|
|
end
|
|
else begin
|
|
C.send_msg connection ~is_big:true (color_text ~bg:Green ~fg:LightGreen (formatf "get ready in %i..." n))
|
|
>>= fun () -> Lwt_unix.sleep 1.
|
|
>>= fun () -> toker_thread (n-1) conn
|
|
end
|
|
in
|
|
Lwt.async (fun () ->
|
|
let slt = !sleeptime in
|
|
(if slt > 10.
|
|
then Lwt_unix.sleep (slt-.10.) >>= fun () ->
|
|
C.send_msg connection ~is_big:true
|
|
(color_text ~bg:Black ~fg:LightGreen "get ready to toke in ~10s") >>= fun () ->
|
|
Lwt_unix.sleep 10.
|
|
else Lwt_unix.sleep slt) >>= fun () ->
|
|
toker_thread !countdown connection);
|
|
C.send_msg connection ~is_big:false (formatf "Toke in progress, type in `!toke' to join. Time to go: ~%.1f secs" !sleeptime)
|
|
|
|
let handle_toke who conn =
|
|
let is_new = push_toker who in
|
|
if (!toke_in_progress)
|
|
then if is_new
|
|
then C.send_msg conn ~is_big:false (formatf "%s joins the toke call" who)
|
|
else return ()
|
|
else start_toke conn
|
|
|
|
let rollcall who chan conn =
|
|
let pref = match who with
|
|
None -> ""
|
|
| Some n -> n ^ ": " in
|
|
C.send_msg conn ~channel:chan ~is_big:false (pref ^ "vantabot is a bot for synchronized toking. See <https://tildegit.org/epicmorphism/vantabot>. TL;DR: the only command is !toke")
|
|
|
|
(* Register all the commands *)
|
|
let init conn =
|
|
C.register_callback "rollcall" (fun conn who chan _ ->
|
|
rollcall (if who = "" then None else Some who) chan conn);
|
|
C.register_callback "toke" (fun conn who _ _ ->
|
|
handle_toke (if who = "" then "<lain>" else who) conn)
|
|
|
|
(***********************************)
|
|
|
|
let lwt_main () =
|
|
C.pls_connect ~realname:realname ~username:!username ~server:!host
|
|
~port:!port ~nick:!botnick ~logf
|
|
~onconnect:(fun connection ->
|
|
init connection;
|
|
Lwt_list.iter_p
|
|
(fun c -> C.join_chan connection ~is_big:false ~channel:c) smolchannels
|
|
>>= fun () ->
|
|
Lwt_list.iter_p
|
|
(fun c -> C.join_chan connection ~is_big:true ~channel:c) bigchannels)
|
|
|
|
let _ =
|
|
Arg.parse options (fun _ -> ()) "<vantabot> [options]\n";
|
|
Lwt_main.run (lwt_main ())
|