<> <> <> <> <<>> DIRECTORY Atom USING [ DottedPairNode, GetPName ], Commander USING [ CommandProc, Register ], Convert USING [ IntFromRope ], IO, LarkPlay USING [ MergeToneSpecs, PlayString, ToneSpec, ToneSpecRec ], LarkSmartsMonitorImpl, MBQueue USING [ QueueClientAction ], NameDB USING [ GetAttribute, SetAttribute ], Nice, Process USING [ Detach, SecondsToTicks, SetTimeout ], RefID USING [ ID, Reseal, Unseal ], RefTab USING [ Create, Fetch, Ref, Store ], Rope USING [ Concat, Equal, Fetch, Length, ROPE ], ThNet USING [ pd ], ThParty USING [ Advance, ConversationInfo, DescribeParty, GetConversationInfo, GetKeyTable, GetPartyInfo, PartyInfo ], ThPartyPrivate USING [ GetCurrentParty ], Thrush USING [ ActionReport, ConvEvent, ConversationID, Credentials, PartyID, PartyType, NB, notReallyInConv, nullConvID, nullID, Reason, ROPE, SHHH, SmartsID, StateID, StateInConv ], ThSmartsPrivate USING [ ConvDesc, ConvDescBody, ConvRequest, ConvRequestBody, EnterLarkState, Fail, LarkInfo, LarkState, OpenConversations, ParseState, QueueLarkAction, SmartsInfo ], ThSmartsRpcControl, Triples USING [ Select ], TU, VoiceUtils USING [ MakeAtom, ProblemFR, ReportFR ] ; LarkSmartsSupImpl: CEDAR MONITOR LOCKS root IMPORTS Atom, Commander, Convert, IO, LarkPlay, root: LarkSmartsMonitorImpl, MBQueue, NameDB, Nice, Process, RefID, RefTab, Rope, ThNet, ThParty, ThPartyPrivate, ThSmartsPrivate, Triples, TU, VoiceUtils EXPORTS ThSmartsPrivate SHARES LarkSmartsMonitorImpl = { OPEN IO; <> ConversationID: TYPE = Thrush.ConversationID; nullConvID: ConversationID=Thrush.nullConvID; ConvDesc: TYPE = ThSmartsPrivate.ConvDesc; ConvEvent: TYPE = Thrush.ConvEvent; Reseal: PROC[r: REF] RETURNS[RefID.ID] = INLINE {RETURN[RefID.Reseal[r]]; }; NB: TYPE = Thrush.NB; OpenConversations: TYPE = ThSmartsPrivate.OpenConversations; PartyID: TYPE = Thrush.PartyID; nullID: RefID.ID = Thrush.nullID; ROPE: TYPE = Thrush.ROPE; SmartsID: TYPE = Thrush.SmartsID; SmartsInfo: TYPE = ThSmartsPrivate.SmartsInfo; StateInConv: TYPE = Thrush.StateInConv; LORA: TYPE = LIST OF REF ANY; PD: TYPE = RECORD [ timeoutNoAction: INTEGER _ 5, doReports: BOOL_FALSE, doNice: BOOL_FALSE ]; pd: REF PD _ NEW[PD_[]]; <> <<>> LarkProgress: PUBLIC ENTRY PROC[ interface: ThSmartsRpcControl.InterfaceRecord, shh: Thrush.SHHH, convEvent: Thrush.ConvEvent ] = { ENABLE UNWIND => NULL; -- RestoreInvariant; <> <> <> <<(For now, when we don't know about that conversation and are already in another)>> <> <<(New conversation and we're idle or it's a conversation we're in already)>> <> convID: ConversationID = convEvent.self.convID; info: SmartsInfo = GetSmartsInfo[smartsID: convEvent.self.smartsID]; cDesc: ConvDesc; reason: Thrush.Reason; cInfo: REF ThParty.ConversationInfo; whatNeedsDoing: WhatNeedsDoing; IF info=NIL THEN { Problem["No Smarts at LarkProgress for SmartsID %g", NIL, card[convEvent.self.smartsID]]; RETURN; }; cDesc _ GetConv[ info, convEvent.self, TRUE ]; IF convEvent.self.partyID = convEvent.other.partyID THEN { -- own state changed NoteNewState[cDesc, convEvent]; -- Report on existing conv. or notification of new one. RETURN; }; <> whatNeedsDoing _ whatNeedsDoingIf[cDesc.situation.self.state][convEvent.other.state]; SELECT whatNeedsDoing FROM $noop, $ntiy => NULL; -- No action is needed, or we don't know what one to take. $imp => ERROR; -- This is supposed to be impossible! $xrep => Problem["Didn't expect state change report", info]; <> $frgt => ForgetConv[cDesc]; <> $invl => { <> Problem["Invalid state transition", info]; []_ChangeState[cDesc: cDesc, state: $failed, reason: $error, comment: "System Error: Invalid state transition"]; }; $idle => { <> IF (cInfo _ GetConversationInfo[cDesc]) = NIL THEN RETURN; -- have already complained reason _ IF convEvent.reason#NIL THEN convEvent.reason ELSE $terminating; IF (cInfo.numParties-cInfo.numIdle) <= 1 THEN []_ChangeState[cDesc, IF reason=$terminating THEN $idle ELSE $failed, reason] ELSE IF cDesc.situation.self.state=$active THEN ResetLarkState[cDesc]; }; $idlerg => { <> IF (cInfo _ GetConversationInfo[cDesc]) = NIL THEN RETURN; -- have already complained reason _ IF convEvent.reason # NIL THEN convEvent.reason ELSE $terminating; IF cInfo.originator = convEvent.other.partyID THEN []_ChangeState[cDesc, IF reason=$terminating THEN $idle ELSE $failed, reason]; }; $rback => IF ~DBInfo[cDesc.situation.self.partyID, $deferringback].value.Equal["true", FALSE] THEN []_ChangeState[cDesc, $ringback]; -- Provide ring-back signal $actv => []_ChangeState[cDesc, $active]; -- Go active (else wait for timeout) $actvd => IF ~DBInfo[cDesc.situation.self.partyID, $deferringback].value.Equal["true", FALSE] THEN []_ChangeState[cDesc, $active]; -- Go active (else wait for timeout) $ckrg => CheckRing[cDesc]; -- We're ringing; Some other party that was ringing has now become active; determine if we should continue ringing. $reac, -- Someone else has entered or returned to active state, while we are active $deac -- Someone else has entered inactive state. => ResetLarkState[cDesc]; ENDCASE => ERROR; }; LarkSubstitution: PUBLIC ENTRY PROC[ interface: ThSmartsRpcControl.InterfaceRecord, shh: Thrush.SHHH, convEvent: Thrush.ConvEvent, oldPartyID: Thrush.PartyID, newPartyID: Thrush.PartyID ] = { ENABLE UNWIND => NULL; -- RestoreInvariant; <> <> info: SmartsInfo = GetSmartsInfo[smartsID: convEvent.self.smartsID]; cDesc: ConvDesc; IF info=NIL THEN { Problem["No Smarts at LarkSubstitution for SmartsID %g", NIL, card[convEvent.self.smartsID]]; RETURN; }; IF (cDesc _ GetConv[ info, convEvent.self ]) = NIL THEN RETURN; NoteNewState[cDesc, convEvent]; }; LarkReportAction: PUBLIC ENTRY PROC[ interface: ThSmartsRpcControl.InterfaceRecord, shh: Thrush.SHHH, report: Thrush.ActionReport ] = { ENABLE UNWIND => NULL; nb: NB; info: SmartsInfo = GetSmartsInfo[smartsID: report.self.smartsID]; cDesc: ConvDesc; IF info=NIL THEN { Problem["No Smarts at LarkSubstitution for SmartsID %g", NIL, card[report.self.smartsID]]; RETURN; }; IF (cDesc _ GetConv[ info, report.self ]) = NIL THEN RETURN; SELECT report.actionClass FROM $keyDistribution => { SELECT report.actionType FROM $newKeys => NULL; ENDCASE => RETURN; [nb, cDesc.keyTable] _ ThParty.GetKeyTable[credentials: report.self]; IF nb#$success THEN { cDesc.keyTable _ NIL; RETURN; }; <> SetLarkState[cDesc, LIST[cDesc.keyTable]]; }; $recording, $playback, $synthesizer => <> SELECT report.actionType FROM $scheduled => cDesc.lastActionID _ report.actionID; $started => NULL; -- always follows $scheduled $finished, $flushed => { IF cDesc.lastActionID = report.actionID AND cDesc.situation.self.state > Thrush.notReallyInConv AND (SELECT cDesc.info.larkInfo.switchState FROM speaker, monitor =>TRUE, ENDCASE =>FALSE) THEN [] _ ChangeState[cDesc, $idle] }; ENDCASE; ENDCASE; }; nextScheduledCheckRef: REF INT _ NEW[INT_0]; LarkCheckIn: PUBLIC ENTRY PROC[ interface: ThSmartsRpcControl.InterfaceRecord, shh: Thrush.SHHH, credentials: Thrush.Credentials, reason: Thrush.Reason, nextScheduledCheck: INT ] = { ENABLE UNWIND => NULL; info: SmartsInfo _ GetSmartsInfo[credentials.smartsID]; -- That's us. IF info=NIL OR info.failed THEN RETURN; <> nextScheduledCheckRef^ _ nextScheduledCheck; ThSmartsPrivate.QueueLarkAction[info.larkInfo, nextScheduledCheckRef]; }; <smarts report>> <> <<The only ones left are those that avoid recursive calls on ThParty.Advance and on NoteNewState. Even those could probably be eliminated with a bit more thought. Like maybe Loop with the resulting ConvEvent. >> <<>> QdNotification: ENTRY PROC [r: REF] ~ { <> ENABLE UNWIND => NULL; -- RestoreInvariant; cDesc: ConvDesc = NARROW[r]; { OPEN now: cDesc.situation.self; rNAtom: ATOM; rName: ROPE; val: ROPE; <> IF cDesc.info.failed THEN { Problem["Notification abandoned", cDesc.info]; RETURN; }; SELECT now.state FROM $notified => NULL; $initiating => { []_ChangeState[cDesc, $failed, $error, "Party remained in initiating state too long"]; RETURN; }; ENDCASE => RETURN; -- Nothing to do any more <> [rName, rNAtom, val] _ DBInfo[now.partyID, $deferanswer]; IF val.Equal["true", FALSE] THEN TRUSTED { Process.Detach[FORK DeferSignalling[cDesc]]; RETURN; }; <> IF HardwareInUse[cDesc] THEN []_ChangeState[cDesc, $idle, $busy] ELSE IF ChangeState[cDesc, IF DBInfo[now.partyID, $autoanswer, rNAtom].value.Equal["true", FALSE] THEN $active ELSE $ringing] = $success AND now.state=$ringing THEN CheckRing[cDesc]; }; }; QdIdle: ENTRY PROC [r: REF] ~ { <> ENABLE UNWIND => NULL; -- RestoreInvariant; cDesc: ConvDesc = NARROW[r]; [] _ ChangeState[cDesc, $idle, cDesc.situation.reason]; }; DeferSignalling: ENTRY PROC [cDesc: ConvDesc] ~ TRUSTED { <> OPEN now: cDesc.situation.self; c: CONDITION; attribute: ATOM _ IF cDesc.situation.self.state = $notified THEN $deferanswer ELSE $deferringback; Process.SetTimeout[@c, Process.SecondsToTicks[pd.timeoutNoAction*(IF attribute=$deferanswer THEN 1 ELSE 2)]]; WAIT c; SELECT cDesc.situation.self.state FROM $notified, $initiating => NULL; ENDCASE=>RETURN; NameDB.SetAttribute[DBInfo[now.partyID].rName, attribute, NIL]; cDesc.info.requests.QueueClientAction[QdNotification, cDesc]; }; <> <> DoAdvance: INTERNAL PROC[convRequest: ThSmartsPrivate.ConvRequest, secondTry: BOOL_FALSE] RETURNS [nb: NB] = { cDesc: ConvDesc = convRequest.cDesc; DO -- for possible stateMismatch loop OPEN now: cDesc.situation.self, desired: convRequest.desiredSituation.self; convEvent: Thrush.ConvEvent; IF now.state=$idle OR now.state = desired.state THEN RETURN[$success]; [nb, convEvent] _ ThParty.Advance[ credentials: now, state: desired.state, reason: convRequest.desiredSituation.reason, comment: convRequest.desiredSituation.comment, reportToAll: shouldReportToAll[desired.state], bilateral: convRequest.bilateral, checkConflict: requiresHardware[desired.state] ]; SELECT nb FROM $success => cDesc.info.NoteNewStateP[cDesc, convEvent]; $stateMismatch => { <> < ringing, but let's see)>> IF secondTry THEN ERROR; -- Don't loop forever cDesc.info.NoteNewStateP[cDesc, convEvent]; secondTry _ TRUE; IF now.state # $idle THEN LOOP; -- Attempt the transition, based on new information. <> }; $partyAlreadyActive, $conferenceConv, $voiceTerminalBusy, $bilateralConv, $voiceTerminalUnavailable, <> $interfaceError => { <> IF secondTry THEN ERROR; -- Don't loop forever IF nb=$interfaceError THEN Problem["Party state-advance yields interface error", cDesc.info]; IF convEvent#NIL THEN cDesc.info.NoteNewStateP[cDesc, convEvent]; <> convRequest.desiredSituation.reason _ $error; convRequest.desiredSituation.comment _ Atom.GetPName[nb]; desired.state _ $idle; IF now.state # $idle THEN [] _ DoAdvance[convRequest, TRUE]; <> }; ENDCASE => { -- $convIdle, $noSuchSmarts, $noSuchParty, $noSuchConv, $notInConv msg: Rope.ROPE = IO.PutFR["Unexpected party state-advance failure, nb=%g", atom[nb]]; IF cDesc#NIL AND cDesc.info#NIL AND cDesc.info.larkInfo#NIL THEN ThSmartsPrivate.Fail[cDesc.info.larkInfo, msg, TRUE] <> <> ELSE { Problem[msg, cDesc.info]; ForgetConv[cDesc]; }; }; EXIT; ENDLOOP; }; <> <> <<>> NoteNewState: PUBLIC INTERNAL PROC[cDesc: ConvDesc, convEvent: ConvEvent] ~ { OPEN now: cDesc.situation.self; nb: NB; larkStateData: LORA _NIL; state: StateInConv _ convEvent.self.state; previousState: StateInConv = cDesc.situation.self.state; <> cDesc.situation _ convEvent^; IF state = previousState THEN RETURN; -- No conceivable value in acting. SELECT state FROM $notified => { -- Somebody else did the notifying. We have to respond. <> cDesc.info.requests.QueueClientAction[QdNotification, cDesc]; }; $initiating => TRUSTED { -- Set timers Process.Detach[FORK DeferSignalling[cDesc]]; }; $ringing, $ringback, $reserved => { larkStateData _ LIST[SetupRingTunes[cDesc]]; IF larkStateData.first=NIL THEN larkStateData_NIL; }; $idle, $neverWas => ForgetConv[cDesc]; $failed => IF HardwareInUse[cDesc] THEN { cDesc.info.requests.QueueClientAction[QdIdle, cDesc]; -- Go away quietly. RETURN; }; $active => { value: ROPE; rNAtom: ATOM; larkStateData _ LIST[ComputeConnection[cDesc]]; [, rNAtom, value] _ DBInfo[now.partyID, $audiosource]; larkStateData _ CONS[NEW[Atom.DottedPairNode_[$audioSource, VoiceUtils.MakeAtom[value]]], larkStateData]; --[[$audioSource,audioSource],...] value _ DBInfo[now.partyID, $transmitonly, rNAtom].value; larkStateData _ CONS[NEW[Atom.DottedPairNode_[$transmitOnly, VoiceUtils.MakeAtom[value]]], larkStateData]; }; ENDCASE; IF state > Thrush.notReallyInConv AND cDesc.keyTable=NIL THEN { <> [nb, cDesc.keyTable] _ ThParty.GetKeyTable[credentials: now]; IF nb # $success THEN cDesc.keyTable_NIL; }; SetLarkState[cDesc, larkStateData]; <> }; CheckRing: PUBLIC INTERNAL PROC [cDesc: ConvDesc] ~ { nb: NB; cInfo: ThParty.ConversationInfo; [nb, cInfo] _ ThParty.GetConversationInfo[convID: cDesc.situation.self.convID]; IF nb # $success THEN { []_ChangeState[cDesc, $failed, $error, "System Error: can't monitor ringing situation"]; RETURN; }; IF cDesc.ringCheckProcess#NIL OR -- Already handling cInfo.numActive = 0 THEN RETURN; -- Not in the interesting situation yet. <> TRUSTED { Process.Detach[FORK RingProcess[cDesc]]; }; }; RingProcess: ENTRY PROC[cDesc: ConvDesc] = { ENABLE UNWIND => { cDesc.ringCheckProcess _ NIL; }; nb: NB; cInfo: ThParty.ConversationInfo; numWaited: INT_0; numToWait: INT_0; condition: CONDITION; TRUSTED { Process.SetTimeout[@condition, Process.SecondsToTicks[1]]; }; WHILE TRUE DO value: ROPE_NIL; valueAtom: ATOM; IF cDesc.info.failed OR cDesc.situation.self.state # $ringing THEN EXIT; [nb, cInfo] _ ThParty.GetConversationInfo[convID: cDesc.situation.self.convID]; IF nb#$success OR cInfo.bilateralConv AND cInfo.numActive>=2 THEN GOTO Idle; <> value _ DBInfo[cDesc.situation.self.partyID, $multiring].value; valueAtom _ VoiceUtils.MakeAtom[value]; SELECT TRUE FROM valueAtom=NIL, value.Length[]=0, valueAtom=$false => numToWait_numWaited; -- quit valueAtom=$true => { numToWait_numWaited+1; }; -- forever value.Fetch[0] IN ['0..'9] => numToWait_Convert.IntFromRope[value]; ENDCASE => numToWait _ numWaited; -- invalid database IF numWaited >= numToWait THEN GOTO Idle; WAIT condition; numWaited _ numWaited+1; REPEAT Idle => []_ChangeState[cDesc, $idle]; -- We're a third wheel. ENDLOOP; cDesc.ringCheckProcess _ NIL; }; <<>> <> ChangeState: PUBLIC INTERNAL PROC[ cDesc: ConvDesc, state: StateInConv _ $idle, reason: Thrush.Reason _ NIL, -- $wontSay comment: ROPE_NIL, bilateral: BOOL_FALSE ] RETURNS [nb: NB _ $noSuchConv] = { convRequest: ThSmartsPrivate.ConvRequest; IF cDesc = NIL THEN { Problem["No cDesc supplied at ChangeState", NIL]; RETURN; }; IF state=$failed THEN { <> IF DBInfo[cDesc.situation.self.partyID, $service].value.Length[]#0 THEN state _ $idle; <> SELECT cDesc.info.larkInfo.switchState FROM $onhook, $speaker, sPEAKER => { cInfo: REF ThParty.ConversationInfo _ GetConversationInfo[cDesc]; IF cInfo=NIL OR cInfo.originator#cDesc.situation.self.partyID THEN state _ $idle; }; ENDCASE; }; IF requiresHardware[state] AND HardwareInUse[cDesc] THEN { state _ $idle; reason _ $error; comment _ "Conflicting use of Lark requested"; }; convRequest _ NEW[ThSmartsPrivate.ConvRequestBody _ [cDesc: cDesc, bilateral: bilateral]]; convRequest.desiredSituation.self.state _ state; convRequest.desiredSituation.reason _ reason; convRequest.desiredSituation.comment _ comment; nb _ DoAdvance[convRequest]; }; <> <> GetConv: PUBLIC INTERNAL PROC[ info: SmartsInfo, credentials: Thrush.Credentials, createOK: BOOL_FALSE ] RETURNS [ cDesc: ConvDesc_NIL ] = --INLINE-- { nb: NB_$success; partyID: PartyID_credentials.partyID; convID: ConversationID _ credentials.convID; SELECT credentials.smartsID FROM nullID, info.smartsID => NULL; ENDCASE=>ERROR; FOR convs: OpenConversations _ info.conversations, convs.rest WHILE convs#NIL DO IF convs.first.situation.self.convID = convID THEN RETURN[convs.first]; ENDLOOP; IF ~createOK THEN { VoiceUtils.ProblemFR["Couldn't find referenced conversation, id= %g", $System, NIL, time[convID]]; RETURN; }; IF partyID=nullID THEN [nb, partyID] _ ThPartyPrivate.GetCurrentParty[smartsID: info.smartsID]; SELECT nb FROM $success => NULL; $noSuchSmarts, $noSuchParty => { VoiceUtils.ProblemFR["Party has apparently failed; damage control.", $System, NIL]; RETURN; }; ENDCASE => ERROR; cDesc _ NEW[ThSmartsPrivate.ConvDescBody_[]]; cDesc.situation.self _ [ convID: convID, smartsID: info.smartsID, partyID: partyID ]; cDesc.info _ info; info.conversations _ CONS[cDesc, info.conversations]; IF pd.doReports THEN ReportFR[" ** NewConv %t %g\n", info, time[convID], TU.RefAddr[info] ]; }; ForgetConv: PUBLIC INTERNAL PROC[cDesc: ConvDesc] = { <> info: SmartsInfo = cDesc.info; convs: OpenConversations _ info.conversations; IF convs=NIL THEN RETURN ELSE IF convs.first=cDesc THEN info.conversations _ convs.rest ELSE FOR cS: OpenConversations _ convs, cS.rest WHILE cS.rest#NIL DO IF cS.rest.first=cDesc THEN { cS.rest _ cS.rest.rest; EXIT; }; ENDLOOP; }; ComputeConnection: PUBLIC INTERNAL PROC[cDesc: ConvDesc] RETURNS [pInfo: ThParty.PartyInfo _ NIL] = { <> <> <> <> <> <> nb: NB; [nb, pInfo] _ ThParty.GetPartyInfo[credentials: cDesc.situation.self, nameReq: $none, allParties: TRUE]; IF nb # $success OR pInfo[0].partyID=0 THEN { Problem["No conversation info, or incomplete", cDesc.info]; pInfo_NIL; RETURN; }; -- This is really bad! }; <<>> <> GetSmartsInfo: PUBLIC PROC[smartsID: SmartsID] RETURNS [info: SmartsInfo_NIL] = { sd: REF _ RefID.Unseal[smartsID]; IF sd#NIL THEN RETURN[NARROW[Triples.Select[$SmartsData, sd, --info--]]]; }; DBInfo: PUBLIC PROC[partyID: Thrush.PartyID, attribute: ATOM_NIL, prevRNAtom: ATOM_NIL] RETURNS [rName: ROPE_NIL, rNAtom: ATOM_NIL, value: ROPE_NIL] = { nb: NB _ $success; rNAtom _ prevRNAtom; IF rNAtom#NIL THEN rName _ Atom.GetPName[rNAtom] ELSE IF partyID#nullID THEN [nb, rName] _ ThParty.DescribeParty[partyID: partyID, nameReq: $current]; IF nb # $success OR rName=NIL THEN RETURN; IF rNAtom=NIL THEN rNAtom _ VoiceUtils.MakeAtom[rName: rName, case: FALSE]; IF attribute#NIL THEN value _ NameDB.GetAttribute[rName, attribute]; }; GetConversationInfo: INTERNAL PROC[cDesc: ConvDesc] RETURNS [cInfo: REF ThParty.ConversationInfo] = { nb: NB; cInfoRecord: ThParty.ConversationInfo; [nb, cInfoRecord] _ ThParty.GetConversationInfo[convID: cDesc.situation.self.convID]; SELECT nb FROM $success => NULL; $noSuchConv => { Problem["Conversation disappeared, can't get ConversationInfo", cDesc.info]; ForgetConv[cDesc]; RETURN[NIL]; }; ENDCASE => ERROR; RETURN[NEW[ThParty.ConversationInfo _ cInfoRecord]]; }; Problem: PROC[comment: ROPE, info: SmartsInfo, v1: IO.Value _ [null[]]] = { VoiceUtils.ProblemFR[Rope.Concat["LarkSmarts(%g): ", comment], $Smarts, info, TU.RefAddr[info], v1]; }; ReportFR: PROC[what: ROPE, info: SmartsInfo, a1, a2, a3: IO.Value_rope[NIL]] = { IF NOT pd.doReports THEN RETURN; VoiceUtils.ReportFR[what, $Lark, info.larkInfo, a1, a2, a3]; }; BeNice: PROC[r: REF, d: INT, info: SmartsInfo] = { IF NOT pd.doNice THEN RETURN; Nice.BeNice[r, d, $Lark, info.larkInfo]; }; <> <<>> ringTunes: RefTab.Ref_RefTab.Create[59]; ringTone: LarkPlay.ToneSpec _ NIL; subduedRingTone: LarkPlay.ToneSpec _ NIL; outsideRingTone: LarkPlay.ToneSpec _ NIL; outsideSubduedRingTone: LarkPlay.ToneSpec _ NIL; outsideRingTune: PUBLIC LarkPlay.ToneSpec _ NIL; outsideRingTuneRope: ROPE _ "@300;G%>G<%G%>G<%G%>G<%G%>G<%G%>*C"; ringTuneDelay: NAT _ 2400; -- ms. delay between tune starts. SetupRingTunes: PROC[cDesc: ConvDesc] RETURNS [toneSpec: LarkPlay.ToneSpec] = { OPEN self: cDesc.situation.self; partyID: Thrush.PartyID = self.partyID; rName: ROPE; originatingPartyID: Thrush.PartyID_nullID; otherRName: ROPE; otherTune: LarkPlay.ToneSpec_NIL; otherType: Thrush.PartyType_$service; -- default value: not telephone, individual, trunk defaultSpec: LarkPlay.ToneSpec_NIL; -- outside or inside ringing nb: NB; pInfo: ThParty.PartyInfo; divisor: NAT _ 1; rope: ROPE; now: BasicTime.GMT = BasicTime.Now[]; ringMode: ATOM; ringDo: ATOM; IF ThNet.pd.ringsInvalid THEN MakeDefaultRingTunes[]; [nb, pInfo] _ ThParty.GetPartyInfo[credentials: [convID: self.convID, partyID: partyID], allParties: self.state#$reserved, nameReq: $current]; IF nb#$success OR pInfo.numParties=0 THEN RETURN[ringTone]; -- not worth messing about rName _ pInfo[0].intendedName; -- self SELECT self.state FROM $reserved => { ringMode _ $r; rope _ NameDB.GetAttribute[rName, $dialtonetune]; ringDo _ IF rope=NIL THEN $false ELSE VoiceUtils.MakeAtom[rName: rope, case: FALSE]; IF ringDo=$false THEN RETURN[NIL] ELSE ringDo _ $tune; }; $ringing => originatingPartyID _ pInfo.conversationInfo.originator; $ringback => NULL; ENDCASE => RETURN[NIL]; IF self.state#$reserved THEN FOR i: NAT IN [1..pInfo.numParties) DO SELECT self.state FROM <> ringback => SELECT pInfo[i].state FROM ringing, notified => { toneSpec _ GetRingTune[pInfo[i].intendedName]; IF toneSpec=NIL THEN RETURN[ringTone]; toneSpec _ NEW[LarkPlay.ToneSpecRec _ toneSpec^]; toneSpec.volume _ ThNet.pd.tonesVolume+2; toneSpec.repeatIndefinitely _ TRUE; RETURN[toneSpec]; }; ENDCASE; <> ringing => IF pInfo[i].partyID = originatingPartyID THEN { otherType _ pInfo[i].type; otherRName _ pInfo[i].intendedName; EXIT; }; ENDCASE=>ERROR; ENDLOOP; SELECT self.state FROM $ringback => RETURN[ringTone]; -- Didn't find another party above. $ringing => { <> defaultSpec _ SELECT otherType FROM $trunk => outsideRingTone, ENDCASE => ringTone; rope _ NameDB.GetAttribute[rName, $ringmode]; ringMode _ IF rope=NIL THEN $r ELSE VoiceUtils.MakeAtom[rName: rope, case: FALSE]; rope _ NameDB.GetAttribute[rName, $dotune]; ringDo _ IF rope=NIL THEN $standard ELSE VoiceUtils.MakeAtom[rName: rope, case: FALSE]; }; ENDCASE; <<>> SELECT ringMode FROM -- $o, $s, $r $o => RETURN[NIL]; $s => RETURN[ IF otherType=$trunk THEN outsideSubduedRingTone ELSE subduedRingTone]; $r => NULL; -- largest case continues below ENDCASE => RETURN[defaultSpec]; -- unknown case; act vanilla <<>> <> SELECT ringDo FROM $false, $standard => RETURN[defaultSpec]; $both => { SELECT otherType FROM $individual, $telephone => { divisor _ 2; rope _ NameDB.GetAttribute[otherRName, $dotune]; ringDo _ IF rope=NIL THEN $standard ELSE VoiceUtils.MakeAtom[rName: rope, case: FALSE]; IF ringDo=$both THEN otherTune _ GetRingTune[otherRName]; <> }; $trunk => otherTune _ outsideRingTune; ENDCASE; }; $true, $tune => NULL; -- continue below ENDCASE => RETURN[defaultSpec]; toneSpec _ GetRingTune[rName]; IF toneSpec=NIL THEN RETURN[defaultSpec]; IF otherTune#NIL THEN toneSpec _ LarkPlay.MergeToneSpecs[toneSpec, otherTune, divisor, ringTuneDelay]; }; GetRingTune: PROC[name: ROPE] RETURNS [ringTune: LarkPlay.ToneSpec_NIL] = { <> nameAtom: ATOM; ringTuneRope: ROPE; IF name=NIL THEN RETURN; ringTuneRope _ NameDB.GetAttribute[name, $ringtune]; IF ringTuneRope=NIL THEN RETURN; nameAtom _ VoiceUtils.MakeAtom[name]; ringTune _ NARROW[ringTunes.Fetch[nameAtom].val]; IF ringTune#NIL AND ringTune.asRope=ringTuneRope THEN RETURN; ringTune _ LarkPlay.PlayString[music: ringTuneRope, file: FALSE, volume: ThNet.pd.defaultRingVolume]; []_ringTunes.Store[nameAtom, ringTune] }; MakeDefaultRingTunes: PROC = { ringTone _ NEW[LarkPlay.ToneSpecRec _ [ repeatIndefinitely: TRUE, volume: ThNet.pd.defaultRingVolume, tones: LIST[LIST[ [f1: 440, f2: 480, on: 2000, off: 4000], [f1: 440, f2: 480, on: 2000, off: 4000]]]]]; outsideRingTone _ NEW[LarkPlay.ToneSpecRec _ [ repeatIndefinitely: TRUE, volume: ThNet.pd.defaultRingVolume, tones: LIST[LIST[ [f1: 440, f2: 480, on: 500, off: 500], [f1: 440, f2: 480, on: 500, off: 4500]]]]]; subduedRingTone _ NEW[LarkPlay.ToneSpecRec _ [ repeatIndefinitely: FALSE, volume: ThNet.pd.defaultRingVolume+ThNet.pd.subduedVolumeInterval, tones: LIST[LIST[[f1: 440, f2: 480, on: 500, off: 0]]] ]]; outsideSubduedRingTone _ NEW[LarkPlay.ToneSpecRec _ [ repeatIndefinitely: FALSE, volume: ThNet.pd.defaultRingVolume+ThNet.pd.subduedVolumeInterval, tones: LIST[LIST[[f1: 440, f2: 480, on: 500, off: 500], [f1: 440, f2: 480, on: 500, off: 0]]] ]]; outsideRingTune _ LarkPlay.PlayString[outsideRingTuneRope, FALSE, ThNet.pd.defaultRingVolume]; ThNet.pd.ringsInvalid _ FALSE; }; <> larkStateForState: ARRAY StateInConv OF ThSmartsPrivate.LarkState _ [ <> silence, idle, errorTone, dialTone, silence, silence, silence, ringBack, ringing, <> silence, talking, silence ]; SetLarkState: INTERNAL PROC[cDesc: ConvDesc, larkStateData: LORA ] = { state: StateInConv _ cDesc.situation.self.state; larkState: ThSmartsPrivate.LarkState _ larkStateForState[state]; larkInfo: ThSmartsPrivate.LarkInfo _ cDesc.info.larkInfo; IF larkInfo.forwardedCall THEN RETURN; -- don't even heed data IF HardwareInUse[cDesc] THEN { IF requiresHardware[state] THEN Problem["Conflicting use of Lark at SetLarkState: ", cDesc.info]; RETURN; }; IF requiresHardware[state] AND cDesc.keyTable#cDesc.info.larkInfo.keyTable AND cDesc.keyTable#NIL THEN larkStateData _ CONS[cDesc.keyTable, larkStateData]; <> IF larkState # larkInfo.larkState THEN SELECT larkState FROM $talking => { <> spec: ThParty.PartyInfo; FOR dL: LORA _ larkStateData, dL.rest WHILE dL#NIL DO WITH dL.first SELECT FROM pI: ThParty.PartyInfo => spec _ pI; ENDCASE; ENDLOOP; IF spec=NIL THEN ERROR; IF spec.conversationInfo.numActive < 2 OR (spec.conversationInfo.bilateralConv AND spec[0].socket.host=spec[1].socket.host) THEN <> larkState _ larkInfo.larkState; -- don't change }; $errorTone => larkState _ SELECT cDesc.situation.reason FROM $busy, $notImportantEnough => $busyTone, $absent, $noCircuits, $noParticular, $notFound, $error => $errorTone, ENDCASE => $errorTone; ENDCASE; ThSmartsPrivate.EnterLarkState[cDesc.info.larkInfo, larkState, larkStateData]; }; ResetLarkState: INTERNAL PROC[cDesc: ConvDesc] = { SetLarkState[cDesc, LIST[ComputeConnection[cDesc]]]; }; HardwareRequired: PUBLIC PROC[cDesc: ConvDesc] RETURNS [required: BOOL] = { RETURN[IF cDesc=NIL THEN FALSE ELSE requiresHardware[cDesc.situation.self.state]]; }; HardwareInUse: PUBLIC PROC[cDesc: ConvDesc] RETURNS [inUse: BOOL] = { <> <> convID: ConversationID _ cDesc.situation.self.convID; info: SmartsInfo _ cDesc.info; IF info=NIL OR convID = nullConvID THEN RETURN[FALSE]; <> FOR convs: OpenConversations _ info.conversations, convs.rest WHILE convs#NIL DO IF (~convs.first.situation.self.convID = convID) AND requiresHardware[convs.first.situation.self.state] THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE]; }; <> requiresHardware: ARRAY StateInConv OF BOOL _ [ <> FALSE, FALSE,TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE ]; shouldReportToAll: ARRAY StateInConv OF BOOL _ [ <> FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE ]; WhatNeedsDoing: TYPE = ATOM; -- { <> <<$noop, $idle, $idlerg, $actv, $rback, $reac, $deac, $ckrg, $frgt, -- cases explained in code>> <<$actvd, -- same as active, except no-op if database is controlling "ringback">> <<$invl, -- considered an invalid request>> <<$xrep, -- we got a report we feel we shouldn't have got>> <<$ntiy, -- not implemented yet>> <<$imp -- this situation should not arise even in the face of invalid requests>> <<};>> whatNeedsDoingIf: ARRAY StateInConv OF ARRAY StateInConv OF WhatNeedsDoing _ [ <> <<>> << never idle failed resrv pars init notif rback ring canAc activ inact -- _ (other)>> [ $imp, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt, $frgt], --neverWas <<(Clip this table to view without these comments.)>> <> [ $imp, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $ntiy ], -- idle [ $imp, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $noop, $ntiy ], -- failed [ $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp ], -- reserved <> [ $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp, $imp ], -- parsing <> [ $imp, $idle, $noop, $invl, $invl, $invl, $xrep, $xrep, $rback,$actvd, $actvd,$actvd ], -- initiating <> [ $imp, $idlerg,$noop,$invl, $invl, $invl, $xrep, $noop, $noop, $ntiy, $noop, $ntiy ], -- notified <> [ $imp, $idle, $noop, $invl, $invl, $invl, $noop, $xrep, $noop, $ntiy, $actv, $ntiy ], -- ringback <> [ $imp, $idlerg,$noop,$invl, $invl, $invl, $xrep, $xrep, $noop, $ntiy, $ckrg, $ntiy ], -- ringing <> [ $imp, $idle, $noop, $invl, $invl, $invl, $xrep, $xrep, $noop, $ntiy, $ckrg, $ntiy ], -- canActivate [ $imp, $idle, $noop, $invl, $invl, $invl, $xrep, $xrep, $noop, $ntiy, $reac, $deac ], -- active [ $imp, $idle, $invl, $invl, $invl, $invl, $xrep, $xrep, $noop, $ntiy, $ntiy, $ntiy ] -- inactive (current ^) ]; <> ViewCmd: Commander.CommandProc = TRUSTED { Nice.View[pd, "Lark PD"]; }; Commander.Register["VuLarkSmarts", ViewCmd, "Program Management variables for Lark Smarts"]; }. <> <> <> <> < autoAnswer>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> < ID, H => Reseal, Log => VoiceUtils>> <> <> <> <> <<>> <> <> <> <<>> <<>> <> <> <> <<>> <> <> <> <> < NameDB>> <> <> <> <> <> <<>> <> <> <> <<>>