20060303a

1 files changed, 511 insertions, 0 deletions

diff --git a/appl/wm/keyboard.b b/appl/wm/keyboard.b
new file mode 100644
index 00000000..7e257826
--- /dev/null
+++ b/appl/wm/keyboard.b
@@ -0,0 +1,511 @@
+implement Keybd;
+
+#
+# extensive revision of code originally by N. W. Knauft
+#
+# Copyright © 1997 Lucent Technologies Inc.  All rights reserved.
+# Revisions Copyright © 1998 Vita Nuova Limited.  All rights reserved.
+# Rewritten code Copyright © 2001 Vita Nuova Holdings Limited.  All rights reserved.
+#
+# To do:
+#	input from file
+#	calculate size
+
+include "sys.m";
+        sys: Sys;
+
+include "draw.m";
+        draw: Draw;
+	Rect, Point: import draw;
+
+include "tk.m";
+        tk: Tk;
+
+include "tkclient.m";
+        tkclient: Tkclient;
+
+include "arg.m";
+
+include "keyboard.m";
+
+Keybd: module
+{
+	init:	fn(nil: ref Draw->Context, nil: list of string);
+};
+
+FONT: con "/fonts/lucidasans/boldlatin1.6.font";
+SPECFONT: con "/fonts/lucidasans/unicode.6.font";
+
+# size in pixels
+#KEYSIZE: con 16;
+KEYSIZE: con 13;
+KEYSPACE: con 2;
+KEYBORDER: con 1;
+KEYGAP: con KEYSPACE - (2 * KEYBORDER);
+#ENDGAP: con 2 - KEYBORDER;
+ENDGAP: con 0;
+
+Key: adt {
+	name: string;
+	val:	int;
+	size:	int;
+	x:	list of int;
+	on:	int;
+};
+
+background: con "#dddddd";
+
+Backspace, Tab, Backslash, CapsLock, Return, Shift, Ctrl, Esc, Alt, Space: con iota;
+
+specials := array[] of {
+Backspace =>		Key("<-", '\b', 28, nil, 0),
+Tab =>			Key("Tab", '\t', 26, nil, 0),
+Backslash =>		Key("\\\\", '\\', KEYSIZE, nil, 0),
+CapsLock =>		Key("Caps", Keyboard->Caps, 40, nil, 0),
+Return =>			Key("Enter", '\n', 36, nil, 0),
+Shift =>			Key("Shift", Keyboard->LShift, 45, nil, 0),
+Esc =>			Key("Esc", 8r33, 21, nil, 0),
+Ctrl =>			Key("Ctrl", Keyboard->LCtrl, 36, nil, 0),
+Alt =>			Key("Alt", Keyboard->LAlt, 22, nil, 0),
+Space =>			Key(" ", ' ', 140, nil, 0),
+Space+1 =>		Key("Return", '\n', 36, nil, 0),
+};
+
+keys:= array[] of {
+	# unshifted
+	array[] of {
+		"Esc", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "=", "\\\\", "`", nil,
+		"Tab", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "<-", nil,
+		"Ctrl", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "Enter", nil,
+		"Shift", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "Shift", nil,
+		"Caps", "Alt", " ", "Alt", nil,
+	},
+
+	# shifted
+	array[] of {
+		"Esc", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "|", "~", nil,
+		"Tab", "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "\\{", "\\}", "<-", nil,
+		"Ctrl", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", "\"", "Return", nil,
+		"Shift", "Z", "X", "C", "V", "B", "N", "M", "<", ">", "?", "Shift", nil,
+		"Caps", "Alt", " ", "Alt", nil,
+	},
+};
+
+keyvals: array of array of int;
+noexit := 0;
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+	sys = load Sys Sys->PATH;
+	if (ctxt == nil) {
+		sys->fprint(sys->fildes(2), "keyboard: no window context\n");
+		raise "fail:bad context";
+	}
+	draw = load Draw Draw->PATH;
+	tk = load Tk Tk->PATH;
+	tkclient = load Tkclient Tkclient->PATH;
+	arg := load Arg Arg->PATH;
+
+	taskbar := 0;
+	winopts := Tkclient->Hide;
+	arg->init(args);
+	while ((opt := arg->opt()) != 0) {
+		case opt {
+		't' =>
+			taskbar = 1;
+		'e' =>
+			noexit = 1;
+			winopts = 0;
+		* =>
+			sys->fprint(sys->fildes(2), "usage: keyboard [-et]\n");
+			raise "fail:usage";
+		}
+	}
+
+	sys->pctl(Sys->NEWPGRP, nil);
+	tkclient->init();
+
+	keyvals = array[] of {
+		array[len keys[0]] of int,
+		array[len keys[1]] of int,
+	};
+	setindex(keys[0], keyvals[0], specials);
+	setindex(keys[1], keyvals[1], specials);
+
+
+	(t, wcmd) := tkclient->toplevel(ctxt, "", "Kbd", winopts);
+	cmd(t, ". configure -bd 0 -relief flat");
+
+	for(i := 0; i < len keys[0]; i++)
+		if(keys[0][i] != nil)
+			cmd(t, sys->sprint("button .b%d -takefocus 0 -font %s -width %d -height %d -bd %d -activebackground %s -text {%s} -command 'send keypress %d",
+				i, FONT, KEYSIZE, KEYSIZE, KEYBORDER, background, keys[0][i], keyvals[0][i]));
+
+	for(i = 0; i < len specials; i++) {
+		k := specials[i];
+		for(xl := k.x; xl != nil; xl = tl xl)
+			cmd(t, sys->sprint(".b%d configure -font %s -width %d", hd xl, SPECFONT, k.size));
+	}
+
+	# pack buttons in rows
+	i = 0;
+	for(j:=0; i < len keys[0]; j++){
+		rowf := sys->sprint(".f%d", j);
+		cmd(t, "frame "+rowf);
+		cmd(t, sys->sprint("frame .pad%d -height %d", j, KEYGAP));
+		if(ENDGAP){
+			cmd(t, rowf + ".pad -width " + string ENDGAP);
+			cmd(t, "pack " + rowf + ".pad -side left");
+		}
+		for(; keys[0][i] != nil; i++){
+			label := keys[0][i];
+			expand := label != "\\\\" && len label > 1;
+			cmd(t, "pack .b" + string i + " -in "+ rowf + " -side left -fill x -expand "+string expand);
+			if(keys[0][i+1] != nil && KEYGAP > 0){
+				padf := sys->sprint("%s.pad%d", rowf, i);
+				cmd(t, "frame " + padf + " -width " + string KEYGAP);
+				cmd(t, "pack " + padf + " -side left");
+			}
+		}
+		if(ENDGAP){
+			padf := sys->sprint("%s.pad%d", rowf, i);
+			cmd(t, "frame " + padf + " -width " + string ENDGAP);
+			cmd(t, "pack " + padf + " -side left");
+		}
+		i++;
+	}
+	nrow := j;
+
+	# pack rows in frame
+	for(j = 0; j < nrow; j++)
+		cmd(t, sys->sprint("pack .f%d .pad%d -fill x -in .", j, j));
+
+	(w, h) := (int cmd(t, ". cget -width"), int cmd(t, ". cget -height"));
+	r := t.screenr;
+	off := (r.dx()-w)/2;
+	cmd(t, sys->sprint(". configure -x %d -y %d", r.min.x+off, r.max.y-h));
+	tkclient->onscreen(t, nil);
+	tkclient->startinput(t, "ptr" :: nil);
+
+	spawn handle_keyclicks(t, wcmd, taskbar);
+}
+
+setindex(keys: array of string, keyvals: array of int, spec: array of Key)
+{
+	for(i := 0; i < len keys; i++){
+		if(keys[i] == nil)
+			continue;
+		val := keys[i][0];
+		if(len keys[i] > 1 && val == '\\')
+			val = keys[i][1];
+		for(j := 0; j < len spec; j++)
+			if(spec[j].name == keys[i]){
+				if(!inlist(i, spec[j].x))
+					spec[j].x = i :: spec[j].x;
+				val = spec[j].val;
+				break;
+			}
+		keyvals[i] = val;
+	}
+}
+
+inlist(i: int, l: list of int): int
+{
+	for(; l != nil; l = tl l)
+		if(hd l == i)
+			return 1;
+	return 0;
+}
+
+handle_keyclicks(t: ref Tk->Toplevel, wcmd: chan of string, taskbar: int)
+{
+	keypress := chan of string;
+	tk->namechan(t, keypress, "keypress");
+
+	if(taskbar)
+		tkclient->wmctl(t, "task");
+
+	cmd(t,"update");
+
+	collecting := 0;
+	collected := "";
+	for(;;)alt {
+	k := <-keypress =>
+		c := int k;
+		case c {
+		Keyboard->Caps =>
+			active(t, Ctrl, 0);
+			active(t, Shift, 0);
+			active(t, Alt, 0);
+			active(t, CapsLock, -1);
+			redraw(t);
+		Keyboard->LShift =>
+			active(t, Shift, -1);
+			redraw(t);
+		Keyboard->LCtrl =>
+			active(t, Alt, 0);
+			active(t, Ctrl, -1);
+			active(t, Shift, 0);
+			redraw(t);
+		Keyboard->LAlt =>
+			active(t, Alt, -1);
+			active(t, Ctrl, 0);
+			active(t, Shift, 0);
+			redraw(t);
+			if(specials[Alt].on){
+				collecting = 1;
+				collected = "";
+			}else
+				collecting = 0;
+		* =>
+			if(collecting){
+				collected[len collected] = c;
+				c = latin1(collected);
+				if(c < -1)
+					continue;
+				collecting = 0;
+				if(c == -1){
+					for(i := 0; i < len collected; i++)
+						sendkey(t, collected[i]);
+					continue;
+				}
+			}
+			show := specials[Ctrl].on | specials[Alt].on | specials[Shift].on;
+			if(specials[Ctrl].on)
+				c &= 16r1F;
+			active(t, Ctrl, 0);
+			active(t, Alt, 0);
+			active(t, Shift, 0);
+			if(show)
+				redraw(t);
+			sendkey(t, c);
+		}
+	m := <-t.ctxt.ptr =>
+		tk->pointer(t, *m);
+	s := <-t.ctxt.ctl or
+	s = <-t.wreq or
+	s = <-wcmd =>
+		if (s == "exit" && noexit)
+			s = "task";
+		tkclient->wmctl(t, s);
+	}
+}
+
+sendkey(t: ref Tk->Toplevel, c: int)
+{
+	sys->fprint(t.ctxt.connfd, "key %d", c);
+}
+
+active(t: ref Tk->Toplevel, keyno: int, on: int)
+{
+	key := specials[keyno:];
+	if(on < 0)
+		key[0].on ^= 1;
+	else
+		key[0].on = on;
+	for(xl := key[0].x; xl != nil; xl = tl xl){
+		col := background;
+		if(key[0].on)
+			col = "white";
+		cmd(t, ".b"+string hd xl+" configure -bg "+col+ " -activebackground "+col);
+	}
+}
+
+redraw(t: ref Tk->Toplevel)
+{
+	shifted := specials[Shift].on;
+	bank := keys[shifted];
+	vals := keyvals[shifted];
+	for(i:=0; i<len bank; i++) {
+		key := bank[i];
+		val := vals[i];
+		if(key != nil){
+			if(specials[CapsLock].on && len key == 1){
+				if(key[0]>='A' && key[0]<='Z')	# true if also shifted
+					key[0] += 'a'-'A';
+				else if(key[0] >= 'a' && key[0]<='z')
+					key[0] += 'A'-'a';
+				val = key[0];
+			}
+			cmd(t, ".b" + string i + " configure -text {" + key + "} -command 'send keypress " + string val);
+		}
+  	}
+	cmd(t, "update");
+}
+
+#
+# The code makes two assumptions: strlen(ld) is 1 or 2; latintab[i].ld can be a
+# prefix of latintab[j].ld only when j<i.
+#
+Cvlist: adt
+{
+	ld:	string;	# must be seen before using this conversion
+	si:	string;	#  options for last input characters
+	so:	string;	# the corresponding Rune for each si entry
+};
+latintab: array of Cvlist = array[] of {
+	(" ", " i",	"␣ı"),
+	("!~", "-=~",	"≄≇≉"),
+	("!", "!<=>?bmp",	"¡≮≠≯‽⊄∉⊅"),
+	("\"*", "IUiu",	"ΪΫϊϋ"),
+	("\"", "\"AEIOUYaeiouy",	"¨ÄËÏÖÜŸäëïöüÿ"),
+	("$*", "fhk",	"ϕϑϰ"),
+	("$", "BEFHILMRVaefglopv",	"ℬℰℱℋℐℒℳℛƲɑℯƒℊℓℴ℘ʋ"),
+	("\'\"", "Uu",	"Ǘǘ"),
+	("\'", "\'ACEILNORSUYZacegilnorsuyz",	"´ÁĆÉÍĹŃÓŔŚÚÝŹáćéģíĺńóŕśúýź"),
+	("*", "*ABCDEFGHIKLMNOPQRSTUWXYZabcdefghiklmnopqrstuwxyz",	"∗ΑΒΞΔΕΦΓΘΙΚΛΜΝΟΠΨΡΣΤΥΩΧΗΖαβξδεφγθικλμνοπψρστυωχηζ"),
+	("+", "-O",	"±⊕"),
+	(",", ",ACEGIKLNORSTUacegiklnorstu",	"¸ĄÇĘĢĮĶĻŅǪŖŞŢŲąçęģįķļņǫŗşţų"),
+	("-*", "l",	"ƛ"),
+	("-", "+-2:>DGHILOTZbdghiltuz~",	"∓­ƻ÷→ÐǤĦƗŁ⊖ŦƵƀðǥℏɨłŧʉƶ≂"),
+	(".", ".CEGILOZceglz",	"·ĊĖĠİĿ⊙Żċėġŀż"),
+	("/", "Oo",	"Øø"),
+	("1", "234568",	"½⅓¼⅕⅙⅛"),
+	("2", "-35",	"ƻ⅔⅖"),
+	("3", "458",	"¾⅗⅜"),
+	("4", "5",	"⅘"),
+	("5", "68",	"⅚⅝"),
+	("7", "8",	"⅞"),
+	(":", ")-=",	"☺÷≔"),
+	("<!", "=~",	"≨⋦"),
+	("<", "-<=>~",	"←«≤≶≲"),
+	("=", ":<=>OV",	"≕⋜≡⋝⊜⇒"),
+	(">!", "=~",	"≩⋧"),
+	(">", "<=>~",	"≷≥»≳"),
+	("?", "!?",	"‽¿"),
+	("@\'", "\'",	"ъ"),
+	("@@", "\'EKSTYZekstyz",	"ьЕКСТЫЗекстыз"),
+	("@C", "Hh",	"ЧЧ"),
+	("@E", "Hh",	"ЭЭ"),
+	("@K", "Hh",	"ХХ"),
+	("@S", "CHch",	"ЩШЩШ"),
+	("@T", "Ss",	"ЦЦ"),
+	("@Y", "AEOUaeou",	"ЯЕЁЮЯЕЁЮ"),
+	("@Z", "Hh",	"ЖЖ"),
+	("@c", "h",	"ч"),
+	("@e", "h",	"э"),
+	("@k", "h",	"х"),
+	("@s", "ch",	"щш"),
+	("@t", "s",	"ц"),
+	("@y", "aeou",	"яеёю"),
+	("@z", "h",	"ж"),
+	("@", "ABDFGIJLMNOPRUVXabdfgijlmnopruvx",	"АБДФГИЙЛМНОПРУВХабдфгийлмнопрувх"),
+	("A", "E",	"Æ"),
+	("C", "ACU",	"⋂ℂ⋃"),
+	("Dv", "Zz",	"DŽDž"),
+	("D", "-e",	"Ð∆"),
+	("G", "-",	"Ǥ"),
+	("H", "-H",	"Ħℍ"),
+	("I", "-J",	"ƗIJ"),
+	("L", "&-Jj|",	"⋀ŁLJLj⋁"),
+	("N", "JNj",	"NJℕNj"),
+	("O", "*+-./=EIcoprx",	"⊛⊕⊖⊙⊘⊜ŒƢ©⊚℗®⊗"),
+	("P", "P",	"ℙ"),
+	("Q", "Q",	"ℚ"),
+	("R", "R",	"ℝ"),
+	("S", "123S",	"¹²³§"),
+	("T", "-u",	"Ŧ⊨"),
+	("V", "=",	"⇐"),
+	("Y", "R",	"Ʀ"),
+	("Z", "-ACSZ",	"Ƶℤ"),
+	("^", "ACEGHIJOSUWYaceghijosuwy",	"ÂĈÊĜĤÎĴÔŜÛŴŶâĉêĝĥîĵôŝûŵŷ"),
+	("_\"", "AUau",	"ǞǕǟǖ"),
+	("_,", "Oo",	"Ǭǭ"),
+	("_.", "Aa",	"Ǡǡ"),
+	("_", "AEIOU_aeiou",	"ĀĒĪŌŪ¯āēīōū"),
+	("`\"", "Uu",	"Ǜǜ"),
+	("`", "AEIOUaeiou",	"ÀÈÌÒÙàèìòù"),
+	("a", "ben",	"↔æ∠"),
+	("b", "()+-0123456789=bknpqru",	"₍₎₊₋₀₁₂₃₄₅₆₇₈₉₌♝♚♞♟♛♜•"),
+	("c", "$Oagu",	"¢©∩≅∪"),
+	("dv", "z",	"dž"),
+	("d", "-adegz",	"ð↓‡°†ʣ"),
+	("e", "$lmns",	"€⋯—–∅"),
+	("f", "a",	"∀"),
+	("g", "$-r",	"¤ǥ∇"),
+	("h", "-v",	"ℏƕ"),
+	("i", "-bfjps",	"ɨ⊆∞ij⊇∫"),
+	("l", "\"$&\'-jz|",	"“£∧‘łlj⋄∨"),
+	("m", "iou",	"µ∈×"),
+	("n", "jo",	"nj¬"),
+	("o", "AOUaeiu",	"Å⊚Ůåœƣů"),
+	("p", "Odgrt",	"℗∂¶∏∝"),
+	("r", "\"\'O",	"”’®"),
+	("s", "()+-0123456789=abnoprstu",	"⁽⁾⁺⁻⁰ⁱ⁲⁳⁴⁵⁶⁷⁸⁹⁼ª⊂ⁿº⊃√ß∍∑"),
+	("t", "-efmsu",	"ŧ∃∴™ς⊢"),
+	("u", "-AEGIOUaegiou",	"ʉĂĔĞĬŎŬ↑ĕğĭŏŭ"),
+	("v\"", "Uu",	"Ǚǚ"),
+	("v", "ACDEGIKLNORSTUZacdegijklnorstuz",	"ǍČĎĚǦǏǨĽŇǑŘŠŤǓŽǎčďěǧǐǰǩľňǒřšťǔž"),
+	("w", "bknpqr",	"♗♔♘♙♕♖"),
+	("x", "O",	"⊗"),
+	("y", "$",	"¥"),
+	("z", "-",	"ƶ"),
+	("|", "Pp|",	"Þþ¦"),
+	("~!", "=",	"≆"),
+	("~", "-=AINOUainou~",	"≃≅ÃĨÑÕŨãĩñõũ≈"),
+};
+
+#
+# Given 5 characters k[0]..k[4], find the rune or return -1 for failure.
+#
+unicode(k: string): int
+{
+	c := 0;
+	for(i:=1; i<5; i++){
+		r := k[i];
+		c <<= 4;
+		if('0'<=r && r<='9')
+			c += r-'0';
+		else if('a'<=r && r<='f')
+			c += 10 + r-'a';
+		else if('A'<=r && r<='F')
+			c += 10 + r-'A';
+		else
+			return -1;
+	}
+	return c;
+}
+
+#
+# Given n characters k[0]..k[n-1], find the corresponding rune or return -1 for
+# failure, or something < -1 if n is too small.  In the latter case, the result
+# is minus the required n.
+#
+latin1(k: string): int
+{
+	n := len k;
+	if(k[0] == 'X' || n>1 && k[0] == 'x' && k[1]!='O')	# 'x' to avoid having to Shift as well
+		if(n>=5)
+			return unicode(k);
+		else
+			return -5;
+	for(i := 0; i < len latintab; i++){
+		l := latintab[i];
+		if(k[0] == l.ld[0]){
+			if(n == 1)
+				return -2;
+			c := 0;
+			if(len l.ld == 1)
+				c = k[1];
+			else if(l.ld[1] != k[1])
+				continue;
+			else if(n == 2)
+				return -3;
+			else
+				c = k[2];
+			for(p:=0; p < len l.si; p++)
+				if(l.si[p] == c && p < len l.so)
+					return l.so[p];
+			return -1;
+		}
+	}
+	return -1;
+}
+
+cmd(top: ref Tk->Toplevel, c: string): string
+{
+	e := tk->cmd(top, c);
+	if (e != nil && e[0] == '!')
+		sys->fprint(sys->fildes(2), "keyboard: tk error on '%s': %s\n", c, e);
+	return e;
+}