util  Check-in [ff13f110ee]

/* [ʞ] compose.c
 *  ~ lexi hale <lexi@hale.su>
 *  © affero general public license v3
 *  $ cc -c compose.c
 *  # include <string.h>
 *
 * compose.c contains some useful string utilities
 * that libc lacks.

   TODO add macro to use homebrew strlen instead of
        dragging in <string.h> */

#ifdef k_header // only emit the declarations
#	define fn(x)
#else
#	define fn(x) x
#endif

#include <string.h>

typedef struct pstr { size_t len; union {
	const char* ptr;
	char* mutptr;
}; } pstr;
#define _p(str) { sizeof str - 1, str }

typedef struct safestr {
	union {
		const char* ptr;
		char* mutptr;
	}; // im sorry okay
	bool heap;
	size_t len;
} safestr;

void delstr(safestr s) fn ({
	if (s.heap) { free(s.mutptr); }
});

void clrstr(safestr* s) fn ({
	delstr(*s);
	s->heap = false;
	s->ptr = NULL;
	s->len = 0;
})

char* compose(pstr* lst,size_t ct, size_t* strsz) fn({
	size_t len = 0;
	for (size_t i = 0; i < ct; ++i) {
		if (lst[i].len == 0) {
			if (lst[i].ptr == NULL) continue;
			lst[i].len = strlen(lst[i].ptr);
		}
		len += lst[i].len;
	}
	if (strsz != NULL) *strsz = len;
	if (len == 0) return NULL;
	
	char* str = malloc(len + 1);
	char* ptr = str;
	for (size_t i = 0; i < ct; ++i) {
		if (lst[i].len == 0) continue;
		strncpy(ptr,lst[i].ptr,lst[i].len);
		ptr += lst[i].len;
	}
	*ptr = 0;
	return str;
});

// a simple C debug mechanism
#define _itoa(x) _str(x)
#define _str(x) #x
#define _ul(n,s,l,r) "\e[3"#n"m"l"\e[9"#n";4m" s "\e[;3"#n"m"r"\e[m"
#define _hl(n,s,l,r) "\e[3"#n"m"l"\e[9"#n"m" s "\e[;3"#n"m"r"\e[m"
#define _hlstr _ul(5,"%s","“","”")
#define _hlpath _ul(4,"%s","“","”")
#define _hlvar(v) _hl(2,v,"$","")

#if defined(_debug) || defined(_live_debug)
#	include <stdio.h>
#	define _var_pos "\e[34mat \e[94;4m" __FILE__ "#" _itoa(__LINE__) "\e[;34m:\e[m " 
#	ifdef _live_debug
#		define say(fmt,...) (debug ? fprintf(stderr, \
			_var_pos fmt "\n", __VA_ARGS__) : 0)
#	else
#		define say(fmt,...) fprintf(stderr, \
			_var_pos fmt "\n", __VA_ARGS__)
#	endif
#	define _var_expr(name,code,prefix,suffix) _var_pos "\e[1m" name "\e[m \e[35m= \e[35m" \
		prefix "\e[95;4m" "%" #code "\e[24;35m" suffix "\e[m\n"
