[_CDCSL_93-16_]<1>Cedar>release>RemoteViewersTerminalByViewer>TerminalSenderImpl.mesa

TerminalSenderImpl.mesa

Mike Spreitzer January 7, 1987 7:34:38 pm PST

Last tweaked by Mike Spreitzer on July 6, 1992 2:34 pm PDT

Willie-s, April 23, 1992 10:53 am PDT

DIRECTORY Atom, BackStop, Basics, BasicTime, CardToCardTab, CedarProcess, Commander, CommanderOps, IO, KeyMapping, KeyMappingTypes, KeySymsKB, KeySymsSun, KeyTypes, Process, Real, RelativeTimes, RemoteEventTime, RemoteImagerDataTypes, Rope, SimpleFeedback, TerminalSender, TerminalSenderPrivate, TIPKeyboards, UserInput, UserInputDiscrimination, UserInputGetActions, UserInputOps, UserInputTypes;

TerminalSenderImpl: CEDAR MONITOR

LOCKS sr USING sr: Sender

IMPORTS Atom, BackStop, Basics, BasicTime, CardToCardTab, CedarProcess, Commander, CommanderOps, IO, KeyMapping, Process, Real, RemoteEventTime, Rope, SimpleFeedback, TIPKeyboards, UserInputDiscrimination, UserInputGetActions, UserInputOps

EXPORTS TerminalSender

BEGIN OPEN RET:RemoteEventTime, TerminalSender;

WaitMode: TYPE ~ UserInputTypes.WaitMode;

PrincOpsKeyName: TYPE ~ RemoteImagerDataTypes.PrincOpsKeyName;

Sender: TYPE ~ REF SenderPrivate;

SenderPrivate: PUBLIC TYPE ~ TerminalSenderPrivate.SenderPrivate;

ActionKind: TYPE = MACHINE DEPENDENT { --copied from DCedar's ClassIncreek

deltaEventTime, eventTime,

deltaMouse, mousePosition, penPosition,

keyDown, keyUp, keyStillDown, allUp,

timedOut -- never stored --

};

allUp is generated when full keyboard state is entered; action readers should

interpret allUp[] as a request to clear the current state in preparation for starting over.

shortWM: WaitMode ¬ dontWait;

timeout: Milliseconds ¬ 10;

closeAbortly: BOOL ¬ TRUE;

debug: BOOL ¬ TRUE;

StartSending: PUBLIC PROC

[et1: EventTime,

xlateKC: KeyCodeTranslation,

hostDescr: ROPE,

sourceData: REF ANY,

GetAction: GetActionProc,

initialState: ActionBodyList,

consumer: IO.STREAM,

Finish: PROC [sender: Sender, sourceData: REF ANY, consumer, pushStream: IO.STREAM] ¬ NIL,

Push: PROC [IO.STREAM] ¬ NIL,

pushStream: IO.STREAM ¬ NIL,

Other: PROC [Sender]]

RETURNS [Sender] = {

sr: Sender ~ NEW [SenderPrivate ¬ [et1: et1, xlateKC: xlateKC, sourceData: sourceData, hostDescr: hostDescr, GetAction: GetAction, consumer: consumer, pushStream: pushStream, Finish: Finish, Push: Push, Other: Other]];

TRUSTED {Process.Detach[sr.sender ¬ FORK SendProcess[sr, initialState]]};

RETURN [sr]};

