util  Check-in [4f647d4981]

Overview
Comment:more updates
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 4f647d4981544b04883c94f07682082599877ab1931cbf7e0ccbb3b0fcb834ea
User & Date: lexi on 2019-07-13 09:01:57
Other Links: manifest | tags
Context
2019-07-13
09:05
PUTTING COMPUTER AWAY check-in: 95bd59918c user: lexi tags: trunk
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
Changes

Modified rosshil.ml from [6ac01952d6] to [f964acde37].

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