Overview
Comment: | more updates |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
4f647d4981544b04883c94f076820825 |
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");;