Differences From
Artifact [6ac01952d6]:
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");;