
<<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 ~ 
    BEGIN

    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.