12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
...
446
447
448
449
450
451
452
453
454
455
456
457
|
(* 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 | Debug | OutOnly
let optstrs = [
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;
type name = { short: string; long: string; }
let nmpair short long = { short = short; long = long };
type timeunit = {
name : string;
expr : timespan -> string;
................................................................................
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
................................................................................
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, 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
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,_) =
(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
(op ("saw flag " ^opt^ ", adding to option set and restarting parse")
parse (o :: opts) rst bin)
................................................................................
(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 arrow ansi hl bin);;
let () = print_string (match (Array.to_list Sys.argv) with
| bin :: rst -> parse [] rst bin
| _ -> "buddy ya fucked up BAD");;
|
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
>
>
<
>
<
>
|
<
>
<
>
<
>
|
<
>
|
|
>
|
|
|
|
|
>
>
|
>
>
|
>
>
|
|
>
>
<
>
|
<
>
|
|
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
...
475
476
477
478
479
480
481
482
483
484
485
486
|
(* basic units *)
type timespan = int (* earth seconds are current tick unit *)
type timepoint = int
type quantity = int
type proportion = float
type runopt = NoOpt | NoANSI | NoColor | ASCII | Debug | OutOnly
let optstrs = [
NoANSI, "-plain";
NoANSI, "-noansi";
NoANSI, "p";
NoColor, "-mono";
NoColor, "-nocolor";
NoColor, "-bw";
NoColor, "m";
ASCII, "-ascii";
ASCII, "a";
Debug, "-verbose";
Debug, "-debug";
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
let in_opt_list opts o = List.exists (fun a -> a = o) opts
type outfmt = {
options: runopt list;
ansi : string -> string -> string;
ul : string -> string;
hl : string -> string;
italic : string -> string;
arrow : string;
}
type name = { short: string; long: string; }
let nmpair short long = { short = short; long = long };
type timeunit = {
name : string;
expr : timespan -> string;
................................................................................
fmt = bad_dim;
equiv = bad_dim;
};
};
]
let usage (o: outfmt) 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
(o.ansi fmt (o.hl name)) ^
(o.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 = (o.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 = " ["^(o.ul "options")^"] " in
let param x = (if in_opt_list o.options NoANSI then "<"^x^">"
else (o.hl (o.ul x))) in
let syntax = [
(param "calendar") ^ " [year "^(param "year")^"] [day "^(param "day")^"] to "^(param "calendar"),
"convert a calendar date";
(param "number") ^" "^ (param "calendar") ^ " (days | years ["^(param "days")^" days]) to "^(param "calendar"),
"convert a span of time";
(param "calendar")^" ticks "^(param "years")^" years "^(param "days")^" days",
"count temporal ticks corresponding to a timespan";
(param "calendar")^" epoch "^(param "year")^" day "^(param "day"),
"get the Spirals epoch for a particular date";
"epoch "^(param "number")^" to "^(param "calendar"),
"convert a Spirals epoch "^(param "number")^" to a calendar date";
(param "number")^" ticks to "^(param "calendar"),
"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 ^ (o.ansi "34" s) ^"\n" ^
spacing ^ ((o.ansi "95" (o.italic (" "^o.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";
"m","mono", "emit monochrome output";
"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^" "^(o.ansi "94" ("(--"^l^")"))^": "^(o.ansi "95" d)^"\n" in
let spaceopt s = opt_spacing ^ (mkopt s) in
let fst_opt = (o.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 = (o.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
................................................................................
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, time)
let rec parse (opts: runopt list) (args: string list) (bin: string) = let
has_opt = in_opt_list opts in
let switch o a b = if has_opt o then a else b in
let o = {
options = opts;
ansi = (fun fmt str -> if has_opt NoANSI || has_opt NoColor then str else
("\x1b["^fmt^"m"^str^"\x1b[m"));
italic = (fun txt -> switch NoANSI txt
("\x1b[3m" ^ txt ^ "\x1b[23m"));
ul = (fun txt -> switch NoANSI txt
("\x1b[4m" ^ txt ^ "\x1b[24m"));
hl = (fun txt -> switch NoANSI txt
("\x1b[1m" ^ txt ^ "\x1b[21m"));
arrow = (switch ASCII "->" "→");
} in
let dbg msg : unit = (if has_opt Debug then print_string
(o.ansi "35" (o.italic ((o. hl " -- ") ^ msg)) ^ "\n") else ()) in
let op msg o = dbg msg; o in
let res_fmt (inf,ind,outf,outd,_) =
(switch OutOnly "" ((o.ansi inf ind) ^" "^ o.arrow ^" "))^ (o.ansi outf (o.hl outd)) in
let epoch (_,_,_,_,time) = time in
match args with
| opt :: rst when is_opt opt -> let o = opt_of_str opt in
(op ("saw flag " ^opt^ ", adding to option set and restarting parse")
parse (o :: opts) rst bin)
................................................................................
(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 o bin);;
let () = print_string (match (Array.to_list Sys.argv) with
| bin :: rst -> parse [] rst bin
| _ -> "buddy ya fucked up BAD");;
|