SendProcess: PROC [sr: Sender, initialState: ActionBodyList] ~ {

OPEN sr;

et0: EventTime ~ et1.Sub[RET.SmallConsCC[0, 1]];

eg0: BasicTime.ExtendedGMT ~ RET.ToEGMT[et0];

SendAction: ENTRY PROC [sr: Sender, ab: ActionBody] = {

ENABLE UNWIND => NULL;

dms: Milliseconds ¬ ab.deltaTime;

SELECT TRUE FROM

ab.kind = $TimeOut => ERROR --shouldn't happen--;

ab.kind = $EventTime, dms > CARD16.LAST => {

SendHeader[eventTime, 0];

SendEventTime[et0.Add[RET.SmallConsCC[0, ab.eventTime]]];

IF ab.kind = $EventTime THEN RETURN ELSE dms ¬ 0};

dms > BYTE.LAST => {

SendHeader[deltaEventTime, 0];

SendCard16[dms];

dms ¬ 0};

ENDCASE => NULL;

SELECT ab.kind FROM

$TimeIsPassing => {SendHeader[deltaEventTime, 0]; SendCard16[dms]};

$End => going ¬ FALSE;

$AllUp, $KeyStillDown => NULL;

$Key => {dkc: KeyCode ~ xlateKC[ab.keyCode];

IF dkc <= PrincOpsKeyName.LAST.ORD

THEN {SendHeader[IF ab.down THEN keyDown ELSE keyUp, dms]; SendByte[dkc]}};

$IntegerPosition => {SendHeader[mousePosition, dms]; SendMousePosition[[mouseX: ab.x, mouseY: ab.y, color: DisplayToColor[ab.display]]]};

$Position => {SendHeader[mousePosition, dms]; SendMousePosition[[mouseX: Real.Round[ab.rx], mouseY: Real.Round[ab.ry], color: DisplayToColor[ab.display]]]};

ENDCASE => NULL;

RETURN};

SendChar: PROC [c: CHAR] = INLINE {consumer.PutChar[c]};

SendByte: PROC [byte: BYTE] = INLINE {SendChar[VAL[byte]]};

SendHeader: PROC [kind: ActionKind, dms: BYTE]

~ {SendByte[kind.ORD]; SendByte[dms]};

SendMousePosition: PROC [mp: RemoteImagerDataTypes.MousePosition] = INLINE {

SendInteger[mp.mouseX];

SendInteger[mp.mouseY+16383 - (IF mp.color THEN 32768 ELSE 0)]

};

SendEventTime: PROC [eventTime: EventTime] = {

SendCard[eventTime.hi];

SendCard16[eventTime.lo];

};

SendCard: PROC [card: CARD] = INLINE {

SendCard16[Basics.HighHalf[card]];

SendCard16[Basics.LowHalf[card]];

};

SendCard16: PROC [cardinal: CARD16] = INLINE {

SendByte[Basics.HighByte[cardinal]];

SendByte[Basics.LowByte[cardinal]];

};

SendInteger: PROC [i: INTEGER] = {SendCard16[IF i<0 THEN i+10000H ELSE i]};

NextAction: GetActionProc ~ {

IF initialState#NIL THEN {

head: ActionBodyList ~ initialState;

initialState ¬ initialState.rest;

RETURN [head.first]};

RETURN GetAction[sr.sourceData, waitMode, waitInterval, acceptance]};

FinishProcess: PROC ~ {

IF debug THEN SimpleFeedback.PutFL[$TerminalSender, oneLiner, $Debug, "%g Finishing Viewers Terminal sender to %g.", LIST[[time[BasicTime.Now[]]], [rope[hostDescr]]] ];

IF Finish#NIL THEN Finish[sr, sourceData, consumer, pushStream];

};

TsToEgmt: PROC [ts: RelativeTimes.TimeStamp] RETURNS [BasicTime.ExtendedGMT] ~ {

ds: NAT ¬ ts/1D3;

us: NAT ¬ (ts - ds*1D3)*1D3 + eg0.usecs;

IF us >= 1D6 THEN {us ¬ us - 1D6; ds ¬ ds + 1};

RETURN [[eg0.gmt.Update[ds], us]]};

EgmtToTs: PROC [eg: BasicTime.ExtendedGMT] RETURNS [RelativeTimes.TimeStamp] ~ {

ds: CARD ¬ BasicTime.Period[from: eg0.gmt, to: eg.gmt];

dus: INT ¬ INT[eg.usecs] - INT[eg0.usecs];

IF dus < 0 THEN {ds ¬ ds - 1; dus ¬ dus + 1D6};

RETURN [[ds*1000 + CARD[dus+500]/1D3]]};

wm: WaitMode ¬ shortWM;

ab: ActionBody ¬ [$TimeOut, [0], 0];

firstDownPullTime, pushTime, doneTime: BasicTime.ExtendedGMT ¬ eg0;

firstDownTS, firstDownPullTS, pushEventTS, pushTS, doneTS: RelativeTimes.TimeStamp ¬ [0];

noDown: BOOL ¬ TRUE;

nDown: NAT ¬ 0;

