NewLarkImpl.mesa
Last modified by D. Swinehart, June 19, 1984 12:36:48 pm PDT
Last modified by L. Stewart, December 27, 1983 4:58 pm
Last Edited by: Pier, May 30, 1984 11:41:13 am PDT
DIRECTORY
AMBridge USING [TVForReferent],
BasicTime USING [Now, nullGMT],
Buttons USING [ Button, ButtonProc, SetDisplayStyle ],
Containers USING [ ChildXBound, Create ],
EditedStream USING [DeliverWhenProc, SetEcho],
IO,
IOUtils USING [CopyPFProcs, PFCodeProc, PFProcs, SetPFCodeProc, SetPFProcs],
Lark,
LarkRpcControl USING [ImportNewInterface],
LarkSmarts,
LarkSmartsRpcControl USING [ ExportInterface ],
List USING [ Length, Reverse ],
Names USING [ CurrentPasskey, CurrentRName, InstanceFromNetAddress ],
PlayOps USING [PlayString, BeepProc],
PrintTV USING [Print],
Process USING [ Detach, MsecToTicks, Pause, SecondsToTicks ],
Rope USING [Equal, Fetch, Length, ROPE],
RPC USING [AuthenticateFailed, AuthenticateFailure, CallFailed, CallFailure, ImportFailed, ImportFailure, StartConversation, unencrypted],
NewLark,
TypeScript USING [Create],
UserProfile USING [Token],
ViewerIO USING [CreateViewerStreams],
ViewRec USING [BindAllOfATypeFromRefs, RVQuaViewer, ViewRef],
VTables USING [Create, GetTableEntry, Install, SetTableEntry, VTable];
NewLarkImpl:
CEDAR
PROGRAM
IMPORTS
AMBridge, BasicTime, Buttons, Containers, EditedStream, IO, IOUtils, LarkRpcControl, LarkSmartsRpcControl, List, Names, NewLark, PlayOps, PrintTV, Process, Rope, RPC, TypeScript, UserProfile, ViewerIO, ViewRec, VTables
EXPORTS LarkSmarts = {
larkList: LIST OF NewLark.LarkHandle;
serialNumber: LarkSmarts.SmartsHandle ← 1;
This stuff handles the Crossbar viewer (which is a VTable)
TogProc: Buttons.ButtonProc =
TRUSTED {
bd: REF NewLark.BDat ← NARROW[clientData];
bd.value ← NOT bd.value;
Buttons.SetDisplayStyle[NARROW[parent], IF bd.value THEN $WhiteOnBlack ELSE $BlackOnWhite];
InternalTogProc[bd];
};
InternalTogProc:
PROC [bd:
REF NewLark.BDat] = {
ev: Lark.CommandEvent ← IF bd.value THEN bd.on ELSE bd.off;
IF ev.device # nothing THEN SendCommand[self: bd.h, d: ev.device, e: ev.event];
};
ConnProc: Buttons.ButtonProc =
TRUSTED {
bd: REF NewLark.BDat ← NARROW[clientData];
bd.value ← NOT bd.value;
Buttons.SetDisplayStyle[NARROW[parent], IF bd.value THEN $WhiteOnBlack ELSE $BlackOnWhite];
SELECT
NARROW[parent, Buttons.Button]
FROM
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 3] => ConnectCommand[self: bd.h, ch: 1, tx: TRUE, on: bd.value];
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 4] => ConnectCommand[self: bd.h, ch: 2, tx: TRUE, on: bd.value];
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 5] => ConnectCommand[self: bd.h, ch: 3, tx: TRUE, on: bd.value];
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 6] => ConnectCommand[self: bd.h, ch: 1, tx: FALSE, on: bd.value];
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 7] => ConnectCommand[self: bd.h, ch: 2, tx: FALSE, on: bd.value];
VTables.GetTableEntry[table: bd.h.xbv, row: 10, column: 8] => ConnectCommand[self: bd.h, ch: 3, tx: FALSE, on: bd.value];
ENDCASE => ERROR;
};
SetUpXBarViewer:
PROC [self: NewLark.LarkHandle] = {
sources: ARRAY [0..7] OF Rope.ROPE = ["Codec 1", "TeleSet", "TeleWall", "Mike", "Silence", "Codec 2", "Line 1", "Line 2"];
sinks: ARRAY [0..7] OF Rope.ROPE = ["Codec 1", "TeleSet", "TeleWall", "Speaker", "DTMF", "Codec 2", "Line 1", "Line 2"];
ev: Lark.Event;
bd: REF NewLark.BDat;
xbv: VTables.VTable;
SetUpBDat:
PROC [row:
NAT, column:
NAT, name: Rope.
ROPE, bd:
REF NewLark.BDat, proc: Buttons.ButtonProc ← TogProc] = {
VTables.SetTableEntry[table: xbv, row: row, column: column, name: name, flavor: NIL, proc: proc, clientData: bd, displayStyle: IF bd.value THEN $WhiteOnBlack ELSE $BlackOnWhite, useMaxSize: TRUE];
};
self.xbv ← xbv ← VTables.Create[columns: 9, rows: 11, parent: self.container, y: self.ts.wh];
FOR i:
NAT
IN [0..7]
DO
VTables.SetTableEntry[xbv, i + 1, 0, sources[i]];
VTables.SetTableEntry[xbv, 0, i + 1, sinks[i]];
ENDLOOP;
FOR row:
NAT
IN [0..7]
DO
FOR col:
NAT
IN [0..7]
DO
ev ← LOOPHOLE[row*16+col, Lark.Event];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: setCrosspoint, event: ev], off: [device: clearCrosspoint, event: ev], value: FALSE]];
SetUpBDat[row: row + 1, column: col + 1, name: " ", bd: bd];
ENDLOOP;
ENDLOOP;
relays
bd ← NEW[NewLark.BDat ← [h: self, on: [device: offHookRelay, event: Lark.enabled], off: [device: offHookRelay, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 1, name: "OH", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: aRelay, event: Lark.enabled], off: [device: aRelay, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 2, name: "A", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: revertRelay, event: Lark.enabled], off: [device: revertRelay, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 3, name: "Revert", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: revertHookswitch, event: Lark.enabled], off: [device: revertHookswitch, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 4, name: "HS", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: sideTone, event: Lark.enabled], off: [device: sideTone, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 5, name: "SideTone", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: ringEnable, event: Lark.enabled], off: [device: ringEnable, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 6, name: "RingEnable", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: led, event: Lark.enabled], off: [device: led, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 7, name: "LED", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: spMode, event: Lark.enabled], off: [device: spMode, event: Lark.disabled], value: FALSE]];
SetUpBDat[row: 9, column: 8, name: "SPMode", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: voiceMode, event: Lark.o2i2], off: [device: voiceMode, event: Lark.o3i1], value: FALSE]];
SetUpBDat[row: 10, column: 1, name: "O2I2", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, on: [device: timeslot, event: Lark.ts12], off: [device: timeslot, event: Lark.ts0], value: FALSE]];
SetUpBDat[row: 10, column: 2, name: "TS12", bd: bd];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 3, name: "TX1", bd: bd, proc: ConnProc];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 4, name: "TX2", bd: bd, proc: ConnProc];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 5, name: "VFS-TX", bd: bd, proc: ConnProc];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 6, name: "RX1", bd: bd, proc: ConnProc];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 7, name: "RX2", bd: bd, proc: ConnProc];
bd ← NEW[NewLark.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 8, name: "RX3", bd: bd, proc: ConnProc];
VTables.Install[xbv];
};
SetUpBDat:
PROC [table: VTables.VTable, row:
NAT, column:
NAT, name: Rope.
ROPE, bd:
REF NewLark.BDat, proc: Buttons.ButtonProc ← TogProc] = {
VTables.SetTableEntry[table: table, row: row, column: column, name: name, flavor: NIL, proc: proc, clientData: bd, displayStyle: IF bd.value THEN $WhiteOnBlack ELSE $BlackOnWhite];
};
MyPlayFile: NewLark.PlayFileProc =
TRUSTED {
NewLark.PlayFile[fileName: fileName, him: self.rx1.localSocket];
};
MyDialProc: NewLark.DialProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
ce: Lark.CommandEvents ← RopeToDTMF[number];
waveTableNat:
NAT ←
SELECT waveTable
FROM
dB0 => 0,
dB3 => 1,
dB6 => 2,
dB9 => 3
ENDCASE => 4;
IF self.registered THEN [] ← self.lark.Feep[shh: self.shhh, on: on, off: off, waveTable: waveTableNat, queueIt: queueIt, notify: IF notify THEN [tones, 'F] ELSE [nothing, 0C], events: ce];
};
MyEchoProc: NewLark.EchoProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
echoRec: Lark.EchoParameters ← NEW[Lark.EchoParameterRecord];
echoRec.buffer ← buffer;
echoRec.buffer1Controlled ← controlIn1;
echoRec.buffer2Controlled ← controlIn2;
echoRec.decayTime ← decayTime;
echoRec.gain[0] ← g0;
echoRec.gain[1] ← g1;
echoRec.gain[2] ← g2;
echoRec.gain[3] ← g3;
echoRec.gain[4] ← g4;
IF self.registered THEN self.lark.EchoSupression[shh: self.shhh, echo: echoRec];
};
MySetHostProc: NewLark.SetHostProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
IF self.registered THEN self.lark.SetHostNumber[shh: self.shhh, host: host];
};
MySocketProc: NewLark.SocketProc = {
spec: Lark.ConnectionSpec;
SELECT buffer
FROM
in1 => spec ← self.tx1;
in2 => spec ← self.tx2;
out1 => spec ← self.rx1;
out2 => spec ← self.rx2;
out3 => spec ← self.rx3;
ENDCASE => RETURN;
IF buffer = in1 OR buffer = in2 THEN spec.remoteSocket ← socket
ELSE spec.localSocket ← socket;
};
MyToneProc: NewLark.ToneProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
waveTableNat:
NAT ←
SELECT waveTable
FROM
dB0 => 0,
dB3 => 1,
dB6 => 2,
dB9 => 3
ENDCASE => 4;
IF self.registered THEN [] ← self.lark.GenerateTones[shh: self.shhh, f1: f1, f2: f2, on: on, off: off, modulation: modulation, repetitions: repetitions, waveTable: waveTableNat, queueIt: queueIt, notify: IF notify THEN [tones, 'T] ELSE [nothing, 0C]];
};
MyTuneProc: NewLark.TuneProc =
TRUSTED {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
waveTableNat: NAT ← 0;
IF self.registered
THEN {
ToneOn: PlayOps.BeepProc
--PROC[beepFreq: CARDINAL, beepTime: LONG CARDINAL]-- = {
[] ← self.lark.GenerateTones[shh: self.shhh, f1: beepFreq, f2: 0, on: beepTime, off: 0, modulation: 0, repetitions: 1, waveTable: waveTableNat, queueIt: TRUE, notify: [nothing, 0C]];
};
PlayOps.PlayString[music: music, file: file, random: FALSE, beepProc: ToneOn];
};
};
MyResetProc: NewLark.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
self.msg.PutF["ResetCommand\n"];
IF self.registered THEN self.lark.Reset[self.shhh, self.rName];
};
MyStatusProc: NewLark.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
res: CARDINAL ← 0;
se: Lark.StatusEvents;
self.msg.PutF["StatusStatus => ["];
IF self.registered
THEN
DO
[next: res, events: se] ← self.lark.WhatIsStatus[shh: self.shhh, which: res];
self.msg.PutF["(%d)[%z]", IO.card[res], IO.refAny[se]];
IF res = 0 THEN EXIT;
ENDLOOP;
self.msg.PutF["]\n"];
};
MyConnStatusProc: NewLark.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
res: CARDINAL ← 0;
conn: Lark.ConnectionSpec;
self.msg.PutF["ConnectStatus => ["];
IF self.registered
THEN
DO
[next: res, specs: conn] ← self.lark.WhatAreConnections[shh: self.shhh, which: res];
self.msg.PutF["(%d)[%z]", IO.card[res], IO.refAny[conn]];
IF res = 0 THEN EXIT;
ENDLOOP;
self.msg.PutF["]\n"];
};
MyRegisterProc: NewLark.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
self.msg.PutF["PleaseRegisterCommand"];
IF self.registered THEN self.lark.PleaseRegister[self.shhh];
self.msg.PutF["\n"];
};
MyToneStatusProc: NewLark.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
IF self.registered THEN self.msg.PutF["ToneStatus => [%g]\n", IO.refAny[NEW[BOOLEAN ← self.lark.WhatAreTones[shh: self.shhh]]]];
};
MyQuitProc: NewLark.BProc =
TRUSTED {
self.msg.PutF["Quit\n"];
CleanupProc[self];
};
CleanupProc: NewLark.BProc = {
self.pleaseStop ← TRUE;
};
MySendAllXBar: NewLark.BProc = {
FOR l:
LIST
OF
REF NewLark.BDat ← self.buttons, l.rest
UNTIL l =
NIL
DO
InternalTogProc[l.first];
ENDLOOP;
};
Identify:
PROC [ clientInstance: Rope.
ROPE, netAddress: Lark.Machine ]
RETURNS [ serverRname: Rope.
ROPE, clientRname: Rope.
ROPE ] = {
h: NewLark.LarkHandle;
serverRname ← "Stewart.pa";
clientRname ← Names.InstanceFromNetAddress[netAddress, ".lark"];
h ← FindByName[clientInstance];
IF h =
NIL
THEN {
pf: IOUtils.PFProcs ← IOUtils.CopyPFProcs[NIL];
h ← NEW[NewLark.LarkDataObject];
serialNumber ← serialNumber + 1;
h.handle ← serialNumber;
larkList ← CONS[h, larkList];
h.container ← Containers.Create[info: [name: h.clientInstance, iconic: FALSE]];
h.ts ← TypeScript.Create[info: [ww: 600, wh: 100, parent: h.container]];
Containers.ChildXBound[container: h.container, child: h.ts];
[in: h.in, out: h.out] ← ViewerIO.CreateViewerStreams[name: "NewLark", viewer: h.ts];
h.msg ← h.out;
[] ← IOUtils.SetPFCodeProc[pfProcs: pf, char: 'z, codeProc: MyPrintRef];
[] ← IOUtils.SetPFProcs[stream: h.out, pfProcs: pf];
SetUpXBarViewer[h];
h.cr ←
NEW[NewLark.ControlRecord ← [
InGain1: ,
InGain2: ,
OutGain: ,
PlayFile: MyPlayFile,
Dial: MyDialProc,
Tones: MyToneProc,
Tunes: MyTuneProc,
Reset: MyResetProc,
Status: MyStatusProc,
ConnStatus: MyConnStatusProc,
Register: MyRegisterProc,
ToneStatus: MyToneStatusProc,
Quit: MyQuitProc,
SendAllXBar: MySendAllXBar,
OpenVFS: NewLark.OpenVFS,
CloseVFS: NewLark.CloseVFS,
Playback: NewLark.Playback,
Record: NewLark.Record,
Echo: MyEchoProc,
SetHost: MySetHostProc,
SetSocket: MySocketProc
]];
h.vr ← ViewRec.ViewRef[agg: h.cr, specs: ViewRec.BindAllOfATypeFromRefs[rec: h.cr, handle: NEW[NewLark.LarkHandle ← h]], viewerInit: [wy: h.xbv.wy + h.xbv.wh, ww: h.container.cw, parent: h.container], createOptions: [minRecordWidth: 400]];
h.recordViewer ← ViewRec.RVQuaViewer[h.vr];
h.container.name ← clientInstance;
h.tsA ← TypeScript.Create[info: [wy: h.recordViewer.wy + h.recordViewer.wh, ww: 600, wh: 100, parent: h.container]];
Containers.ChildXBound[container: h.container, child: h.tsA];
[in: h.inA, out: h.outA] ← ViewerIO.CreateViewerStreams[name: "Console", viewer: h.tsA, editedStream: FALSE];
EditedStream.SetEcho[self: h.inA, echoTo: NIL];
h.tsB ← TypeScript.Create[info: [wy: h.tsA.wy + h.tsA.wh, ww: 600, wh: 100, parent: h.container]];
Containers.ChildXBound[container: h.container, child: h.tsB];
[in: h.inB, out: h.outB] ← ViewerIO.CreateViewerStreams[name: "Auxiliary", viewer: h.tsB, editedStream: FALSE];
EditedStream.SetEcho[self: h.inB, echoTo: NIL];
h.procA ← FORK LarkTTY[h, TRUE]; -- start console user.
TRUSTED { Process.Detach[h.procA]; };
h.procB ← FORK LarkTTY[h, FALSE]; -- start auxiliary user.
TRUSTED { Process.Detach[h.procB]; };
};
h.rName ← NIL;
h.address ← netAddress;
h.serverRname ← serverRname;
h.clientRname ← clientRname;
h.clientInstance ← clientInstance;
h.msg.PutF["Identify[%g, %g, %g]\n", IO.rope[h.serverRname], IO.rope[h.clientRname], IO.rope[h.clientInstance]];
};
FindByName:
PROC [instance: Rope.
ROPE]
RETURNS [h: NewLark.LarkHandle] = {
FOR l:
LIST
OF NewLark.LarkHandle ← larkList, l.rest
UNTIL l =
NIL
DO
IF Rope.Equal[instance, l.first.clientInstance, FALSE] THEN RETURN [l.first];
ENDLOOP;
RETURN[NIL];
};
FindBySmartsHandle:
PROC [smartsHandle: LarkSmarts.SmartsHandle]
RETURNS [NewLark.LarkHandle] = {
FOR l:
LIST
OF NewLark.LarkHandle ← larkList, l.rest
UNTIL l =
NIL
DO
IF smartsHandle = l.first.handle THEN RETURN [l.first];
ENDLOOP;
RETURN [NIL];
};
SetupConnPair:
PROC [txBuf, rxBuf: Lark.VoiceBuffer, txAdr, rxAdr: Lark.Machine]
RETURNS [tx, rx: Lark.ConnectionSpec] = {
tsoca: CARDINAL = 1234;
rsoca: CARDINAL = 543;
tx ← NEW[Lark.ConnectionSpecRec];
rx ← NEW[Lark.ConnectionSpecRec];
tx.protocol ← rx.protocol ← Lark.Protocol[interactive];
tx.encoding ← rx.encoding ← Lark.Encoding[muLaw];
tx.blankA ← rx.blankA ← 0;
tx.sampleRate ← rx.sampleRate ← 8000;
tx.packetSize ← rx.packetSize ← 160;
tx.blankB ← rx.blankB ← 0;
tx.buffer ← txBuf;
tx.blankC ← rx.blankC ← 0;
tx.keyIndex ← 1;
tx.localSocket ← [txAdr.net, txAdr.host, [tsoca, LOOPHOLE[txBuf]]];
tx.remoteSocket ← [rxAdr.net, rxAdr.host, [rsoca, LOOPHOLE[rxBuf]]];
rx.buffer ← rxBuf;
rx.keyIndex ← 0;
rx.localSocket ← [rxAdr.net, rxAdr.host, [rsoca, LOOPHOLE[rxBuf]]];
rx.remoteSocket ← [txAdr.net, txAdr.host, [tsoca, LOOPHOLE[txBuf]]];
};
RegisterArgs:
TYPE =
RECORD [
shh: LarkSmarts.SHHH,
oldSmartsID: LarkSmarts.SmartsHandle,
oldEpoch: LarkSmarts.Epoch,
netAddress: Lark.Machine,
model: Lark.LarkModel,
instance: Rope.ROPE
];
Register:
PUBLIC
PROC [
shh: LarkSmarts.SHHH←, -- encrypts connection
oldSmartsID: LarkSmarts.SmartsHandle ← LarkSmarts.nullHandle,
oldEpoch: LarkSmarts.Epoch ← BasicTime.nullGMT,
netAddress: Lark.Machine, -- machine name for registering Lark
model: Lark.LarkModel←,
authenticated: BOOL←FALSE,
clientInstance: Rope.ROPE -- obtained from agent
] RETURNS [ smartsID: LarkSmarts.SmartsHandle, epoch: LarkSmarts.Epoch ] = {
ra:
REF RegisterArgs ←
NEW[RegisterArgs ← [
shh: shh,
oldSmartsID: oldSmartsID,
oldEpoch: oldEpoch,
netAddress: netAddress,
model: model,
instance: clientInstance
]];
h: NewLark.LarkHandle ← FindBySmartsHandle[oldSmartsID];
IF h #
NIL
THEN {
h.msg.PutF["ReRegisterByHandle[instance; %g]\n", IO.rope[clientInstance]];
RETURN [oldSmartsID, oldEpoch];
};
[] ← Identify[clientInstance: clientInstance, netAddress: netAddress];
h ← FindByName[clientInstance];
h.msg.PutF["New Register[instance; %g]\n", IO.rope[clientInstance]];
h.shhh ←
RPC.StartConversation[caller: Names.CurrentRName[], callee: h.clientRname, key: Names.CurrentPasskey[], level: CBCCheck !
RPC.AuthenticateFailed =>
TRUSTED {
h.msg.PutF["AuthenticateFailed: %g\r", IO.refAny[NEW[RPC.AuthenticateFailure ← why]]];
h.shhh ← RPC.unencrypted;
CONTINUE;
}; ];
h.address ← netAddress;
[tx: h.tx1, rx: h.rx1] ← SetupConnPair[txBuf: in1, rxBuf: out1, txAdr: netAddress, rxAdr: netAddress];
[tx: h.tx2, rx: h.rx2] ← SetupConnPair[txBuf: in2, rxBuf: out2, txAdr: netAddress, rxAdr: netAddress];
h.rx3 ← SetupConnPair[txBuf: in1, rxBuf: out3, txAdr: netAddress, rxAdr: netAddress].rx;
h.model ← model;
h.instance ← clientInstance;
smartsID ← h.handle;
epoch ← BasicTime.Now[];
IF
NOT h.registered
THEN {
h.process ← FORK LarkProc[h]; -- start Diagnostic user.
TRUSTED { Process.Detach[h.process]; };
};
RecordEvent:
PUBLIC
PROC [ shh: LarkSmarts.
SHHH, smartsID: LarkSmarts.SmartsHandle, whatHappened: Lark.StatusEvents ]
RETURNS [success:
BOOL]= {
h: NewLark.LarkHandle ← FindBySmartsHandle[smartsID];
FOR i:
NAT
IN [0..whatHappened.length)
DO
SELECT whatHappened.e[i].device
FROM
keyboard => h.outA.PutChar[whatHappened.e[i].event ! IO.Error => CONTINUE];
auxiliaryKeyboard => h.outB.PutChar[whatHappened.e[i].event ! IO.Error => CONTINUE];
ENDCASE => InterpretEvent[h, whatHappened.e[i]];
ENDLOOP;
RETURN[TRUE];
};
What: SIGNAL = CODE;
InterpretEvent:
PUBLIC
PROC[h: NewLark.LarkHandle, event: Lark.StatusEvent] = {{
ENABLE What => GOTO GiveUp;
OnOff:
PUBLIC
PROC[r: Rope.
ROPE, e: Lark.Event] = {
h.msg.PutRope[r];
IF e = Lark.enabled THEN h.msg.PutRope[" On\n"]
ELSE IF e = Lark.disabled THEN h.msg.PutRope[" Off\n"]
ELSE SIGNAL What;
};
SELECT event.device
FROM
speakerSwitch => OnOff["Speaker box Switch", event.event];
ringDetect => OnOff["Ring Detector", event.event];
hookSwitch => OnOff["Telephone Hookswitch", event.event];
tones => OnOff["Tone ", event.event];
touchPad =>
SELECT event.event
FROM
IN [Lark.b0..Lark.b9] => h.msg.PutF["DTMF %g\n", IO.char[event.event - '\200 + '0]];
IN [Lark.bA..Lark.bD] => h.msg.PutF["DTMF %g\n", IO.char[event.event - '\212 + 'A]];
Lark.bStar => h.msg.PutRope["DTMF *\n"];
Lark.bThorp => h.msg.PutRope["DTMF #\n"];
Lark.disabled => h.msg.PutRope["DTMF up\n"];
ENDCASE => GOTO GiveUp;
ENDCASE => GOTO GiveUp;
EXITS
GiveUp => h.msg.PutF[" Event(%z)\n", IO.refAny[NEW[Lark.StatusEvent ← event]]];
}
};
EventRope:
PUBLIC
PROC[shh: LarkSmarts.
SHHH←, smartsID: LarkSmarts.SmartsHandle←, time:
CARDINAL, device: Lark.Device, events: LarkSmarts.
ROPE]
RETURNS [success:
BOOL] = {
h: NewLark.LarkHandle ← FindBySmartsHandle[smartsID];
ev: Lark.StatusEvent ← [time, device, '\000];
SELECT device
FROM
keyboard => h.outA.PutRope[events ! IO.Error => CONTINUE];
auxiliaryKeyboard => h.outB.PutRope[events ! IO.Error => CONTINUE];
ENDCASE =>
FOR i:
INT
IN [0..events.Length[])
DO
ev.event ← events.Fetch[i];
InterpretEvent[h, ev];
ENDLOOP;
RETURN[TRUE];
};
Login:
PUBLIC
PROC[shh: LarkSmarts.
SHHH←, smartsID: LarkSmarts.SmartsHandle←, authenticated:
BOOL←
TRUE] = {
h: NewLark.LarkHandle ← FindBySmartsHandle[smartsID];
h.msg.PutF["Login, authenticated = %g\n", IO.bool[authenticated]];
};
LarkTTY:
PROC [self: NewLark.LarkHandle, console:
BOOL] = {{
in, out: IO.STREAM;
c: CHAR;
IF console
THEN {
in ← self.inA;
out ← self.outA;
}
ELSE {
in ← self.inB;
out ← self.outB;
};
DO
ENABLE {
IO.Error => TRUSTED { GOTO Cleanup; };
RPC.CallFailed =>
TRUSTED {
out.PutF["\nCallFailed: %g\n", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
c ← in.GetChar[];
IF self.registered
THEN {
IF console THEN SendCommand[self, Lark.Device[keyboard], c]
ELSE SendCommand[self, Lark.Device[auxiliaryKeyboard], c];
};
ENDLOOP;
};
EXITS
Cleanup => NULL;
};
LarkProc:
PROC [self: NewLark.LarkHandle] = {{
Process.Pause[Process.SecondsToTicks[1]]; -- let Register results settle.
self.lark ← LarkRpcControl.ImportNewInterface[interfaceName: [ type: "Lark.lark", instance: self.instance ] !
RPC.ImportFailed =>
TRUSTED {
self.msg.PutF["ImportFailed: %g\r", IO.refAny[NEW[RPC.ImportFailure ← why]]];
CleanupProc[self];
GOTO Cleanup;
}];
This here's the main loop.
self.msg.PutF["Lark ready for business.\n"];
self.registered ← TRUE;
DO
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
GOTO Cleanup;
};
};
Process.Pause[Process.MsecToTicks[100]];
compare old and new control records
IF self.cmds # NIL THEN SendCommands[self];
IF self.pleaseStop THEN GOTO Cleanup;
ENDLOOP; -- for example.
EXITS
Cleanup => {
self.msg.PutF["Cleanup\n"];
self.registered ← FALSE;
self.pleaseStop ← FALSE;
};
};
};
SendCommands:
PROC [self: NewLark.LarkHandle] = {
revcmds: LIST OF REF ANY ← NIL;
length: INT ← 0;
len: INT ← 0;
event: REF Lark.CommandEvent;
evs: Lark.CommandEvents ← NIL;
revcmds ← self.cmds;
self.cmds ← NIL;
revcmds ← List.Reverse[revcmds];
DO
length ← List.Length[revcmds];
IF length < 1 THEN EXIT;
len ← IF length > Lark.Passel.LAST THEN Lark.Passel.LAST ELSE length;
evs ← NEW[Lark.CommandEventSequence[len]];
length ← length - evs.length;
FOR j:
INT
IN [0..evs.length)
DO
event ← NARROW[revcmds.first];
evs.e[j] ← event^;
revcmds ← revcmds.rest;
ENDLOOP;
IF self.registered THEN self.lark.Commands[shh: self.shhh, events: evs];
ENDLOOP;
};
SendBool:
PROC [self: NewLark.LarkHandle, d: Lark.Device, b:
BOOL] = {
SendCommand[self, d, IF b THEN Lark.enabled ELSE Lark.disabled];
};
SendCommand:
PROC [self: NewLark.LarkHandle, d: Lark.Device, e: Lark.Event] = {
event: REF Lark.CommandEvent ← NEW[Lark.CommandEvent ← [device: d, event: e]];
self.cmds ← CONS[event, self.cmds];
};
ConnectCommand:
PROC [self: NewLark.LarkHandle, ch:
NAT, tx:
BOOL, on:
BOOL] = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
};
IF self.registered
THEN {
onOrOff: Rope.ROPE ← IF on THEN "Connect" ELSE "Disconnect";
txOrRx: Rope.ROPE ← IF tx THEN "transmit" ELSE "receive";
self.msg.PutF["%g %g Channel %d\n", IO.rope[onOrOff], IO.rope[txOrRx], IO.int[ch]];
IF tx
AND ch = 3
THEN {
transmit to VFS
IF self.tx3 =
NIL
THEN {
self.msg.PutF["Open VFS first\n"];
RETURN;
};
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.tx3]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.tx3.buffer];
RETURN;
};
IF tx
AND ch = 2
THEN {
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.tx2]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.tx2.buffer];
RETURN;
};
IF tx
AND ch = 1
THEN {
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.tx1]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.tx1.buffer];
RETURN;
};
IF
NOT tx
AND ch = 3
THEN {
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.rx3]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.rx3.buffer];
RETURN;
};
IF
NOT tx
AND ch = 2
THEN {
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.rx2]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.rx2.buffer];
RETURN;
};
IF
NOT tx
AND ch = 1
THEN {
IF on THEN self.lark.Connect[shh: self.shhh, specs: self.rx1]
ELSE self.lark.Disconnect[shh: self.shhh, buffer: self.rx1.buffer];
RETURN;
};
};
};
RopeToDTMF:
PROC [r: Rope.
ROPE]
RETURNS [ce: Lark.CommandEvents] = {
len: INT ← MIN[Lark.Passel.LAST, r.Length[]];
ce ← NEW[Lark.CommandEventSequence[len]];
FOR j:
INT
IN [0..ce.length)
DO
ce.e[j] ← [touchPad,
SELECT r.Fetch[j]
FROM
IN ['0..'9] => LOOPHOLE[128 + r.Fetch[j] - '0],
IN ['a..'d] => LOOPHOLE[138 + r.Fetch[j] - 'a],
IN ['A..'J] => LOOPHOLE[(r.Fetch[j] - 'A + 1) * 10],
'* => Lark.bStar,
'# => Lark.bThorp
ENDCASE => ' ];
ENDLOOP;
};
printDepth: INT ← 8;
printWidth: INT ← 64;
MyPrintRef: IOUtils.PFCodeProc =
TRUSTED {
PrintTV.Print[tv: AMBridge.TVForReferent[LOOPHOLE[NARROW[val, IO.Value[refAny]].value]], put: stream, depth: printDepth, width: printWidth];
};
SpOrCR: EditedStream.DeliverWhenProc =
TRUSTED {
IF char = ' OR char = '\n THEN RETURN [TRUE, TRUE];
RETURN [TRUE, FALSE];
};
LarkSmartsRpcControl.ExportInterface[
interfaceName: [ type: "LarkSmarts.Lark", instance: UserProfile.Token[key: "NewLarkInstance", default: "NULL.Lark"]],
user: Names.CurrentRName[],
password: Names.CurrentPasskey[]
];
}.
May 30, 1984 11:40:55 am PDT, Stewart, Cedar 5, December
Edited on May 30, 1984 11:40:18 am PDT, by Pier
added UserProfile call to get NewLarkInstance
changes to: DIRECTORY, UserProfile, LarkSmartsRpcControl
Edited on June 19, 1984 12:35:34 pm PDT, by Swinehart
changes to: DIRECTORY, Identify