implement Keybd;

# extensive revision of 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.

include "sys.m";
	sys: Sys;
	sprint: import sys;
include "draw.m";
	draw: Draw;
	Rect, Point: import draw;
include "tk.m";
	tk: Tk;
include "tkclient.m";
	tkclient: Tkclient;
include "arg.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 32;
KEYSPACE: con 2;
KEYBORDER: con 1;
KEYGAP: con KEYSPACE - (2 * KEYBORDER);
#ENDGAP: con 2 - KEYBORDER;
ENDGAP: con 0;

specialtab := array[] of {
	("Tab",	"key 9"),
	("<-",	"key 8"),
	("Ret",	"key 10"),
	("RET",	"key 10"),
	("Enter",	"key 10"),
	("Esc",	"key 27"),
	("Space",	"key 32"),
	("SPACE",	"key 32"),
	("Del",	"key 127"),
	("Shift",	"menu men"),
	("SHIFT",	"menu men"),
	("Upper",	"menu maj"),
	("Lower",	"menu min"),
	("BLICK",	"menu blickmaj"),
	("Blick",	"menu blickmin"),
	("Ctrl",	"menu ctl"),
	("Fig",	"menu fig"),
	("Num",	"menu num"),
};

top: ref Tk->Toplevel;
noexit := 0;

lookup(name: string): string
{
	for(i := 0; i < len specialtab; i++) {
		if(specialtab[i].t0 == name)
			return specialtab[i].t1;
	}
	raise "%SYSTEM-F-EXQUOTA";
}

mkbank(bname, pfx, ch: string, bdef: array of string)
{
	r := 0;
	cmd("frame " + bname);
	for(i := 0; i < len bdef; i++) {
		rname := bname+".r"+string r;
		cmd(sprint("frame %s; pack %s -in %s -fill x -expand 1", rname, rname, bname));
		for(; (s := bdef[i]) != nil; i++) {
			kname := rname+"."+string i;
			p := pfx;
			send := ch + " " + string int s[0];
			if(len s > 1) {
				p = "";
				send = lookup(s);
			}
			cmd(sprint("button %s -text '%s%s", kname, p, s));
			cmd(sprint("%s configure -command 'send %s", kname, send));
			cmd(sprint("%s configure -width %d -height %d", kname, KEYSIZE, KEYSIZE));
			cmd(sprint("pack %s -in %s -fill x -expand 1 -side left", kname, rname));
		}
		r++;
	}
}

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();

	(t, wcmd) := tkclient->toplevel(ctxt, "", "Kbd", winopts);
	top = t;
	cmd(". configure -bd 0 -relief flat");

	mkbank(".min", "", "key", array[] of {
		"1", "2", "3", "4", "5", "6", "7", "8", "9", "0", nil,
		 "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", nil,
		  "a", "s", "d", "f", "g", "h", "j", "k", "l", nil,
		   "z", "x", "c", "v", "b", "n", "m", "<-", nil,
		"Shift", "Space", "Ret", nil,
	} );

	mkbank(".maj", "", "key", array[] of {
		"!", "@", "#", "$", "%", "^", "&", "*", "(", ")", nil,
		 "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", nil,
		  "A", "S", "D", "F", "G", "H", "J", "K", "L", nil,
		   "Z", "X", "C", "V", "B", "N", "M", "<-", nil,
		"SHIFT", "SPACE", "RET", nil,
	} );

	mkbank(".fig", "", "key", array[] of {
		"!", "@", "#", "$", "%", "^", "&", "*", "(", ")", nil,
		"Esc", "`", "~", "-", "_", "=", "+", nil,
		"Tab", "[", "]", "{", "}", "\\", "|", nil,
		"<", ">", ",", ".", "/", "?", "<-", nil,
		"Shift", "Space", "Ret", nil,
	} );

	mkbank(".ctl", "^", "ctrl", array[] of {
		"Esc", "1", "2", "3", "4", ";", "Del", nil,
		 "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", nil,
		  "a", "s", "d", "f", "g", "h", "j", "k", "l", nil,
		   "z", "x", "c", "v", "b", "n", "m", "<-", nil,
		"Shift", "Space", "Ret", nil,
	} );

	mkbank(".num", "", "key", array[] of {
		"Enter", "Shift", "<-", nil,
		"7", "8", "9", "-", "/", nil,
		"4", "5", "6", "+", "*", nil,
		"1", "2", "3", ",", "=", nil,
		"0",  ".", nil,
	} );

	mkbank(".blickmin", "", "key", array[] of {
		 "z", "x", "k", "g", "b", "v", "q", "j", nil,
		  "p", "w", "f", "u", "l", "c", "m", "y", nil,
		"d", "h", "i", "a", "t", "e", "n", "s", "o", "r", "<-", nil,
		"Shift", "Space", "Ret", nil,
	} );

	mkbank(".blickmaj", "", "key", array[] of {
		 "Z", "X", "K", "G", "B", "V", "Q", "J", nil,
		  "P", "W", "F", "U", "L", "C", "M", "Y", nil,
		"D", "H", "I", "A", "T", "E", "N", "S", "O", "R", "<-", nil,
		"SHIFT", "SPACE", "RET", nil,
	} );

	mkbank(".men", "", "key", array[] of {
		"Upper", "BLICK", "Ctrl", "Num", nil,
		"Lower", "Blick", "Fig", nil,
	} );

	(w, h) := (int cmd(". cget -width"), int cmd(". cget -height"));
	r := t.screenr;
	off := (r.dx()-w)/2;
	cmd(sys->sprint(". configure -x %d -y %d", r.min.x+off, r.max.y-h));
	tkclient->onscreen(t, nil);
	tkclient->startinput(t, "ptr" :: nil);

	cmd("frame .fb; pack .fb -in .");
	cmd("pack .min -in .fb");
	cmd("pack propagate . 0");
	spawn handle_keyclicks(t, wcmd, taskbar);
}

handle_keyclicks(t: ref Tk->Toplevel, wcmd: chan of string, taskbar: int)
{
	tk->namechan(t, key := chan of string, "key");
	tk->namechan(t, menu := chan of string, "menu");
	tk->namechan(t, ctrl := chan of string, "ctrl");
	if(taskbar)
		tkclient->wmctl(t, "task");
	cmd("update");

	for(;;) alt {
	m := <-menu	=>
		cmd("pack forget " + cmd("pack slaves .fb"));
		cmd(sprint("pack .%s -in .fb; update", m));
	c := int <-ctrl =>
		sys->fprint(t.ctxt.connfd, "key %d", c&31);
	c := int <-key	=>
		sys->fprint(t.ctxt.connfd, "key %d", 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);
	}
}

cmd(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;
}