Index: rosshil.ml
==================================================================
--- rosshil.ml
+++ rosshil.ml
@@ -1,21 +1,36 @@
(* [ʞ] rosshil.ml - tasshila semes sirvos
* ~ lexi hale <lexi@hale.su>
* $ ocamlopt.opt rosshil.ml -o rosshil
- * © AGPL
+ * © GNU GPLv3
+ * ? rosshil is a tool for transforming various dates in the
+ * calendar systems of Spirals into other representations.
+ * feel free to copy it and use it for your own settings
+ * if you're as much of a perfectionist dweeb as me; just
+ * make sure you change the name of the utility so it's
+ * not in Ranuir
*)
(* basic units *)
type timespan = int (* earth seconds are current tick unit *)
type timepoint = int
type quantity = int
type proportion = float
-type runopt = NoOpt | NoANSI | ASCII
+type runopt = NoOpt | NoANSI | ASCII | Debug | OutOnly
let optstrs = [
- NoANSI, "noansi";
- ASCII, "ascii";
+ NoANSI, "-plain";
+ NoANSI, "p";
+
+ ASCII, "-ascii";
+ ASCII, "a";
+
+ Debug, "-verbose";
+ Debug, "v";
+
+ OutOnly, "-out";
+ OutOnly, "o";
]
let is_opt str = List.exists (fun (_,s) -> ("-"^s) = str) optstrs
let opt_of_str str = let (opt,_) = List.find
(fun (_,s) -> ("-"^s) = str) optstrs in opt;
@@ -207,26 +222,10 @@
League.Span.(fmt(calc span)) ^" from Creation →\n\t";
League.Cal.(fmt(calc time)) ^"\n";
]
*)
-let usage arrow ansi hl bin =
- let heading = "usage: " in
- let syntax = [
- "<faction> [year <year>] [day <day>] to <faction>",
- "convert a calendar date";
- "<number> <faction> (days | years [<days> days]) to <faction>",
- "convert a span of time";
- ] in
- let spacing = String.make (String.length heading) ' ' in
- let mkrow (s,d) = bin ^ " " ^ (ansi "96" s) ^"\n" ^
- spacing ^ ((ansi "3;95" (" "^arrow^" " ^ d))^"\n") in
- let space s = spacing ^ (mkrow s) in
- let fst = (hl heading) ^ (mkrow (List.hd syntax)) in
- let rst = List.map space (List.tl syntax) in
- List.fold_left (^) fst rst;;
-
type funcset = {
calc : int -> date;
fmt : date -> string;
equiv : date -> int;
}
@@ -239,11 +238,11 @@
}
let funcs : funcrow list = [
(* Society *) {
- names=["society"; "shil"; "ranshil"; "rs"];
+ names=["Society of Worlds"; "society"; "shil"; "ranshil"; "rs"];
fmt="92";
span = {
calc=Society.Span.calc;
fmt=Society.Span.fmt;
equiv=Society.Span.equiv;
@@ -253,11 +252,11 @@
fmt=Society.Cal.fmt;
equiv=Society.Cal.equiv;
};
};
(* Empire *) {
- names=["empire"; "ziapha"; "zp"; "imperial"];
+ names=["Heavenly Empire of a Thousand Suns"; "empire"; "imperial";"ziapha"; "zp"];
fmt="91";
span = {
calc =Empire.Span.calc;
fmt =Empire.Span.fmt;
equiv=Empire.Span.equiv;
@@ -267,11 +266,11 @@
fmt =Empire.Cal.fmt;
equiv =Empire.Cal.equiv;
};
};
(* League *) {
- names=["league"; "ly"];
+ names=["Socialist League"; "league"; "ly"];
fmt="96";
span = {
calc =League.Span.calc;
fmt =League.Span.fmt;
equiv=League.Span.equiv;
@@ -281,11 +280,11 @@
fmt =League.Cal.fmt;
equiv =League.Cal.equiv;
};
};
(* Gregorian *) {
- names=["gregorian"; "terrestrial"; "earth"; "gy"];
+ names=["Gregorian calendar"; "gregorian"; "terrestrial"; "earth"; "gy"; "ce";];
fmt="95";
span = {
calc = Gregorian.Span.calc;
fmt = Gregorian.Span.fmt;
equiv = Gregorian.Span.equiv;
@@ -299,10 +298,68 @@
fmt = bad_dim;
equiv = bad_dim;
};
};
]
+
+
+let usage arrow ansi hl bin =
+ let caltext = (
+ let heading = "calendars: " in
+ let desc (cal: funcrow) : string =(
+ let name = List.hd cal.names in
+ let aliases = List.tl cal.names in
+ let append a b = if a = "" then b else (a^", "^b) in
+ let fmt = cal.fmt in
+ (ansi fmt (hl name)) ^
+ (ansi fmt (" [" ^ (List.fold_left append "" aliases) ^"]") ^"\n"))
+ in let spacing = String.make (String.length heading) ' ' in
+ let space s = spacing ^ (desc s) in
+ let fst = (hl heading) ^ (desc (List.hd funcs)) in
+ let rst = List.map space (List.tl funcs) in
+ (List.fold_left (^) fst rst)
+ ) in
+
+ let heading = "usage: " in
+ let opts = " [options] " in
+ let syntax = [
+ "<faction> [year <year>] [day <day>] to <faction>",
+ "convert a calendar date";
+ "<number> <faction> (days | years [<days> days]) to <faction>",
+ "convert a span of time";
+ "<faction> ticks <years> years <days> days",
+ "count temporal ticks corresponding to a timespan";
+ "<faction> epoch <year> day <day>",
+ "get the Spirals epoch for a particular date";
+ "epoch <epoch> to <system>",
+ "convert a Spirals epoch to a calendar date";
+ "<number> ticks to <system>",
+ "convert a tick count to a span of time in a given calendar";
+ ] in
+ let spacing = String.make (String.length heading) ' ' in
+ let mkrow (s,d) = bin ^ opts ^ (ansi "94" s) ^"\n" ^
+ spacing ^ ((ansi "3;95" (" "^arrow^" " ^ d))^"\n") in
+ let space s = spacing ^ (mkrow s) in
+ let opt_heading = "options: " in
+ let optdesc = [
+ "o","out", "only print what the date is converted into";
+ "p","plain", "do not format output with ansi escape codes";
+ "v","verbose", "output extra debugging information";
+ "a","ascii", "use only ASCII in output (instead of UTF-8)";
+ ] in
+ let opt_spacing = String.make (String.length opt_heading) ' ' in
+ let mkopt (s,l,d) = "-"^s^" "^(ansi "94" ("(--"^l^")"))^": "^(ansi "95" d)^"\n" in
+ let spaceopt s = opt_spacing ^ (mkopt s) in
+
+ let fst_opt = (hl opt_heading) ^ (mkopt (List.hd optdesc)) in
+ let rst_opt = List.map spaceopt (List.tl optdesc) in
+ let opt_body = List.fold_left (^) fst_opt rst_opt in
+
+ let fst = (hl heading) ^ (mkrow (List.hd syntax)) in
+ let rst = List.map space (List.tl syntax) in
+ (List.fold_left (^) fst rst) ^"\n"^ opt_body ^"\n" ^ caltext;;
+
let contains ar v : bool = List.exists (fun a -> a = v) ar
let getfuncs (tag: string) : funcrow = List.find
(* pred *) (fun (a:funcrow) -> contains a.names tag)
@@ -321,11 +378,11 @@
let indate = {years = years; days = days} in
let time = from_sys.equiv indate in
let outdate = to_sys.calc time in
let instr = from_sys.fmt indate in
let outstr = to_sys.fmt outdate in
- (from_funcs.fmt, instr, to_funcs.fmt, outstr)
+ (from_funcs.fmt, instr, to_funcs.fmt, outstr, time)
let rec parse (opts: runopt list) (args: string list) (bin: string) = let
has_opt o = List.exists (fun a -> a = o) opts in
let switch o a b = if has_opt o then a else b in
@@ -332,36 +389,69 @@
let ansi (fmt: string) (str: string) = switch NoANSI str
("\x1b["^fmt^"m"^str^"\x1b[m") in
let hl txt = switch NoANSI txt
("\x1b[1m" ^ txt ^ "\x1b[21m") in
+ let arrow = (switch ASCII "->" "→") in
+ let dbg msg : unit = (if has_opt Debug then print_string
+ (ansi "35;3" ((hl " -- ") ^ msg ^ "\n")) else ()) in
+ let op msg o = dbg msg; o in
- let res_fmt (inf,ind,outf,outd) =
- (ansi inf ind) ^ (switch ASCII " -> " " → ") ^ (ansi outf (hl outd)) in
+ let res_fmt (inf,ind,outf,outd,_) =
+ (switch OutOnly "" ((ansi inf ind) ^" "^ arrow ^" "))^ (ansi outf (hl outd)) in
+ let epoch (_,_,_,_,time) = time in
match args with
| opt :: rst when is_opt opt -> let o = opt_of_str opt in
- (* (print_string ("running conv with flag "^opt^"!\n")); *)
- parse (o :: opts) rst bin
- | [fromcal; "to"; calendar] ->
- (res_fmt (conv Timespan fromcal calendar 1 0))^"\n" ^
- (res_fmt (conv Timespan fromcal calendar 0 1))^"\n"
+ (op ("saw flag " ^opt^ ", adding to option set and restarting parse")
+ parse (o :: opts) rst bin)
+
+ (* convert timepoints between different calendars *)
| [fromcal; "date"; date; "to"; calendar]
| [fromcal; "year"; date; "to"; calendar] ->
(res_fmt (conv Calendar fromcal calendar (int_of_string date) 0))^"\n"
| [fromcal; "year"; years; "day"; days; "to"; calendar] ->
(res_fmt (conv Calendar fromcal calendar
(int_of_string years)
(int_of_string days)))^"\n"
+
+ (* absolute values - maybe useful for scripting, e.g.
+ * comparing or sorting lists of dates in different
+ * systems. *)
+ | [cal; "epoch"; years; "day"; days;] ->
+ (string_of_int (epoch (conv Calendar cal cal
+ (int_of_string years)
+ (int_of_string days))))^"\n"
+ | [cal; "ticks"; years; "years"; days; "days"] ->
+ (string_of_int (epoch (conv Timespan cal cal
+ (int_of_string years)
+ (int_of_string days))))^"\n"
+
+ (* absolute values - convert timepoints/spans to dates *)
+ | ["epoch"; epoch; "to"; system;] ->
+ let fns = getfuncs system in
+ (res_fmt ("3", "EPOCH "^epoch, fns.fmt,
+ (fns.cal.fmt (fns.cal.calc (int_of_string epoch))), 0))^"\n"
+ | [ticks; "ticks"; "to"; system;] ->
+ let fns = getfuncs system in
+ (res_fmt ("3", ticks^" TICKS", fns.fmt,
+ (fns.span.fmt (fns.span.calc (int_of_string ticks))), 0))^"\n"
+
+ (* get conversion factors between different days & years *)
+ | [fromcal; "to"; calendar] ->
+ (res_fmt (conv Timespan fromcal calendar 1 0))^"\n" ^
+ (res_fmt (conv Timespan fromcal calendar 0 1))^"\n"
+
+ (* convert timespans of one calendar system to another *)
| [count; from; "years"; "to"; system] ->
(res_fmt (conv Timespan from system (int_of_string count) 0))^"\n"
| [count; from; "days"; "to"; system] ->
(res_fmt (conv Timespan from system 0 (int_of_string count)))^"\n"
| [years; from; "years"; days; "days"; "to"; system] ->
(res_fmt (conv Timespan from system
(int_of_string years)
(int_of_string days)))^"\n"
- | _ -> (usage (switch ASCII "->" "→") ansi hl bin);;
+ | _ -> (usage arrow ansi hl bin);;
let () = print_string (match (Array.to_list Sys.argv) with
| bin :: rst -> parse [] rst bin
| _ -> "buddy ya fucked up BAD");;