{ENABLE UNWIND => FinishProcess[];

IF debug THEN SimpleFeedback.PutFL[$TerminalSender, oneLiner, $Debug, "%g Starting Viewers Terminal sender to %g.", LIST[[time[BasicTime.Now[]]], [rope[hostDescr]]] ];

IF verboseDebugDelay THEN SimpleFeedback.PutFL[$TerminalSender, oneLiner, $Debug, "eg0 = [gmt: %g, usecs: %g].", LIST[[time[eg0.gmt]], [cardinal[eg0.usecs]]] ];

{ENABLE IO.Error => IF (ec = StreamClosed OR ec = Failure) THEN CONTINUE;

WHILE going DO

IF initialState=NIL THEN Other[sr];

IF NOT going THEN EXIT;

ab ¬ NextAction[NIL, wm, timeout, all];

IF debugDelay AND ab.kind=$Key AND ab.down THEN {

IF noDown THEN {

firstDownTS ¬ ab.eventTime;

firstDownPullTime ¬ BasicTime.ExtendedNow[];

firstDownPullTS ¬ EgmtToTs[firstDownPullTime];

noDown ¬ FALSE;

nDown ¬ 1}

ELSE nDown ¬ nDown.SUCC};

IF NOT going THEN EXIT;

CedarProcess.CheckAbort[];

IF ab.kind = $TimeOut THEN {

IF debugDelay AND NOT noDown THEN {

pushEventTS ¬ ab.eventTime;

pushTS ¬ EgmtToTs[pushTime ¬ BasicTime.ExtendedNow[]]};

IF Push # NIL THEN Push[pushStream];

IF debugDelay AND NOT noDown THEN {

doneTS ¬ EgmtToTs[doneTime ¬ BasicTime.ExtendedNow[]];

SimpleFeedback.PutFL[$TerminalSender, oneLiner, $Debug, "Delay to pull=%g, t.o.Inp=%g, t.o.Real=%g, done=%gms; %g dn.", LIST[[cardinal[firstDownPullTS-firstDownTS]], [cardinal[pushEventTS-firstDownTS]], [cardinal[pushTS-firstDownTS]], [cardinal[doneTS-firstDownTS]], [cardinal[nDown]]] ];

IF verboseDebugDelay THEN SimpleFeedback.PutFL[$TerminalSender, oneLiner, $Debug, "First down input TS = %g, real EGmt = [%g, %g], pull TS = %g.", LIST[[cardinal[firstDownTS]], [time[firstDownPullTime.gmt]], [cardinal[firstDownPullTime.usecs]], [cardinal[firstDownPullTS]]] ];

noDown ¬ TRUE};

wm ¬ forever;

LOOP}

ELSE wm ¬ shortWM;

SendAction[sr, ab];

IF ab.kind = $End THEN going ¬ FALSE;

ENDLOOP;

}};

FinishProcess[];

RETURN};

debugDelay, verboseDebugDelay: BOOL ¬ FALSE;

