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