From ef312564ca84a2b49fc291434d8fb2f8501bb618 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 15 Nov 2016 13:00:01 +0100 Subject: Initial commit --- tools.ml | 288 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 288 insertions(+) create mode 100755 tools.ml (limited to 'tools.ml') 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 -- cgit v1.2.3