#	define var(v) fprintf(stderr, _Generic ((v),      \
			char*         : _var_expr(#v,s,"“","”"),     \
			const char*   : _var_expr(#v,s,"",""),     \
			char          : _var_expr(#v,c,"‘","’"),      \
			signed   char : _var_expr(#v,hhi,"","i"),     \
			unsigned char : _var_expr(#v,hhu,"","u"),     \
			signed   short: _var_expr(#v,hi,"","I"),      \
			unsigned short: _var_expr(#v,hu,"","U"),      \
			signed   int  : _var_expr(#v,i,"","I"),       \
			unsigned int  : _var_expr(#v,u,"","U"),       \
			signed   long : _var_expr(#v,li,"","L"),      \
			unsigned long : _var_expr(#v,lu,"","UL"),      \
			signed   long long : _var_expr(#v,lli,"","LL"),\
			unsigned long long : _var_expr(#v,llu,"","ULL"),\
			default       : _var_expr(#v,p,"[","]")), v)
#else
#	define say(...) 
#	define var(v)
#endif

/* [ʞ] findconf.c
 *  ~ lexi hale <lexi@hale.su>
 *  $ cc -c findconf.c
 *	© GNU AGPL v3
 *	# include <stdlib.h>
 *	  include "compose.c"
 */

#include <stdlib.h>
#define sz(x) (sizeof x / sizeof x[0])

#define _k_conf(name,s) findconf((name ".cf"), ("ʞ_" name "_conf"), (s))
bool findconf(char* filename,char* env,safestr* s) {
	say("attempting to locate config file",0);
	var(filename);

	if (filename != NULL) {
		char* conf = getenv(env);
		if (conf != NULL) {
			say("config file specified by " _hlvar("%s") ": " _hlpath, env, conf);
			s->heap=false; s->ptr = conf;
			s->len=strlen(conf); return true;
		} else {
			say("no config file specified by " _hlvar("%s") ", constructing XDG path",env);
		}
	}

	char* xdg, *home, *path = NULL;
	size_t len;
	if (xdg  = getenv("XDG_CONFIG_HOME")) {
		say("config dir " _hlpath " specified by " _hlvar("XDG_CONFIG_HOME"), xdg);
		pstr xdg_path[] = { {0, xdg}, _p("/"), {0, filename} } ;
		path = compose(xdg_path, sz(xdg_path), &(s->len));
	} else if (home = getenv("HOME")) {
		say(_hlvar("XDG_CONFIG_HOME") " undefined, constructing default from " _hlvar("HOME"),home);
		var(home);
		pstr home_path[] = { {0, home}, _p("/.config/"), {0, filename} };
		path = compose(home_path, sz(home_path), &(s->len));
	} else {
		say("no " _hlvar("HOME") " variable, assuming /home/$USER",0);
		char* user = getenv("USER");
		if (user == NULL) { /* uh oh */ user = getlogin();
			say("no " _hlvar("USER") " variable, but " _hl(3, "getlogin","","()") " reports %s",user); }
		if (user != NULL) {
			pstr user_path[] = { _p("/home/"), {0, user}, _p("/.config/"), {0, filename} };
			path = compose(user_path, sz(user_path), &(s->len));
		} else {
			// UH OH
			say("no " _hlvar("USER") " and " _hl(3, "getlogin","","()") " did not return a sane value - bailing the fuck out",0);
			return false;
		}
	}

	var(path);
	if (path) {
		s->ptr = path;
		s->heap = true;
		return true;
	} else return false;
}
#undef sz

(* [ʞ] 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   };

type timeunit = {
	name   : string;
	expr   : timespan -> string;
	span   : timespan;
}

let span (start: timepoint) (stop: timepoint) : timespan = stop - start
	(* because im a dyscalculic idiot *)

type epoch = {
	(* an epoch delineates discrete eras in a calendar system,
	 * such as which empress is reigning *)
	title : name;
	start : timepoint;
}
let inepoch (e: epoch) (date: timepoint) = date > e.start

type era = {
	(* an era is a period of time that may be attached to
	 * galactic history or to a single calendar *)
	title : name;
	start : timepoint;
	stop  : timepoint;
}
let eraspan (e: era) : timespan = span e.start e.stop

let history : era list = [] (* in DESCENDING order!! *)
let galacticzero : timepoint = 0

type date = { years : quantity; days : quantity }

let strify = string_of_int

exception Bad_dimension
let bad_dim _ = raise Bad_dimension

module Gregorian = struct
	module Span = struct
		let sec  : timespan =   1
		let min  : timespan =  60 * sec
		let hour : timespan =  60 * min
		let day  : timespan =  24 * hour
		let days : quantity = 365
		let year : timespan = days * day

		let equiv (d: date): timespan =
			(year * d.years) + (day * d.days)

		let day_equiv calendar_days earth_equiv = int_of_float
			(float day *. (float earth_equiv /. float calendar_days))

		let calc (span: timespan) : date =
			let ctdays = span / day in
			let ctyears = ctdays / days in
			let rem = ctdays mod days in
				{ years = ctyears; days = rem; }

		let fmt (d: date) : string = (
			(strify d.years) ^ " Gregorian years and " ^
			(strify d.days) ^ " days"
		)
	end
end

module Society = struct
	module Span = struct
		let days = 256
		let earth_days_in_year = 414
		let day = Gregorian.Span.day_equiv days earth_days_in_year
		let rantis = day / 64
		let year = day * days

		let equiv (d: date): timespan =
			(year * d.years) + (day * d.days)

		let calc (span: timespan) : date =
			let ctdays = span / day in
			let ctyears = ctdays / days in
			let rem = ctdays mod days in
				{years = ctyears; days = rem}

		let fmt (d : date) : string =
			("Sh." ^ (strify d.years) ^ "/" ^ (strify d.days))
	end

	module Cal = struct
		let zero = galacticzero + (0 * Span.year)

		let equiv (d: date): timepoint =
			zero + (Span.year * d.years) + (Span.day * d.days)

		let calc (pt: timepoint) : date =
			let adj = pt - zero in
			let span = Span.calc adj in
				{years = span.years; days = span.days; }

		let fmt (d: date) : string =
			("R" ^ (strify d.years) ^ "/" ^ (strify d.days))
	end
end

module Empire = struct
	module Span = struct
		let days = 376
		let earth_days_in_year = 394
		let day = Gregorian.Span.day_equiv days earth_days_in_year
		let year = day * days

		let equiv (d: date): timespan =
			(year * d.years) + (day * d.days)

		let calc (span: timespan) : date =
			let ctdays = span / day in
			let ctyears = ctdays / days in
			let rem = ctdays mod days in
				{years = ctyears; days = rem}

		let fmt (d : date) : string =
			((strify d.years)^" Old Carnelian orbital years, "^(strify d.days)^" days")
	end

	module Cal = struct
		let zero = Society.Cal.zero + (524 * Span.year)

		let equiv (d: date): timepoint =
			zero + (Span.year * d.years) + (Span.day * d.days)

		let calc (pt: timepoint) : date =
			let adj = pt - zero in
			let span = Span.calc adj in
				{years = span.years; days = span.days; }

		let fmt (d: date) : string =
			((strify d.years)^"ᵉ and "^(strify d.days)^" days")
	end
end

module League = struct
	module Span = struct
		let days = 300
		let earth_days_in_year = 388
		let day = Gregorian.Span.day_equiv days earth_days_in_year
		let year = day * days

		let equiv (d: date): timespan =
			(year * d.years) + (day * d.days)

		let calc (span: timespan) : date =
			let ctdays = span / day in
			let ctyears = ctdays / days in
			let rem = ctdays mod days in
				{years = ctyears; days = rem}

		let fmt (d : date) : string =
			((strify d.years)^" Topaz orbital years, "^(strify d.days)^" days")
	end

	module Cal = struct
		let zero = Society.Cal.zero + (928 * Society.Span.year)

		let equiv (d: date): timepoint =
			zero + (Span.year * d.years) + (Span.day * d.days)

		let calc (pt: timepoint) : date =
			let adj = pt - zero in
			let span = Span.calc adj in
				{years = span.years; days = span.days; }

		let fmt (d: date) : string =
			("L."^(strify d.years)^"."^(strify d.days))
	end
end

(*
let test () = let time : timepoint = Empire.Cal.equiv {years=953; days=38} in
	let span : timespan = time - galacticzero in
	List.iter print_string [
		"\x1b[1m"^ Gregorian.Span.(fmt(calc time)) ^" from Creation\x1b[0m\n";
		Society.Span.(fmt(calc span)) ^" from Creation →\n\t";
		Society.Cal.(fmt(calc time)) ^"\n";
		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 = {
	names : string list;
	fmt : string;
	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 = {
			(* gregorian dates do not reference the same
			 * spacetime continuum that Spirals dates do,
			 * so any attempt to convert between calendars
			 * 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

type convkind = Calendar | Timespan

let conv (kind: convkind) tagfrom tagto years days =
	let choosefuncs system = match kind with
		| Calendar -> system.cal
		| Timespan -> system.span in
	let from_funcs = getfuncs tagfrom in
	let to_funcs = getfuncs tagto in
	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");;

	size_t nsz;
	const char* basename = argv[0], *p;
	for (p = argv[0]; *p!=0; ++p) {
		if(*p == '/') basename = p + 1;
	}
	nsz = p - basename;
	char shid[nsz + sizeof shmem_prefix + 0];
	strncpy(shid,shmem_prefix,sizeof shmem_prefix);
	strncpy(shid + sizeof shmem_prefix - 1, basename, nsz);


	if (op == mode_go) {
		int fd;
		if ((fd = shm_open(shid, O_RDWR, 0600)) == -1) {
			const char* args[] = {
				"urxvtc", "-bg", "[90]#4b0024",
				          "-e",  argv[0],

	size_t nsz;
	const char* basename = argv[0], *p;
	for (p = argv[0]; *p!=0; ++p) {
		if(*p == '/') basename = p + 1;
	}
	nsz = p - basename;
	char shid[nsz + sizeof shmem_prefix];
	strncpy(shid,shmem_prefix,sizeof shmem_prefix);
	strncpy(shid + sizeof shmem_prefix - 1, basename, nsz);
	shid[nsz + sizeof shmem_prefix - 1] = 0;

	if (op == mode_go) {
		int fd;
		if ((fd = shm_open(shid, O_RDWR, 0600)) == -1) {
			const char* args[] = {
				"urxvtc", "-bg", "[90]#4b0024",
				          "-e",  argv[0],