Differences From
Artifact [1155e40476]:
1 1 (* [ʞ] rosshil.ml - tasshila semes sirvos
2 2 * ~ lexi hale <lexi@hale.su>
3 3 * $ ocamlopt.opt rosshil.ml -o rosshil
4 - * © AGPL
4 + * © GNU GPLv3
5 + * ? rosshil is a tool for transforming various dates in the
6 + * calendar systems of Spirals into other representations.
7 + * feel free to copy it and use it for your own settings
8 + * if you're as much of a perfectionist dweeb as me; just
9 + * make sure you change the name of the utility so it's
10 + * not in Ranuir
5 11 *)
6 12
7 13 (* basic units *)
8 14 type timespan = int (* earth seconds are current tick unit *)
9 15 type timepoint = int
10 16 type quantity = int
11 17 type proportion = float
12 18
13 -type runopt = NoOpt | NoANSI | ASCII
19 +type runopt = NoOpt | NoANSI | ASCII | Debug | OutOnly
14 20 let optstrs = [
15 - NoANSI, "noansi";
16 - ASCII, "ascii";
21 + NoANSI, "-plain";
22 + NoANSI, "p";
23 +
24 + ASCII, "-ascii";
25 + ASCII, "a";
26 +
27 + Debug, "-verbose";
28 + Debug, "v";
29 +
30 + OutOnly, "-out";
31 + OutOnly, "o";
17 32 ]
18 33 let is_opt str = List.exists (fun (_,s) -> ("-"^s) = str) optstrs
19 34 let opt_of_str str = let (opt,_) = List.find
20 35 (fun (_,s) -> ("-"^s) = str) optstrs in opt;
21 36
22 37 type name = { short: string; long: string; }
23 38 let nmpair short long = { short = short; long = long };
................................................................................
205 220 Empire.Span.(fmt(calc span)) ^" from Creation →\n\t";
206 221 Empire.Cal.(fmt(calc time)) ^"\n";
207 222 League.Span.(fmt(calc span)) ^" from Creation →\n\t";
208 223 League.Cal.(fmt(calc time)) ^"\n";
209 224 ]
210 225 *)
211 226
212 -let usage arrow ansi hl bin =
213 - let heading = "usage: " in
214 - let syntax = [
215 - "<faction> [year <year>] [day <day>] to <faction>",
216 - "convert a calendar date";
217 - "<number> <faction> (days | years [<days> days]) to <faction>",
218 - "convert a span of time";
219 - ] in
220 - let spacing = String.make (String.length heading) ' ' in
221 - let mkrow (s,d) = bin ^ " " ^ (ansi "96" s) ^"\n" ^
222 - spacing ^ ((ansi "3;95" (" "^arrow^" " ^ d))^"\n") in
223 - let space s = spacing ^ (mkrow s) in
224 - let fst = (hl heading) ^ (mkrow (List.hd syntax)) in
225 - let rst = List.map space (List.tl syntax) in
226 - List.fold_left (^) fst rst;;
227 -
228 227 type funcset = {
229 228 calc : int -> date;
230 229 fmt : date -> string;
231 230 equiv : date -> int;
232 231 }
233 232
234 233 type funcrow = {
................................................................................
237 236 span : funcset;
238 237 cal : funcset;
239 238 }
240 239
241 240
242 241 let funcs : funcrow list = [
243 242 (* Society *) {
244 - names=["society"; "shil"; "ranshil"; "rs"];
243 + names=["Society of Worlds"; "society"; "shil"; "ranshil"; "rs"];
245 244 fmt="92";
246 245 span = {
247 246 calc=Society.Span.calc;
248 247 fmt=Society.Span.fmt;
249 248 equiv=Society.Span.equiv;
250 249 };
251 250 cal = {
252 251 calc=Society.Cal.calc;
253 252 fmt=Society.Cal.fmt;
254 253 equiv=Society.Cal.equiv;
255 254 };
256 255 };
257 256 (* Empire *) {
258 - names=["empire"; "ziapha"; "zp"; "imperial"];
257 + names=["Heavenly Empire of a Thousand Suns"; "empire"; "imperial";"ziapha"; "zp"];
259 258 fmt="91";
260 259 span = {
261 260 calc =Empire.Span.calc;
262 261 fmt =Empire.Span.fmt;
263 262 equiv=Empire.Span.equiv;
264 263 };
265 264 cal = {
266 265 calc =Empire.Cal.calc;
267 266 fmt =Empire.Cal.fmt;
268 267 equiv =Empire.Cal.equiv;
269 268 };
270 269 };
271 270 (* League *) {
272 - names=["league"; "ly"];
271 + names=["Socialist League"; "league"; "ly"];
273 272 fmt="96";
274 273 span = {
275 274 calc =League.Span.calc;
276 275 fmt =League.Span.fmt;
277 276 equiv=League.Span.equiv;
278 277 };
279 278 cal = {
280 279 calc =League.Cal.calc;
281 280 fmt =League.Cal.fmt;
282 281 equiv =League.Cal.equiv;
283 282 };
284 283 };
285 284 (* Gregorian *) {
286 - names=["gregorian"; "terrestrial"; "earth"; "gy"];
285 + names=["Gregorian calendar"; "gregorian"; "terrestrial"; "earth"; "gy"; "ce";];
287 286 fmt="95";
288 287 span = {
289 288 calc = Gregorian.Span.calc;
290 289 fmt = Gregorian.Span.fmt;
291 290 equiv = Gregorian.Span.equiv;
292 291 };
293 292 cal = {
................................................................................
297 296 * needs to raise an exception *)
298 297 calc = bad_dim;
299 298 fmt = bad_dim;
300 299 equiv = bad_dim;
301 300 };
302 301 };
303 302 ]
303 +
304 +
305 +let usage arrow ansi hl bin =
306 + let caltext = (
307 + let heading = "calendars: " in
308 + let desc (cal: funcrow) : string =(
309 + let name = List.hd cal.names in
310 + let aliases = List.tl cal.names in
311 + let append a b = if a = "" then b else (a^", "^b) in
312 + let fmt = cal.fmt in
313 + (ansi fmt (hl name)) ^
314 + (ansi fmt (" [" ^ (List.fold_left append "" aliases) ^"]") ^"\n"))
315 + in let spacing = String.make (String.length heading) ' ' in
316 + let space s = spacing ^ (desc s) in
317 + let fst = (hl heading) ^ (desc (List.hd funcs)) in
318 + let rst = List.map space (List.tl funcs) in
319 + (List.fold_left (^) fst rst)
320 + ) in
321 +
322 + let heading = "usage: " in
323 + let opts = " [options] " in
324 + let syntax = [
325 + "<faction> [year <year>] [day <day>] to <faction>",
326 + "convert a calendar date";
327 + "<number> <faction> (days | years [<days> days]) to <faction>",
328 + "convert a span of time";
329 + "<faction> ticks <years> years <days> days",
330 + "count temporal ticks corresponding to a timespan";
331 + "<faction> epoch <year> day <day>",
332 + "get the Spirals epoch for a particular date";
333 + "epoch <epoch> to <system>",
334 + "convert a Spirals epoch to a calendar date";
335 + "<number> ticks to <system>",
336 + "convert a tick count to a span of time in a given calendar";
337 + ] in
338 + let spacing = String.make (String.length heading) ' ' in
339 + let mkrow (s,d) = bin ^ opts ^ (ansi "94" s) ^"\n" ^
340 + spacing ^ ((ansi "3;95" (" "^arrow^" " ^ d))^"\n") in
341 + let space s = spacing ^ (mkrow s) in
342 + let opt_heading = "options: " in
343 + let optdesc = [
344 + "o","out", "only print what the date is converted into";
345 + "p","plain", "do not format output with ansi escape codes";
346 + "v","verbose", "output extra debugging information";
347 + "a","ascii", "use only ASCII in output (instead of UTF-8)";
348 + ] in
349 + let opt_spacing = String.make (String.length opt_heading) ' ' in
350 + let mkopt (s,l,d) = "-"^s^" "^(ansi "94" ("(--"^l^")"))^": "^(ansi "95" d)^"\n" in
351 + let spaceopt s = opt_spacing ^ (mkopt s) in
352 +
353 + let fst_opt = (hl opt_heading) ^ (mkopt (List.hd optdesc)) in
354 + let rst_opt = List.map spaceopt (List.tl optdesc) in
355 + let opt_body = List.fold_left (^) fst_opt rst_opt in
356 +
357 + let fst = (hl heading) ^ (mkrow (List.hd syntax)) in
358 + let rst = List.map space (List.tl syntax) in
359 + (List.fold_left (^) fst rst) ^"\n"^ opt_body ^"\n" ^ caltext;;
360 +
304 361
305 362 let contains ar v : bool = List.exists (fun a -> a = v) ar
306 363
307 364 let getfuncs (tag: string) : funcrow = List.find
308 365 (* pred *) (fun (a:funcrow) -> contains a.names tag)
309 366 (* from array *) funcs
310 367
................................................................................
319 376 let from_sys = choosefuncs from_funcs in
320 377 let to_sys = choosefuncs to_funcs in
321 378 let indate = {years = years; days = days} in
322 379 let time = from_sys.equiv indate in
323 380 let outdate = to_sys.calc time in
324 381 let instr = from_sys.fmt indate in
325 382 let outstr = to_sys.fmt outdate in
326 - (from_funcs.fmt, instr, to_funcs.fmt, outstr)
383 + (from_funcs.fmt, instr, to_funcs.fmt, outstr, time)
327 384
328 385
329 386 let rec parse (opts: runopt list) (args: string list) (bin: string) = let
330 387 has_opt o = List.exists (fun a -> a = o) opts in
331 388 let switch o a b = if has_opt o then a else b in
332 389
333 390 let ansi (fmt: string) (str: string) = switch NoANSI str
334 391 ("\x1b["^fmt^"m"^str^"\x1b[m") in
335 392 let hl txt = switch NoANSI txt
336 393 ("\x1b[1m" ^ txt ^ "\x1b[21m") in
394 + let arrow = (switch ASCII "->" "→") in
395 + let dbg msg : unit = (if has_opt Debug then print_string
396 + (ansi "35;3" ((hl " -- ") ^ msg ^ "\n")) else ()) in
397 + let op msg o = dbg msg; o in
337 398
338 - let res_fmt (inf,ind,outf,outd) =
339 - (ansi inf ind) ^ (switch ASCII " -> " " → ") ^ (ansi outf (hl outd)) in
399 + let res_fmt (inf,ind,outf,outd,_) =
400 + (switch OutOnly "" ((ansi inf ind) ^" "^ arrow ^" "))^ (ansi outf (hl outd)) in
401 + let epoch (_,_,_,_,time) = time in
340 402
341 403 match args with
342 404 | opt :: rst when is_opt opt -> let o = opt_of_str opt in
343 - (* (print_string ("running conv with flag "^opt^"!\n")); *)
344 - parse (o :: opts) rst bin
345 - | [fromcal; "to"; calendar] ->
346 - (res_fmt (conv Timespan fromcal calendar 1 0))^"\n" ^
347 - (res_fmt (conv Timespan fromcal calendar 0 1))^"\n"
405 + (op ("saw flag " ^opt^ ", adding to option set and restarting parse")
406 + parse (o :: opts) rst bin)
407 +
408 + (* convert timepoints between different calendars *)
348 409 | [fromcal; "date"; date; "to"; calendar]
349 410 | [fromcal; "year"; date; "to"; calendar] ->
350 411 (res_fmt (conv Calendar fromcal calendar (int_of_string date) 0))^"\n"
351 412 | [fromcal; "year"; years; "day"; days; "to"; calendar] ->
352 413 (res_fmt (conv Calendar fromcal calendar
353 414 (int_of_string years)
354 415 (int_of_string days)))^"\n"
416 +
417 + (* absolute values - maybe useful for scripting, e.g.
418 + * comparing or sorting lists of dates in different
419 + * systems. *)
420 + | [cal; "epoch"; years; "day"; days;] ->
421 + (string_of_int (epoch (conv Calendar cal cal
422 + (int_of_string years)
423 + (int_of_string days))))^"\n"
424 + | [cal; "ticks"; years; "years"; days; "days"] ->
425 + (string_of_int (epoch (conv Timespan cal cal
426 + (int_of_string years)
427 + (int_of_string days))))^"\n"
428 +
429 + (* absolute values - convert timepoints/spans to dates *)
430 + | ["epoch"; epoch; "to"; system;] ->
431 + let fns = getfuncs system in
432 + (res_fmt ("3", "EPOCH "^epoch, fns.fmt,
433 + (fns.cal.fmt (fns.cal.calc (int_of_string epoch))), 0))^"\n"
434 + | [ticks; "ticks"; "to"; system;] ->
435 + let fns = getfuncs system in
436 + (res_fmt ("3", ticks^" TICKS", fns.fmt,
437 + (fns.span.fmt (fns.span.calc (int_of_string ticks))), 0))^"\n"
438 +
439 + (* get conversion factors between different days & years *)
440 + | [fromcal; "to"; calendar] ->
441 + (res_fmt (conv Timespan fromcal calendar 1 0))^"\n" ^
442 + (res_fmt (conv Timespan fromcal calendar 0 1))^"\n"
443 +
444 + (* convert timespans of one calendar system to another *)
355 445 | [count; from; "years"; "to"; system] ->
356 446 (res_fmt (conv Timespan from system (int_of_string count) 0))^"\n"
357 447 | [count; from; "days"; "to"; system] ->
358 448 (res_fmt (conv Timespan from system 0 (int_of_string count)))^"\n"
359 449 | [years; from; "years"; days; "days"; "to"; system] ->
360 450 (res_fmt (conv Timespan from system
361 451 (int_of_string years)
362 452 (int_of_string days)))^"\n"
363 - | _ -> (usage (switch ASCII "->" "→") ansi hl bin);;
453 + | _ -> (usage arrow ansi hl bin);;
364 454
365 455 let () = print_string (match (Array.to_list Sys.argv) with
366 456 | bin :: rst -> parse [] rst bin
367 457 | _ -> "buddy ya fucked up BAD");;