(* [ʞ] rosshil.ml - tasshila semes sirvos
* ~ lexi hale <lexi@hale.su>
* $ ocamlopt.opt rosshil.ml -o rosshil
* © AGPL
*)
(* 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
let optstrs = [
NoANSI, "noansi";
ASCII, "ascii";
]
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;
type name = { short: string; long: string; }
let nmpair short long = { short = short; long = long };
type timeunit = {
name : string;
expr : timespan -> string;
span : timespan;
}
let span (start: timepoint) (stop: timepoint) : timespan = stop - start
(* because im a dyscalculic idiot *)
type epoch = {
(* an epoch delineates discrete eras in a calendar system,
* such as which empress is reigning *)
title : name;
start : timepoint;
}
let inepoch (e: epoch) (date: timepoint) = date > e.start
type era = {
(* an era is a period of time that may be attached to
* galactic history or to a single calendar *)
title : name;
start : timepoint;
stop : timepoint;
}
let eraspan (e: era) : timespan = span e.start e.stop
let history : era list = [] (* in DESCENDING order!! *)
let galacticzero : timepoint = 0
type date = { years : quantity; days : quantity }
let strify = string_of_int
exception Bad_dimension
let bad_dim _ = raise Bad_dimension
module Gregorian = struct
module Span = struct
let sec : timespan = 1
let min : timespan = 60 * sec
let hour : timespan = 60 * min
let day : timespan = 24 * hour
let days : quantity = 365
let year : timespan = days * day
let equiv (d: date): timespan =
(year * d.years) + (day * d.days)
let day_equiv calendar_days earth_equiv = int_of_float
(float day *. (float earth_equiv /. float calendar_days))
let calc (span: timespan) : date =
let ctdays = span / day in
let ctyears = ctdays / days in
let rem = ctdays mod days in
{ years = ctyears; days = rem; }
let fmt (d: date) : string = (
(strify d.years) ^ " Gregorian years and " ^
(strify d.days) ^ " days"
)
end
end
module Society = struct
module Span = struct
let days = 256
let earth_days_in_year = 414
let day = Gregorian.Span.day_equiv days earth_days_in_year
let rantis = day / 64
let year = day * days
let equiv (d: date): timespan =
(year * d.years) + (day * d.days)
let calc (span: timespan) : date =
let ctdays = span / day in
let ctyears = ctdays / days in
let rem = ctdays mod days in
{years = ctyears; days = rem}
let fmt (d : date) : string =
("Sh." ^ (strify d.years) ^ "/" ^ (strify d.days))
end
module Cal = struct
let zero = galacticzero + (0 * Span.year)
let equiv (d: date): timepoint =
zero + (Span.year * d.years) + (Span.day * d.days)
let calc (pt: timepoint) : date =
let adj = pt - zero in
let span = Span.calc adj in
{years = span.years; days = span.days; }
let fmt (d: date) : string =
("R" ^ (strify d.years) ^ "/" ^ (strify d.days))
end
end
module Empire = struct
module Span = struct
let days = 376
let earth_days_in_year = 394
let day = Gregorian.Span.day_equiv days earth_days_in_year
let year = day * days
let equiv (d: date): timespan =
(year * d.years) + (day * d.days)
let calc (span: timespan) : date =
let ctdays = span / day in
let ctyears = ctdays / days in
let rem = ctdays mod days in
{years = ctyears; days = rem}
let fmt (d : date) : string =
((strify d.years)^" Old Carnelian orbital years, "^(strify d.days)^" days")
end
module Cal = struct
let zero = Society.Cal.zero + (524 * Span.year)
let equiv (d: date): timepoint =
zero + (Span.year * d.years) + (Span.day * d.days)
let calc (pt: timepoint) : date =
let adj = pt - zero in
let span = Span.calc adj in
{years = span.years; days = span.days; }
let fmt (d: date) : string =
((strify d.years)^"ᵉ and "^(strify d.days)^" days")
end
end
module League = struct
module Span = struct
let days = 300
let earth_days_in_year = 388
let day = Gregorian.Span.day_equiv days earth_days_in_year
let year = day * days
let equiv (d: date): timespan =
(year * d.years) + (day * d.days)
let calc (span: timespan) : date =
let ctdays = span / day in
let ctyears = ctdays / days in
let rem = ctdays mod days in
{years = ctyears; days = rem}
let fmt (d : date) : string =
((strify d.years)^" Topaz orbital years, "^(strify d.days)^" days")
end
module Cal = struct
let zero = Society.Cal.zero + (928 * Society.Span.year)
let equiv (d: date): timepoint =
zero + (Span.year * d.years) + (Span.day * d.days)
let calc (pt: timepoint) : date =
let adj = pt - zero in
let span = Span.calc adj in
{years = span.years; days = span.days; }
let fmt (d: date) : string =
("L."^(strify d.years)^"."^(strify d.days))
end
end
(*
let test () = let time : timepoint = Empire.Cal.equiv {years=953; days=38} in
let span : timespan = time - galacticzero in
List.iter print_string [
"\x1b[1m"^ Gregorian.Span.(fmt(calc time)) ^" from Creation\x1b[0m\n";
Society.Span.(fmt(calc span)) ^" from Creation →\n\t";
Society.Cal.(fmt(calc time)) ^"\n";
Empire.Span.(fmt(calc span)) ^" from Creation →\n\t";
Empire.Cal.(fmt(calc time)) ^"\n";
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;
}
type funcrow = {
names : string list;
fmt : string;
span : funcset;
cal : funcset;
}
let funcs : funcrow list = [
(* Society *) {
names=["society"; "shil"; "ranshil"; "rs"];
fmt="92";
span = {
calc=Society.Span.calc;
fmt=Society.Span.fmt;
equiv=Society.Span.equiv;
};
cal = {
calc=Society.Cal.calc;
fmt=Society.Cal.fmt;
equiv=Society.Cal.equiv;
};
};
(* Empire *) {
names=["empire"; "ziapha"; "zp"; "imperial"];
fmt="91";
span = {
calc =Empire.Span.calc;
fmt =Empire.Span.fmt;
equiv=Empire.Span.equiv;
};
cal = {
calc =Empire.Cal.calc;
fmt =Empire.Cal.fmt;
equiv =Empire.Cal.equiv;
};
};
(* League *) {
names=["league"; "ly"];
fmt="96";
span = {
calc =League.Span.calc;
fmt =League.Span.fmt;
equiv=League.Span.equiv;
};
cal = {
calc =League.Cal.calc;
fmt =League.Cal.fmt;
equiv =League.Cal.equiv;
};
};
(* Gregorian *) {
names=["gregorian"; "terrestrial"; "earth"; "gy"];
fmt="95";
span = {
calc = Gregorian.Span.calc;
fmt = Gregorian.Span.fmt;
equiv = Gregorian.Span.equiv;
};
cal = {
(* gregorian dates do not reference the same
* spacetime continuum that Spirals dates do,
* so any attempt to convert between calendars
* needs to raise an exception *)
calc = bad_dim;
fmt = bad_dim;
equiv = bad_dim;
};
};
]
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)
(* from array *) funcs
type convkind = Calendar | Timespan
let conv (kind: convkind) tagfrom tagto years days =
let choosefuncs system = match kind with
| Calendar -> system.cal
| Timespan -> system.span in
let from_funcs = getfuncs tagfrom in
let to_funcs = getfuncs tagto in
let from_sys = choosefuncs from_funcs in
let to_sys = choosefuncs to_funcs in
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)
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
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 res_fmt (inf,ind,outf,outd) =
(ansi inf ind) ^ (switch ASCII " -> " " → ") ^ (ansi outf (hl outd)) 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"
| [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"
| [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);;
let () = print_string (match (Array.to_list Sys.argv) with
| bin :: rst -> parse [] rst bin
| _ -> "buddy ya fucked up BAD");;