PseudoKeyboardImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, June 4, 1990 11:02:28 am PDT
Christian Jacobi, April 7, 1992 12:20 pm PDT
DIRECTORY
Ascii, Commander, Rope, KeyChars, KeyMapping, KeySyms1, KeySymsKB, Xl, XlConventions, XTk, XTkWidgets;
PseudoKeyboardImpl:
CEDAR
PROGRAM
IMPORTS Ascii, Commander, KeyChars, KeyMapping, Rope, Xl, XlConventions, XTk, XTkWidgets ~
CurrentBuffer:
PROC[i: Instance]
RETURNS [Rope.
ROPE] = {
RETURN [XTkWidgets.GetText[i.feedback]]
};
SetBuffer:
PROC[i: Instance, r: Rope.
ROPE] = {
XTkWidgets.SetText[i.feedback, r, immediately];
IF i.autoCut THEN XlConventions.CutBufferPush[i.feedback.connection, r];
};
Instance: TYPE = REF InstanceRec;
InstanceRec:
TYPE =
RECORD [
feedback: XTkWidgets.Widget ¬ NIL,
asciiRow: XTkWidgets.Widget ¬ NIL,
directRow: XTkWidgets.Widget ¬ NIL,
ctrlWidget: XTkWidgets.Widget ¬ NIL,
shiftWidget: XTkWidgets.Widget ¬ NIL,
resetModifierWidget: XTkWidgets.Widget ¬ NIL,
ctrlOn: BOOL ¬ FALSE,
shiftOn: BOOL ¬ FALSE,
direct: BOOL ¬ FALSE,
autoCut: BOOL ¬ FALSE,
asciiVisible: BOOL ¬ TRUE,
sz: Xl.Size,
next: Xl.Point ¬ [0, 0]
];
KeySymFromRefAny:
PROC [key:
REF
ANY]
RETURNS [k:
Xl.KeySym ¬ [0]] = {
WITH key
SELECT
FROM
rk: REF Xl.KeySym => k ¬ rk;
rc: REF CHAR => k ¬ KeyChars.KeySymFromChar[rc];
ENDCASE => k ¬ [0];
};
KeyHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
keySym: Xl.KeySym ¬ KeySymFromRefAny[callData];
char: CHAR ¬ KeyChars.CharFromKeySym[keySym];
WITH event
SELECT
FROM
br: Xl.ButtonReleaseEvent => {
IF br.button=1
THEN {
IF char
IN ['A..'Z]
THEN {
char ¬ Ascii.Lower[char];
keySym ¬ KeyChars.KeySymFromChar[char];
};
};
};
ENDCASE=> {};
IF i.direct
THEN {
SimulateDirect[i, event, keySym];
}
ELSE {
r: Rope.ROPE ¬ CurrentBuffer[i];
IF keySym=KeySymsKB.BS
THEN {
l: INT ¬ Rope.Length[r];
IF l>0 THEN r ¬ Rope.Substr[r, 0, l-1];
}
ELSE {
r ¬ Rope.Concat[r, Rope.FromChar[char]]
};
SetBuffer[i, r];
};
Xl.Flush[widget.connection];
};
SetupRec:
TYPE =
RECORD [
keyCode: KeyMapping.KeyCode,
shiftKey: KeyMapping.KeyCode,
found: BOOL,
shift: BOOL,
dest: Xl.Window,
propagate: BOOL ¬ TRUE,
currentFocus: Xl.Window,
currentRoot: Xl.Window,
time: Xl.TimeStamp
];
SetupDirect:
PROC [i: Instance, originalEvent: Xl.Event, sym: Xl.KeySym]
RETURNS [s: SetupRec] = {
keyCodes: KeyMapping.KeyCodes;
inputFocusWindow: Xl.Window = [[1]];
screen: Xl.Screen;
connection: Xl.Connection ¬ i.feedback.connection;
map: Xl.KeyboardMapping ¬ Xl.GetKeyboardMapping[connection];
keyCodes ¬ KeyMapping.KeyCodesFromKeySym[map, sym];
IF keyCodes.n=0
THEN {
IF sym
IN [KeySyms1.a.val..KeySyms1.z.val]
THEN {
capSym: Xl.KeySym ¬ [sym.val - KeySyms1.a.val + KeySyms1.A.val];
keyCodes ¬ KeyMapping.KeyCodesFromKeySym[map, capSym];
};
};
s.found ¬ keyCodes.n>0;
IF s.found
THEN {
s.keyCode ¬ keyCodes[0].keyCode;
s.shift ¬ keyCodes[0].glyphIndex=1 OR (sym.val IN [KeySyms1.A.val..KeySyms1.Z.val]);
};
keyCodes ¬ KeyMapping.KeyCodesFromKeySym[map, KeySymsKB.LeftShift];
IF keyCodes.n>0 THEN s.shiftKey ¬ keyCodes[0].keyCode;
s.dest ¬ inputFocusWindow;
s.currentFocus ¬ Xl.GetInputFocus[connection].window;
IF s.currentFocus=Xl.nullWindow
OR s.currentFocus=Xl.focusPointerRoot
THEN screen ¬ Xl.DefaultScreen[connection]
ELSE screen ¬ Xl.QueryScreen[connection, s.currentFocus];
s.currentRoot ¬ screen.root;
s.time ¬ Xl.currentTime;
s.dest ¬ s.currentFocus; --??
WITH originalEvent
SELECT
FROM
kre: Xl.ButtonReleaseEvent => s.time ¬ kre.timeStamp;
ENDCASE => --sorry-- s.time ¬ Xl.currentTime;
};
SimulateDirectSpecial:
PROC [i: Instance, originalEvent: Xl.Event, sym: Xl.KeySym, down:
BOOL ¬
FALSE] = {
connection: Xl.Connection ¬ i.feedback.connection;
s: SetupRec ¬ SetupDirect[i, originalEvent, sym];
ebDown: Xl.EventRep.keyPress;
ebUp: Xl.EventRep.keyRelease;
ebDown.keyCode ¬ ebUp.keyCode ¬ s.keyCode;
ebDown.timeStamp ¬ ebUp.timeStamp ¬ s.time;
SELECT sym
FROM
KeySymsKB.LeftControl, KeySymsKB.RightControl => {
ebDown.state ¬ [shift: i.shiftOn, control: FALSE];
ebUp.state ¬ [shift: i.shiftOn, control: TRUE];
};
KeySymsKB.LeftShift, KeySymsKB.RightShift => {
ebDown.state ¬ [shift: FALSE, control: i.ctrlOn];
ebUp.state ¬ [shift: TRUE, control: i.ctrlOn];
};
ENDCASE => {ERROR};
ebDown.root ¬ ebUp.root ¬ s.currentRoot;
ebDown.eventWindow ¬ ebUp.eventWindow ¬ s.currentFocus;
ebDown.child ¬ ebUp.child ¬ Xl.nullWindow;
ebDown.rootP ¬ ebUp.rootP ¬ [0, 0];
ebDown.pos ¬ ebUp.pos ¬ [0, 0];
ebDown.sameScreen ¬ ebUp.sameScreen ¬ TRUE;
IF down
THEN Xl.SendEvent[connection, s.dest, s.propagate, [keyPress: TRUE], ebDown]
ELSE Xl.SendEvent[connection, s.dest, s.propagate, [keyRelease: TRUE], ebUp]
};
SimulateDirect:
PROC [i: Instance, originalEvent: Xl.Event, sym: Xl.KeySym] = {
connection: Xl.Connection ¬ i.feedback.connection;
s: SetupRec ¬ SetupDirect[i, originalEvent, sym];
IF s.found
THEN {
ebDown: Xl.EventRep.keyPress;
ebUp: Xl.EventRep.keyRelease;
shift: BOOL ¬ s.shift;
ebDown.keyCode ¬ ebUp.keyCode ¬ s.keyCode;
ebDown.timeStamp ¬ ebUp.timeStamp ¬ s.time;
ebDown.state ¬ ebUp.state ¬ [control: i.ctrlOn, shift: i.shiftOn];
ebDown.root ¬ ebUp.root ¬ s.currentRoot;
ebDown.eventWindow ¬ ebUp.eventWindow ¬ s.currentFocus;
ebDown.child ¬ ebUp.child ¬ Xl.nullWindow;
ebDown.rootP ¬ ebUp.rootP ¬ [0, 0];
ebDown.pos ¬ ebUp.pos ¬ [0, 0];
ebDown.sameScreen ¬ ebUp.sameScreen ¬ TRUE;
IF shift
AND ~i.shiftOn
THEN {
shDown: Xl.EventRep.keyPress ¬ ebDown;
shDown.keyCode ¬ s.shiftKey;
shDown.state ¬ [control: i.ctrlOn, shift: FALSE];--shift not in state
ebDown.state ¬ ebUp.state ¬ [control: i.ctrlOn, shift: TRUE]; --shift in state
Xl.SendEvent[connection, s.dest, s.propagate, [keyPress: TRUE], shDown];
};
Xl.SendEvent[connection, s.dest, s.propagate, [keyPress: TRUE], ebDown];
Xl.SendEvent[connection, s.dest, s.propagate, [keyRelease: TRUE], ebUp];
IF shift
AND ~i.shiftOn
THEN {
shUp: Xl.EventRep.keyRelease ¬ ebUp;
shUp.keyCode ¬ s.shiftKey;
shUp.state ¬ [control: i.ctrlOn, shift: TRUE];--shift in state
Xl.SendEvent[connection, s.dest, s.propagate, [keyPress: TRUE], shUp];
};
};
};
EraseHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
SetBuffer[i, ""];
};
CutHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
r: Rope.ROPE ¬ CurrentBuffer[i];
XlConventions.CutBufferPush[widget.connection, r]
};
EmitCTRL:
PROC [i: Instance] = {
XTkWidgets.SetStyleKey[i.ctrlWidget, IF i.ctrlOn THEN $Gray2 ELSE $BlackOnWhite];
SimulateDirectSpecial[i, NIL--OOPS--, KeySymsKB.LeftControl, i.ctrlOn];
};
EmitSHIFT:
PROC [i: Instance] = {
XTkWidgets.SetStyleKey[i.shiftWidget, IF i.shiftOn THEN $Gray2 ELSE $BlackOnWhite];
SimulateDirectSpecial[i, NIL--OOPS--, KeySymsKB.LeftShift, i.shiftOn];
};
NoOp: XTkWidgets.ButtonHitProcType = {
};
CtrlHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
i.ctrlOn ¬ NOT i.ctrlOn;
EmitCTRL[i];
};
ShiftHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
i.shiftOn ¬ NOT i.shiftOn;
EmitSHIFT[i];
};
ResetModifiersHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
i.shiftOn ¬ i.ctrlOn ¬ FALSE;
EmitSHIFT[i];
EmitCTRL[i];
};
OptionsHit: XTkWidgets.ButtonHitProcType = {
AsciiVisible:
PROC [i: Instance, visible:
BOOL ] = {
IF i.asciiVisible#visible
THEN {
aMapping: XTk.Mapping ¬ IF visible THEN mapped ELSE unmapped;
dMapping: XTk.Mapping ¬ IF visible THEN unmapped ELSE mapped;
i.asciiVisible ¬ visible;
XTk.NoteMappingChange[widget: i.asciiRow, mapping: aMapping];
XTk.NoteMappingChange[widget: i.feedback, mapping: aMapping];
XTk.NoteMappingChange[widget: i.directRow, mapping: dMapping];
XTk.StartReconfigureChildren[i.asciiRow.parent];
XTkWidgets.SetText[i.feedback, "", immediately];
Xl.Flush[i.asciiRow.connection];
}
};
i: Instance ¬ NARROW[registerData];
SELECT callData
FROM
$A => {i.autoCut ¬ TRUE; i.direct ¬ FALSE; AsciiVisible[i, TRUE]};
$X => {i.autoCut ¬ FALSE; i.direct ¬ FALSE; AsciiVisible[i, TRUE]};
$D => {i.autoCut ¬ FALSE; i.direct ¬ TRUE; AsciiVisible[i, FALSE]};
ENDCASE => {}
};
Define:
PROC [ch:
CHAR, keySymVal:
CARD32] = {
};
CreatePseudoKeyboard: Commander.CommandProc ~ {
basicWidth: INT ¬ 19;
basicHeight: INT ¬ 19;
rows: INT ¬ 7;
cols: INT ¬ 11;
i: Instance ¬ NEW[InstanceRec ¬ [sz: [basicWidth, basicHeight]]];
shell, contents, buttonRow, keyboard, options, mode, toggle: XTkWidgets.Widget;
L:
PROC [char:
CHAR] = {
r: Rope.ROPE ¬ Rope.FromChar[char];
keySym: Xl.KeySym ¬ KeyChars.KeySymFromChar[char];
key: REF ANY ¬ NEW[Xl.KeySym ¬ keySym];
IF keySym=0 THEN ERROR;
DrawKey[r, key];
};
DrawKey:
PROC [text: Rope.
ROPE, key:
REF
ANY] = {
--into container "keyboard"
b: XTkWidgets.TextWidget;
b ¬ XTkWidgets.CreateButton[
widgetSpec: [
geometry: [pos: i.next, size: [width: i.sz.width-2, height: i.sz.height-2], borderWidth: 1]
],
text: text,
hitProc: KeyHit, registerData: i, callData: key
];
Right[i.sz.width];
XTkWidgets.AppendChild[keyboard, b];
};
DrawButton:
PROC [text: Rope.
ROPE, key:
REF
ANY ¬
NIL, hitProc: XTkWidgets.ButtonHitProcType ¬
NIL]
RETURNS [b: XTkWidgets.TextWidget] = {
--into container "buttonRow"
IF hitProc=NIL THEN hitProc ¬ KeyHit;
b ¬ XTkWidgets.CreateButton[
widgetSpec: [geometry: [borderWidth: 1]],
text: text, hitProc: hitProc, registerData: i, callData: key
];
XTkWidgets.AppendChild[buttonRow, b];
};
Home:
PROC [] = {
i.next.x ¬ 0; i.next.y ¬ 0;
};
Down:
PROC [] = {
i.next.y ¬ i.next.y + i.sz.height;
i.next.x ¬ 0;
};
Right:
PROC [amount:
INT] = {
i.next.x ¬ i.next.x + amount;
};
shell ¬ XTkWidgets.CreateShell[windowHeader: "pseudo-keyboard", className: $PseudoKeyboard, standardMigration: TRUE, focusProtocol: FALSE];
XTkWidgets.SetFocusMethod[shell: shell, focusProtocol: false, inputHint: false];
XTk.PutWidgetProp[shell, $PseudoKeyboard, i];
--
contents ¬ XTkWidgets.CreateYStack[[]];
XTkWidgets.SetShellChild[shell, contents];
--
i.feedback ¬ XTkWidgets.CreateLabel[widgetSpec: [geometry: [borderWidth: 1]], text: ""];
XTkWidgets.AppendChild[contents, i.feedback];
--
i.directRow ¬ buttonRow ¬ XTkWidgets.CreateXStack[[mapping: unmapped]];
i.ctrlWidget ¬ DrawButton[text: "ctrl", hitProc: CtrlHit];
i.shiftWidget ¬ DrawButton[text: "shift", hitProc: ShiftHit];
i.resetModifierWidget ¬ DrawButton[text: "<up>", hitProc: ResetModifiersHit];
XTkWidgets.AppendChild[contents, buttonRow];
--
i.asciiRow ¬ buttonRow ¬ XTkWidgets.CreateXStack[];
[] ¬ DrawButton[text: "cut", hitProc: CutHit];
[] ¬ DrawButton[text: "erase", hitProc: EraseHit];
XTkWidgets.AppendChild[contents, buttonRow];
--
buttonRow ¬ XTkWidgets.CreateXStack[];
[] ¬ DrawButton[text: "bs", key: NEW[Xl.KeySym ¬ KeySymsKB.BS]];
[] ¬ DrawButton[text: "cr", key: NEW[Xl.KeySym ¬ KeySymsKB.CR]];
[] ¬ DrawButton[text: "del", key: NEW[Xl.KeySym ¬ KeyChars.KeySymFromChar[Ascii.DEL]]];
[] ¬ DrawButton[text: "space", key: NEW[Xl.KeySym ¬ KeyChars.KeySymFromChar[' ]]];
[] ¬ DrawButton[text: "line-feed", key: NEW[Xl.KeySym ¬ KeySymsKB.LF]];
XTkWidgets.AppendChild[contents, buttonRow];
--
keyboard ¬ XTkWidgets.CreateContainer[
widgetSpec: [
geometry: [size: [width: cols*basicWidth, height: rows*basicHeight]]
]
];
XTkWidgets.AppendChild[contents, keyboard];
--
mode ¬ XTkWidgets.CreateLabel[text: "mode:"];
toggle ¬ XTkWidgets.CreateChoices[
hitProc: OptionsHit, registerData: i,
choices:
LIST [
["explicit", $X],
["always", $A],
["direct", $D]
]
];
options ¬ XTkWidgets.CreateXStack[[], LIST[mode, toggle]];
XTkWidgets.AppendChild[contents, options];
--
--drawing in the keyboard container
Home[];
L['1]; L['2]; L['3]; L['4]; L['5]; L['6]; L['7]; L['8]; L['9]; L['0];
Down[]; Right[i.sz.width/2*1];
L['Q]; L['W]; L['E]; L['R]; L['T]; L['Y]; L['U]; L['I]; L['O]; L['P];
Down[]; Right[i.sz.width/2*2];
L['A]; L['S]; L['D]; L['F]; L['G]; L['H]; L['J]; L['K]; L['L];
Down[]; Right[i.sz.width/2*3];
L['Z]; L['X]; L['C]; L['V]; L['B]; L['N]; L['M];
Down[];
L['!]; L['@]; L['#]; L['$]; L['%]; L['~]; L['&]; L['*]; L['(]; L[')];
Down[];
L['-]; L['+]; L['=]; L['\\]; L['|]; L['[]; L[']]; L['{]; L['}]; L['?];
Down[];
L[':]; L[';]; L['"]; L['']; L[',]; L['.]; L['/]; L['<]; L['>]; L[' ];
--
XTkWidgets.RealizeShell[shell];
};
Commander.Register["PseudoKeyboard", CreatePseudoKeyboard, "Create a pseudo keyboard"];
END.