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; 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; 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]= { 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; }]; 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]]; 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 { 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: "LarkTestInstance", default: "NULL.Lark"]], user: Names.CurrentRName[], password: Names.CurrentPasskey[] ]; }. ¨LarkTestImpl.mesa Copyright c 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 This stuff handles the Crossbar viewer (which is a VTable) relays This procedure is not invoked by present Lark programs. This here's the main loop. compare old and new control records transmit to VFS Main Program Edited on April 24, 1985 6:10:35 pm PST, by PolleZ Adding interface to Prose text-to-speech synthesizer added: textToSpeak, larkNotification, ScheduleToSpeak Κ«˜Jšœ™šœ Οmœ1™žœ"˜zJšœžœ˜Jšœžœ˜Jšœžœ˜!Jšœžœ˜!J˜7J˜1J˜J˜%J˜$J˜J˜J˜J˜Jšœ1žœ ˜CJšœ2žœ ˜DJ˜J˜Jšœ1žœ ˜CJšœ2žœ ˜DJ˜J˜—šœžœžœ˜Jšœžœ˜Jšœ%˜%J˜J˜J˜Jšœž˜J˜J˜—šŸœžœžœ˜Jšœžœ‘˜0Jšœ=˜=J˜/Jšœ‘$˜?J˜Jšœžœžœ˜Jšœžœ‘˜3JšœžœC˜Lšœžœžœ˜+J˜ Jšœ˜J˜J˜J˜ Jšœ˜J˜—Jšœ9˜9šžœžœžœ˜Jšœ1žœ˜JJšžœ˜J˜—JšœF˜FJšœ˜Jšœ+žœ˜Dšœ žœwžœžœ˜¦Jšœ'žœžœžœ˜VJšœ žœ ˜Jšžœ˜ J˜—J˜J˜fJ˜fJ˜XJ˜Jšœ˜Jšœ˜J˜Jšžœžœ'˜;Jšžœžœ‘˜T˜J˜——š Ÿ œžœžœžœGžœ žœ˜Jšœ6˜6šžœžœžœž˜)šžœž˜$šœ ˜ Jšœ)žœ žœ˜?Jšœ7˜7—Jšœ>žœ žœ˜TJšžœ)˜0—Jšžœ˜—Jšžœžœ˜ J˜J˜—šŸ œžœžœžœ+žœ$žœžœ žœ˜€J™7Jšžœžœ˜ J˜—J˜J˜Jšœžœžœ˜J˜šŸœžœžœ6˜QJšžœ žœ˜šŸœžœžœ žœ˜3Jšœ˜Jšžœžœ˜/Jšžœžœžœ˜6Jšžœžœ˜J˜—šžœž˜Jšœ:˜:Jšœ2˜2Jšœ9˜9JšœF˜Fšœ žœ ž˜#Jšžœ/žœ!˜TJšžœ/žœ!˜TJšœ(˜(Jšœ)˜)Jšœ,˜,Jšžœžœ˜—Jšžœžœ˜—Jšž˜Jšœ%žœžœ˜OJ˜J˜—J˜š Ÿœžœžœžœ6žœžœ˜kJšœ6˜6Jšœ*žœ˜BJ˜—J˜šŸœžœ&žœ˜=Jšœ žœžœ˜Jšœžœ˜šžœ žœ˜J˜J˜J˜—šžœ˜J˜J˜J˜—šžœžœ˜ Jšžœ žœžœ ˜&šžœžœ˜Jšœžœžœžœ˜FJ˜Jšžœ˜ J˜—J˜J˜šžœžœ˜Jšžœ žœ,˜;Jšžœ6˜:J˜—Jšžœ˜—J˜Jšž˜Jšœ žœ˜J˜J˜J˜—šŸœžœ!˜/Jšœ*‘˜Išœnžœžœ˜‹Jšœ$žœžœžœ˜MJ˜Jšžœ ˜ J˜—Jšœ™J˜,Jšœžœ˜šžœžœ˜ šžœžœ˜Jšœ"žœžœžœ˜IJ˜Jšžœ ˜ J˜J˜—J˜(Jšœ#™#Jšžœ žœžœ˜+Jšžœžœžœ ˜%Jšžœ‘˜—Jšž˜˜ J˜Jšœžœ˜Jšœžœ˜Jšœžœ˜J˜.J˜—J˜J˜J˜—šŸ œžœ ˜2Jš œ žœžœžœžœžœ˜Jšœžœ˜Jšœžœ˜ Jšœžœ˜Jšœžœ˜šŸœžœžœ˜Jšžœžœ4˜K—šŸœžœžœ˜Jšœ!žœ˜(—Jšœ ‘ ˜J˜ šž˜J˜Jšžœ žœžœ˜Jš œžœžœžœ žœžœ˜EJšœžœ!˜*J˜šžœžœžœž˜ Jšœžœ˜J˜J˜Jšžœ˜—J˜ Jšžœ˜—J˜J˜—šŸœžœ0žœ˜GJšœžœžœžœ˜@J˜J˜—šŸ œžœ?˜PJšœžœžœ,˜NJšœ žœ˜#J˜J˜—š Ÿœž œ!žœžœžœ˜Wšžœ˜šžœžœ˜Jšœ"žœžœžœ˜IJ˜Jšžœ˜ J˜—Jšžœžœ˜J˜—šžœžœ˜Jš œžœžœžœ žœ˜