util  Check-in [384965fe63]

Overview
Comment:add another hundred lines or so two rosshil. im done this time i swear
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 384965fe63a1bf06428d931f09c7af722b413139ccd32505c6da3d639c85a35b
User & Date: lexi on 2019-07-13 08:22:44
Other Links: manifest | tags
Context
2019-07-13
09:01
more updates check-in: 4f647d4981 user: lexi tags: trunk
08:22
add another hundred lines or so two rosshil. im done this time i swear check-in: 384965fe63 user: lexi tags: trunk
07:07
add rosshil, misc updates check-in: ff13f110ee user: lexi tags: trunk
Changes

Modified rosshil.ml from [1155e40476] to [6ac01952d6].

1
2
3
4






5
6
7
8
9
10
11
12
13
14

15


16






17
18
19
20
21
22
23
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
297
298
299
300
301
302
303


























































304
305
306
307
308
309
310
...
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
(* [ʞ] 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   };
................................................................................
		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 = {
................................................................................
	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 = {
................................................................................
			 * 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

................................................................................
	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");;



|
>
>
>
>
>
>








|

>
|
>
>
|
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|













|













|













|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|










>
>
>
>

|
<
>
>



|
|
<
>
|
<







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








|




1
2
3
4
5
6
7
8
9
10
11
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
...
220
221
222
223
224
225
226
















227
228
229
230
231
232
233
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
...
296
297
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
365
366
367
...
376
377
378
379
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
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
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
(* [ʞ] rosshil.ml - tasshila semes sirvos
 *  ~ lexi hale <lexi@hale.su>
 *  $ ocamlopt.opt rosshil.ml -o rosshil
 *  © 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 | 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   };
................................................................................
		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";
	]
*)

















type funcset = {
	calc : int -> date;
	fmt : date -> string;
	equiv : date -> int;
}

type funcrow = {
................................................................................
	span : funcset;
	cal : funcset;
}


let funcs : funcrow list = [
	(* Society *) {
        names=["Society of Worlds"; "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=["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;
		};
		cal = {
			calc   =Empire.Cal.calc;
			fmt    =Empire.Cal.fmt;
			equiv  =Empire.Cal.equiv;
		};
	};
	(* League *) {
        names=["Socialist League"; "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 calendar"; "gregorian"; "terrestrial"; "earth"; "gy"; "ce";];
		fmt="95";
		span = {
			calc  = Gregorian.Span.calc;
			fmt   = Gregorian.Span.fmt;
			equiv = Gregorian.Span.equiv;
		};
		cal = {
................................................................................
			 * needs to raise an exception *)
			calc  = bad_dim;
			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)
	(* from array *) funcs

................................................................................
	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, 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)


    (* 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 arrow ansi hl bin);;

let () = print_string (match (Array.to_list Sys.argv) with
	| bin :: rst -> parse [] rst bin
	| _ -> "buddy ya fucked up BAD");;