LarkTestImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Last modified by D. Swinehart, November 21, 1985 2:25:13 pm PST
Last modified by L. Stewart, December 27, 1983 4:58 pm
Last Edited by: Pier, May 30, 1984 11:41:13 am PDT
Last Edited by: PolleZ, May 7, 1985 2:38:35 pm 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,
LarkSmarts,
LarkSmartsRpcControl USING [ ExportInterface ],
LarkTest,
LarkTestMonitorImpl,
List USING [ Length, Reverse ],
Multicast USING [ TurnOnMulticastForNet, HandleMulticast, StopHandlingMulticast ],
MulticastRpcControl,
Names USING [ CurrentPasskey, CurrentRName, InstanceFromNetAddress ],
PrintTV USING [Print],
Process USING [ Detach, MsecToTicks, Pause, SecondsToTicks ],
PupTypes USING [ PupAddress, PupHostID, PupNetID ],
Rope USING [Equal, Fetch, Length, ROPE],
RPC USING [AuthenticateFailed, AuthenticateFailure, CallFailed, CallFailure, ImportFailed, ImportFailure, StartConversation, unencrypted],
TypeScript USING [Create],
UserProfile USING [Token],
ViewerIO USING [CreateViewerStreams],
ViewRec USING [BindAllOfATypeFromRefs, RVQuaViewer, ViewRef],
VTables USING [Create, GetTableEntry, Install, SetTableEntry, VTable];
LarkTestImpl:
CEDAR
MONITOR
LOCKS root
IMPORTS
AMBridge, BasicTime, Buttons, Containers, EditedStream, IO, IOUtils, LarkRpcControl, LarkSmartsRpcControl, LarkTest, root: LarkTestMonitorImpl, List, Multicast, MulticastRpcControl, Names, PrintTV, Process, Rope, RPC, TypeScript, UserProfile, ViewerIO, ViewRec, VTables
EXPORTS LarkSmarts, LarkTest
SHARES LarkTestMonitorImpl = {
larkList: LIST OF LarkTest.LarkHandle;
serialNumber: LarkSmarts.SmartsHandle ← 1;
multicastImported: BOOL←FALSE;
This stuff handles the Crossbar viewer (which is a VTable)
TogProc: Buttons.ButtonProc =
TRUSTED {
bd: REF LarkTest.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 LarkTest.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 LarkTest.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: LarkTest.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 LarkTest.BDat;
xbv: VTables.VTable;
SetUpBDat:
PROC [row:
NAT, column:
NAT, name: Rope.
ROPE, bd:
REF LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.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[LarkTest.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 3, name: "TX1", bd: bd, proc: ConnProc];
bd ← NEW[LarkTest.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 4, name: "TX2", bd: bd, proc: ConnProc];
bd ← NEW[LarkTest.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 5, name: "VFS-TX", bd: bd, proc: ConnProc];
bd ← NEW[LarkTest.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 6, name: "RX1", bd: bd, proc: ConnProc];
bd ← NEW[LarkTest.BDat ← [h: self, value: FALSE]];
SetUpBDat[row: 10, column: 7, name: "RX2", bd: bd, proc: ConnProc];
bd ← NEW[LarkTest.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 LarkTest.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: LarkTest.PlayFileProc =
TRUSTED {
LarkTest.PlayFile[fileName: fileName, him: self.rx1.localSocket];
};
MyDialProc:
ENTRY LarkTest.DialProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
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:
ENTRY LarkTest.EchoProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
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];
};
MyMulticastOnProc:
ENTRY LarkTest.MulticastOnProc = {
ENABLE UNWIND=>NULL;
DoMulticastProc[self, $on, listeningTo];
};
MyMulticastOffProc:
ENTRY LarkTest.MulticastOffProc = {
ENABLE UNWIND=>NULL;
DoMulticastProc[self, $off];
};
DoMulticastProc:
INTERNAL
PROC[
self: LarkTest.LarkHandle, state: LarkTest.MulticastState, listeningTo: PupTypes.PupHostID←[0]]={
ENABLE
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["Multicast call failed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
multicastImported ← FALSE;
CONTINUE;
};
net: PupTypes.PupNetID = self.address.net;
realHost: PupTypes.PupHostID = self.address.host;
ok: BOOL←TRUE;
IF ~multicastImported
THEN {
multicastImported ← TRUE;
MulticastRpcControl.ImportInterface[interfaceName: [type: "Multicast.lark", instance: "Michaelson.lark"]! RPC.ImportFailed => {multicastImported ← FALSE; CONTINUE} ];
};
IF ~multicastImported
THEN {
self.msg.PutF["Multicast Import Failed, try again later\n"];
RETURN;
};
IF ~Multicast.TurnOnMulticastForNet[net: net]
THEN {
self.msg.PutF["Couldn't enable Multicasting, try again later\r"];
multicastImported ← FALSE;
RETURN;
};
self.multicastState ← state;
SELECT state
FROM
$on => {
ok ← Multicast.HandleMulticast[net: net, realHost: realHost, listeningTo: listeningTo];
IF ~ok
THEN {
self.msg.PutF["Multicast call failed, try again later\r"];
multicastImported ← FALSE;
}
ELSE self.msg.PutF["Multicast On for host %g listening to %g\n",
IO.card[realHost], IO.card[listeningTo]];
};
$off => {
Multicast.StopHandlingMulticast[realHost: realHost];
self.msg.PutF["Multicast Off for host %g\n", IO.card[realHost]];
};
ENDCASE;
};
MySetHostProc:
ENTRY LarkTest.SetHostProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
IF ~self.registered THEN RETURN;
IF host#self.address.host THEN DoMulticastProc[self, $on, host];
self.lark.SetHostNumber[shh: self.shhh, host: [self.address.net, host]];
IF host=self.address.host THEN DoMulticastProc[self, $off];
};
MySocketProc: LarkTest.SocketProcIn1 = {
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 < out1
THEN spec.remoteSocket ← socket
-- in(tx) direction
ELSE spec.localSocket ← socket; -- out(rx) direction
};
MyResetProc:
ENTRY LarkTest.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
self.msg.PutF["ResetCommand\n"];
IF self.registered THEN self.lark.Reset[self.shhh, self.rName];
};
MyStatusProc:
ENTRY LarkTest.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
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:
ENTRY LarkTest.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
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:
ENTRY LarkTest.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
self.msg.PutF["PleaseRegisterCommand"];
IF self.registered THEN self.lark.PleaseRegister[self.shhh];
self.msg.PutF["\n"];
};
MyToneStatusProc:
ENTRY LarkTest.BProc = {
ENABLE {
RPC.CallFailed =>
TRUSTED {
self.msg.PutF["CallFailed: %g\r", IO.refAny[NEW[RPC.CallFailure ← why]]];
CleanupProc[self];
CONTINUE;
};
UNWIND => NULL;
};
IF self.registered THEN self.msg.PutF["ToneStatus => [%g]\n", IO.refAny[NEW[BOOLEAN ← self.lark.WhatAreTones[shh: self.shhh]]]];
};
MyQuitProc: LarkTest.BProc =
TRUSTED {
self.msg.PutF["Quit\n"];
CleanupProc[self];
};
CleanupProc:
PUBLIC LarkTest.BProc = {
self.pleaseStop ← TRUE;
};
MySendAllXBar: LarkTest.BProc = {
FOR l:
LIST
OF
REF LarkTest.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: LarkTest.LarkHandle;
serverRname ← "Stewart.pa";
clientRname ← Names.InstanceFromNetAddress[netAddress, ".lark"];
h ← FindByName[clientInstance];
IF h =
NIL
THEN {
pf: IOUtils.PFProcs ← IOUtils.CopyPFProcs[NIL];
h ← NEW[LarkTest.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: "LarkTest", 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[LarkTest.ControlRecord ← [
InGain1: ,
InGain2: ,
OutGain: ,
PlayFile: MyPlayFile,
Dial: MyDialProc,
Tones: LarkTest.MyToneProc,
Tunes: LarkTest.MyTuneProc,
Reset: MyResetProc,
Status: MyStatusProc,
ConnStatus: MyConnStatusProc,
Register: MyRegisterProc,
ToneStatus: MyToneStatusProc,
Quit: MyQuitProc,
SendAllXBar: MySendAllXBar,
OpenVFS: LarkTest.OpenVFS,
CloseVFS: LarkTest.CloseVFS,
Playback: LarkTest.Playback,
Record: LarkTest.Record,
Echo: MyEchoProc,
SetHost: MySetHostProc,
SetSocketIn1: MySocketProc,
SetSocketIn2: MySocketProc,
SetSocketOut1: MySocketProc,
SetSocketOut2: MySocketProc,
SetSocketOut3: MySocketProc,
PlayString: LarkTest.MyPlayStringProc,
Speech: LarkTest.MySpeechProc,
MulticastOn: MyMulticastOnProc,
MulticastOff: MyMulticastOffProc
]];
h.vr ← ViewRec.ViewRef[agg: h.cr, specs: ViewRec.BindAllOfATypeFromRefs[rec: h.cr, handle: NEW[LarkTest.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: LarkTest.LarkHandle] = {
FOR l:
LIST
OF LarkTest.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 [LarkTest.LarkHandle] = {
FOR l:
LIST
OF LarkTest.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: LarkTest.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 h.registered THEN LarkTest.CleanupForNewRegistration[h];
TRUSTED { Process.Detach[h.process ← FORK LarkProc[h]]; }; -- start Diagnostic user.
RecordEvent:
PUBLIC
PROC [ shh: LarkSmarts.
SHHH, smartsID: LarkSmarts.SmartsHandle, whatHappened: Lark.StatusEvents ]
RETURNS [success:
BOOL]= {
h: LarkTest.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];
LarkTest.HandleProseOutput[whatHappened.e[i].event]; };
auxiliaryKeyboard => h.outB.PutChar[whatHappened.e[i].event ! IO.Error => CONTINUE];
ENDCASE => InterpretEvent[h, whatHappened.e[i]];
ENDLOOP;
RETURN[TRUE];
};
EventRope:
PUBLIC
PROC [ shh: LarkSmarts.
SHHH, smartsID: LarkSmarts.SmartsHandle, time:
CARDINAL, device: Lark.Device, events: Rope.
ROPE]
RETURNS [success:
BOOL]= {
This procedure is not invoked by present Lark programs.
RETURN[TRUE];
};
What: SIGNAL = CODE;
InterpretEvent:
PUBLIC
PROC[h: LarkTest.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 => { LarkTest.Ping[event.event]; 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]]];
}
};
Login:
PUBLIC
PROC[shh: LarkSmarts.
SHHH←, smartsID: LarkSmarts.SmartsHandle←, authenticated:
BOOL←
TRUE] = {
h: LarkTest.LarkHandle ← FindBySmartsHandle[smartsID];
h.msg.PutF["Login, authenticated = %g\n", IO.bool[authenticated]];
};
LarkTTY:
PROC [self: LarkTest.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: LarkTest.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;
multicastImported ← FALSE;
LarkTest.Ping['\177]; -- Terminate iterations.
};
};
};
SendCommands:
PROC [self: LarkTest.LarkHandle] = {
revcmds: LIST OF REF ANY ← NIL;
length: INT ← 0;
len: INT ← 0;
event: REF Lark.CommandEvent;
evs: Lark.CommandEvents ← NIL;
SendOne:
ENTRY
PROC = {
IF self.registered THEN self.lark.Commands[shh: self.shhh, events: evs]; };
GetCmds:
ENTRY
PROC = {
revcmds ← self.cmds; self.cmds ← NIL; };
GetCmds[]; -- win races
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;
SendOne[];
ENDLOOP;
};
SendBool:
PROC [self: LarkTest.LarkHandle, d: Lark.Device, b:
BOOL] = {
SendCommand[self, d, IF b THEN Lark.enabled ELSE Lark.disabled];
};
SendCommand:
PROC [self: LarkTest.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:
ENTRY PROC [self: LarkTest.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;
};
UNWIND => NULL;
};
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];
};
Main Program
LarkSmartsRpcControl.ExportInterface[
interfaceName: [ type: "LarkSmarts.Lark", instance: UserProfile.Token[key: "LarkTestInstance", default: "NULL.Lark"]],
user: Names.CurrentRName[],
password: Names.CurrentPasskey[]
];
}.
Edited on April 24, 1985 6:10:35 pm PST, by PolleZ
Adding interface to Prose text-to-speech synthesizer
added: textToSpeak, larkNotification, ScheduleToSpeak