FromUihToDcedar: PUBLIC PROC [uih: UserInput.Handle]
RETURNS [kct: KeyCodeTranslation] ~ {

best: CardToCardTab.Ref ~ CardToCardTab.Create[];

second: CardToCardTab.Ref ~ CardToCardTab.Create[];

mapping: KeyMappingTypes.Mapping ¬ UserInputOps.GetMapping[uih];

Update: PROC [dSofar: KeyCode, tab: CardToCardTab.Ref, ks: CARD] RETURNS [KeyCode] ~ {

found: BOOL;

dNew: CARD;

[found, dNew] ¬ tab.Fetch[ks];

IF found THEN RETURN [dNew];

RETURN [dSofar]};

kct ¬ NEW [KeyCodeTranslationRep ¬ ALL[255]];

FOR dkn: PrincOpsKeyName IN PrincOpsKeyName DO

ks1, ks2: CARD;

success: BOOL;

[ks1, ks2, success] ¬ TIPKeyboards.KeySymsFromKeyCode[VAL[dkn.ORD]];

IF success THEN {

[] ¬ best.Store[ks1, dkn.ORD];

[] ¬ second.Store[ks2, dkn.ORD];

};

IF dkn.ORD = noteKC THEN noted ¬ noted+1;

ENDLOOP;

[] ¬ best.Store[KeySymsKB.A10, PrincOpsKeyName[Arrow].ORD]; --??

[] ¬ best.Store[KeySymsKB.R10, PrincOpsKeyName[Arrow].ORD];

[] ¬ best.Store[KeySymsKB.KeypadSix, PrincOpsKeyName[STUFF].ORD];

[] ¬ best.Store[KeySymsKB.RightMeta, PrincOpsKeyName[EXPAND].ORD];

[] ¬ best.Store[KeySymsKB.R15, PrincOpsKeyName[USERABORT].ORD];

[] ¬ best.Store[KeySymsKB.RightAlt, PrincOpsKeyName[USERABORT].ORD];

[] ¬ best.Store[KeySymsKB.LeftAlt, PrincOpsKeyName[A11].ORD]; --just put it somewhere; hopefully A11 isn't used for anything interesting

[] ¬ best.Store[KeySymsSun.Paste, PrincOpsKeyName[A8].ORD]; --TIPKeyboards already says PASTE is used for LineFeed!

[] ¬ best.Store[66202, PrincOpsKeyName[COPY].ORD];

[] ¬ best.Store[66203, PrincOpsKeyName[A8].ORD];

FOR kc: KeyTypes.KeyCode IN KeyTypes.KeyCode DO

n: NAT ~ KeyMapping.CountKeySyms[mapping, kc];

hisBest, hisSecond: KeyCode ¬ 255;

FOR i: NAT IN [0..n) DO

ks: CARD ~ KeyMapping.GetKeySym[mapping, kc, i];

hisBest ¬ Update[hisBest, best, ks];

hisSecond ¬ Update[hisSecond, second, ks];

IF kc.ORD = noteKC THEN noted ¬ noted+1;

ENDLOOP;

IF kc.ORD = noteKC THEN noted ¬ noted+1;

IF hisBest#255 THEN kct[kc] ¬ hisBest
ELSE kct[kc] ¬ hisSecond;

ENDLOOP;

RETURN};

noteKC: CARD ¬ CARD.LAST;

noted: CARD ¬ 0;

lastTimeStamp: RelativeTimes.TimeStamp ~ [LAST[CARD32]];

