Initial commit

1 files changed, 288 insertions, 0 deletions

diff --git a/tools.ml b/tools.ml
new file mode 100755
index 0000000..1e0e1c4
--- /dev/null
+++ b/tools.ml
@@ -0,0 +1,288 @@
+let u = UTF8.from_utf8string
+
+module Option = struct
+
+  let map f = function
+  | Some x -> Some (f x)
+  | None -> None
+end
+
+module String = struct
+
+  include String
+
+  let split str ~by:sep = begin
+    let p = String.index str sep in
+    let slen = String.length str in
+    String.sub str 0 p, String.sub str (p + 1) (slen - p - 1)
+  end
+
+  let cut str ~by:sep = begin
+    try String.sub str 0 @@ String.index str sep with
+    | Not_found -> str
+  end
+
+  let string_of_ints v = begin
+    let buff = Buffer.create 1 in
+    let rec convert value = begin
+      Buffer.add_char buff @@ char_of_int @@ value land 0xFF;
+      let rem = value lsr 8 in
+      match rem with
+      | 0 -> Buffer.contents buff
+      | x -> convert x
+    end in
+    let res = convert v in
+    let buff' = Buffer.create @@ String.length res in
+    for i = ((String.length res) - 1) downto 0 do
+      Buffer.add_char buff' @@ String.get res i
+    done;
+    Buffer.contents buff'
+  end
+
+  let print_buffer f t = begin
+    let buff = UTF8.Buffer.create 16 in
+    f buff t;
+    UTF8.Buffer.contents buff
+  end
+
+  let filter_float str = begin
+    let l = String.length str in
+    if l > 0 && String.get str (l - 1) = '.' then
+      String.sub str 0 (l - 1)
+    else
+      str
+  end
+
+end
+
+module Num = struct
+
+  include Num
+
+  let of_float_string a = begin
+    try
+      let ipart_s,fpart_s = String.split a ~by:'.' in
+      let ipart = if ipart_s = "" then Num.Int 0 else Num.num_of_string ipart_s in
+      let fpart =
+        if fpart_s = "" then Num.Int 0
+        else
+          let fpart = Num.num_of_string fpart_s in
+          let num10 = Num.num_of_int 10 in
+          let frac = Num.power_num num10 (Num.num_of_int (String.length fpart_s)) in
+          Num.div_num fpart frac
+      in
+      Num.add_num ipart fpart
+    with Not_found -> Num.num_of_string a
+  end
+
+end
+
+module List = struct
+
+  (** fold_left over only the first element *)
+  let fst f init = function
+  | hd::tl -> f init hd
+  | [] -> init
+
+  let printb ?(first=(u"(")) ?(last=(u")")) ?(sep=(u",")) f buffer elems = begin
+
+    let rec print = begin function
+    | [] -> ()
+    | hd::[] ->
+        f buffer hd;
+    | hd::tl ->
+        f buffer hd;
+        UTF8.Buffer.add_string buffer sep;
+        print tl
+    end in
+
+    UTF8.Buffer.add_string buffer first;
+    print elems;
+    UTF8.Buffer.add_string buffer last
+  end
+
+
+end
+
+module Tuple2 = struct
+
+  let fst = Pervasives.fst
+
+  let snd = Pervasives.snd
+
+  let map1 f (a, b) = (f a, b)
+
+  let map2 f (a, b) = (a, f b)
+
+  let replace1 v (a, b) = (v, b)
+
+  let replace2 v (a, b) = (a, v)
+
+  let printb ?(first="(") ?(last=")") ?(sep=",") format1 format2 out (a, b) = begin
+    UTF8.Printf.bprintf out "%s%a%s%a%s"
+      first
+      format1 a
+      sep
+      format2 b
+      last
+  end
+
+end
+
+module Tuple3 = struct
+
+    let fst (a, b, c) = a
+
+    let snd (a, b, c) = b
+
+    let thd (a, b, c) = c
+
+    let map f (a, b, c) = (f a, f b, f c)
+
+    let map1 f (a, b, c) = (f a, b, c)
+
+    let map2 f (a, b, c) = (a, f b, c)
+
+    let map3 f (a, b, c) = (a, b, f c)
+
+    let replace1 v (a, b, c) = (v, b, c)
+
+    let replace2 v (a, b, c) = (a, v, c)
+
+    let replace3 v (a, b, c) = (a, b, v)
+end
+
+(*
+module Locale = struct
+
+  type locale =
+    | LC_ALL
+    | LC_COLLATE
+    | LC_CTYPE
+    | LC_MONETARY
+    | LC_NUMERIC
+    | LC_TIME
+    | LC_MESSAGES
+
+  external set: locale -> string -> string = "c_set_locale"
+
+  external length: string -> int = "c_length"
+
+end
+*)
+
+module NCurses = struct
+
+  type mouse_event =
+  | BUTTON1_PRESSED
+  | BUTTON1_RELEASED
+  | BUTTON1_CLICKED
+  | BUTTON1_DOUBLE_CLICKED
+  | BUTTON1_TRIPLE_CLICKED
+  | BUTTON2_PRESSED
+  | BUTTON2_RELEASED
+  | BUTTON2_CLICKED
+  | BUTTON2_DOUBLE_CLICKED
+  | BUTTON2_TRIPLE_CLICKED
+  | BUTTON3_PRESSED
+  | BUTTON3_RELEASED
+  | BUTTON3_CLICKED
+  | BUTTON3_DOUBLE_CLICKED
+  | BUTTON3_TRIPLE_CLICKED
+  | BUTTON4_PRESSED
+  | BUTTON4_RELEASED
+  | BUTTON4_CLICKED
+  | BUTTON4_DOUBLE_CLICKED
+  | BUTTON4_TRIPLE_CLICKED
+  | BUTTON_SHIFT
+  | BUTTON_CTRL
+  | BUTTON_ALT
+  | ALL_MOUSE_EVENTS
+  | REPORT_MOUSE_POSITION
+
+  type event_type
+
+  external set_mouse_event: mouse_event list -> unit = "c_set_mouse_event"
+
+  external get_mouse_event: unit -> (int * event_type * (int * int * int)) option = "c_get_mouse_event"
+
+  external is_event_of_type: mouse_event -> event_type -> bool = "c_is_event_of_type"
+
+end
+
+module Date = struct
+
+  type t = Num.num
+
+  let get_julian_day year month day = begin
+    CalendarLib.Date.make year month day
+    |> CalendarLib.Date.to_jd
+    |> Num.num_of_int
+  end
+
+  let date_from_julian_day j = begin
+    let date = CalendarLib.Date.from_jd (Num.int_of_num @@ Num.floor_num j) in
+    (CalendarLib.Date.year date),
+    (CalendarLib.Date.int_of_month @@ CalendarLib.Date.month date),
+    (CalendarLib.Date.day_of_month date)
+  end
+
+  let time_from_julian_day j = begin Num.(
+    let day = floor_num j in
+    let time = j -/ day in
+
+    let h = floor_num @@ time */ (num_of_int 24) in
+    let h_24 = (h // (num_of_int 24)) in
+    let m = floor_num @@ (num_of_int 1440) */ (time -/ h_24 ) in
+    let s = (num_of_int 86400) */ (time -/ h_24 -/ (m // (num_of_int 1440))) in
+    (h, m, s)
+  ) end
+
+  (** Compute the julian for a given date.
+
+      Integer return number of days since November 24, 4714 BC.
+      Fractionnal part return the time since midnight.
+  *)
+  let from_string str = begin
+    let n = Num.num_of_int in
+    let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+"
+    and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in
+    if Str.string_match time_regex str 0 then
+      Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec ->
+      Num.(
+        let nhour = n hour // (n 24)
+        and nmin  = n min // (n 1440)
+        and nsec  = n sec // (n 86400) in
+        (get_julian_day year month day) +/ nhour +/ nmin +/ nsec
+      )
+    ) else if Str.string_match date_regex str 0 then
+      Scanf.sscanf str "%d-%d-%d" get_julian_day
+    else (
+      Num.num_of_int 0
+    )
+  end
+
+  let to_string date = begin
+    let y, m, d = date_from_julian_day date
+    and h, n, s = time_from_julian_day date in
+
+    Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g"
+      y
+      m
+      d
+      (Num.int_of_num h)
+      (Num.int_of_num n)
+      (Num.float_of_num s)
+
+  end
+
+
+end
+
+let try_finally f except =
+  try let res = f () in
+    except ();
+    res
+  with e ->
+    except ();
+    raise e