StateOfIncreek: PUBLIC PROC [creek: UserInput.Handle] RETURNS [ActionBodyList, RelativeTimes.TimeStamp] ~ {

ab: ActionBody ~ UserInputGetActions.GetInputActionBody[creek];

IF ab.kind=$End OR ab.kind=$TimeOut OR ab.eventTime=lastTimeStamp THEN ERROR;

RETURN [

LIST[

[$EventTime, ab.eventTime, 0]

ab.eventTime

]};

UserInputGetAction: PUBLIC PROC [sourceData: REF ANY, waitMode: WaitMode, waitInterval: Milliseconds, acceptance: UserInputTypes.Acceptance] RETURNS [ActionBody] --GetActionProc-- ~ TRUSTED {

creek: UserInput.Handle ~ UserInputDiscrimination.NarrowHandle[sourceData];

RETURN UserInputGetActions.GetInputActionBody[creek, waitMode, waitInterval, acceptance]};

StopSending: PUBLIC ENTRY PROC [sr: Sender] ~ {

ENABLE UNWIND => NULL;

sr.going ¬ FALSE;

RETURN};

WithSender: PUBLIC ENTRY PROC [sr: Sender, With: PROC [IO.STREAM]] ~ {

ENABLE UNWIND => NULL;

With[sr.consumer];

RETURN};

SendTimeReply: PUBLIC PROC [sr: Sender, org, mid: EventTime, descToo: BOOL, desc: EventDesc] ~ {

OPEN sr;

SendEventTime: PROC [eventTime: EventTime] = INLINE {

SendCard[eventTime.hi];

SendCard16[eventTime.lo];

};

SendCard: PROC [card: CARD] = INLINE {

SendCard16[Basics.HighHalf[card]];

SendCard16[Basics.LowHalf[card]];

};

SendCard16: PROC [cardinal: CARDINAL] = INLINE {

SendByte[Basics.HighByte[cardinal]];

SendByte[Basics.LowByte[cardinal]];

};

SendByte: PROC [byte: BYTE] = INLINE {SendChar[VAL[byte]]};

SendChar: PROC [c: CHAR] = INLINE {consumer.PutChar[c]};

dcopy: EventDesc ¬ desc;

SendEventTime[org];

SendEventTime[mid];

IF descToo THEN TRUSTED {consumer.UnsafePutBlock[[base: LOOPHOLE[@dcopy], count: BYTES[EventDesc]]]};

RETURN};

SendCutBuffer: PUBLIC PROC [sr: Sender, buffer: ATOM, key: CARD, data: ROPE] ~ {

OPEN sr;

SendRope: PROC [r: ROPE] ~ {

SendCard[r.Length];

consumer.PutRope[r];

RETURN};

SendCard: PROC [card: CARD] = INLINE {

SendCard16[Basics.HighHalf[card]];

SendCard16[Basics.LowHalf[card]];

};

SendCard16: PROC [cardinal: CARDINAL] = INLINE {

SendByte[Basics.HighByte[cardinal]];

SendByte[Basics.LowByte[cardinal]];

};

SendByte: PROC [byte: BYTE] = INLINE {SendChar[VAL[byte]]};

SendChar: PROC [c: CHAR] = INLINE {consumer.PutChar[c]};

SendRope[Atom.GetPName[buffer]];

SendCard[key];

SendRope[data];

RETURN};

Close: PUBLIC ENTRY PROC [sr: Sender] ~ {

ENABLE UNWIND => NULL;

sr.consumer.Close[abort: closeAbortly !IO.Error => CONTINUE];

RETURN};

PushProcess: PROC [sr: Sender] = {

Process.SetPriority[Process.priorityForeground];

WHILE sr.going DO

EnterAndPush: PROC = {

PushWithLock: ENTRY PROC [sr: Sender] = {

ENABLE UNWIND => NULL;

sr.Push[sr.pushStream];

RETURN};

PushWithLock[sr];

RETURN};

Process.Pause[pushPeriod];

IF pushMsg # NIL THEN lastPushMsg ¬ pushMsg;

IF sr.Push # NIL THEN pushMsg ¬ BackStop.Call[EnterAndPush];

ENDLOOP;

};

pushMsg, lastPushMsg: Rope.ROPE ¬ NIL;

pushPeriod: Process.Ticks ¬ Process.MsecToTicks[333];

DisplayToColor: PROC [ra: REF ANY] RETURNS [BOOL] ~ {

SELECT ra FROM

$Main, $Display0, NIL => RETURN [FALSE];

ENDCASE => RETURN [TRUE]};

optionDesc: ROPE ¬ "((+|-)(debug|debugDelay|verboseDebugDelay))* --- show/change flg(s)";

optionUsage: ROPE ¬ Rope.Concat["TerminalSenderOption ", optionDesc];

OptionCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] ~ {

argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];

Set: PROC [name: ROPE, sense: BOOL] RETURNS [BOOL] ~ {

SELECT TRUE FROM

name.Equal["debug", FALSE] => debug ¬ sense;

name.Equal["debugDelay", FALSE] => debugDelay ¬ sense;

name.Equal["verboseDebugDelay", FALSE] => verboseDebugDelay ¬ sense;

ENDCASE => RETURN [TRUE];

RETURN [FALSE]};

i: NAT ¬ 1;

IF argv.argc<1 THEN RETURN [$Null, optionUsage];

WHILE i < argv.argc DO

SELECT TRUE FROM

argv[i].Length = 0 => RETURN [$Failure, optionUsage];

argv[i].Fetch[0] = '+ => IF Set[argv[i].Substr[1], TRUE] THEN RETURN [$Failure, optionUsage];

argv[i].Fetch[0] = '- => IF Set[argv[i].Substr[1], FALSE] THEN RETURN [$Failure, optionUsage];

ENDCASE => RETURN [$Failure, optionUsage];

i ¬ i.SUCC;

ENDLOOP;

cmd.out.PutFL["TerminalSender options are: debug=%g, debugDelay=%g, verboseDebugDelay=%g.\n", LIST[ [boolean[debug]], [boolean[debugDelay]], [boolean[verboseDebugDelay]] ]];

RETURN};

Commander.Register["TerminalSenderOption", OptionCmd, optionDesc];

END.