<> <> <> <> DIRECTORY IO, Lark USING [ bStar, bThorp, ConnectionSpec, CommandEvent, CommandEvents, CommandEventSequence, Device, disabled, EchoParameters, EchoParameterRecord, enabled, endNum, Event, Hertz, KeyTable, Milliseconds, o3i1, o2i2, o1i1, Passel, reset, SHHH ], LarkSmarts, List USING [ Append ], Log USING [ Problem, Report, SLOG ], Names USING [ GetDefaultDetails, GVDetails, SetGVDetails ], RPC USING [ CallFailed ], Nice, Rope USING [ IsEmpty, Fetch, Length, ROPE ], Process USING [ Detach, EnableAborts, MsecToTicks, SetTimeout ], ThPartyPrivate USING [ SmartsData ], ThSmartsPrivate USING [ ConvDesc, GetConvDesc, HookState, LarkInfo, LarkState, LarkStateSpec, LSwitches, LState, ProgressTones, RingMode, RingEnable, SmartsInfo, TerminalType ], BasicTime USING [ Update, Now, Period ], Thrush USING[ H, Machine, pERROR, ROPE, SHHH, SmartsHandle, ThHandle ], ThNet USING [ pd ], PlayOps USING [ PlayString, BeepProc ] ; LarkOutImpl: CEDAR MONITOR LOCKS info USING info: LarkInfo IMPORTS IO, List, Log, Names, Nice, Process, Rope, RPC, BasicTime, ThNet, Thrush, ThSmartsPrivate, PlayOps EXPORTS ThSmartsPrivate= { OPEN IO; ConvDesc: TYPE = ThSmartsPrivate.ConvDesc; H: PROC[r: REF] RETURNS[Thrush.ThHandle] = INLINE {RETURN[Thrush.H[r]]; }; LarkInfo: TYPE = ThSmartsPrivate.LarkInfo; LarkState: TYPE = ThSmartsPrivate.LarkState; SmartsData: TYPE = ThPartyPrivate.SmartsData; SmartsInfo: TYPE = ThSmartsPrivate.SmartsInfo; SmartsHandle: TYPE = Thrush.SmartsHandle; TerminalType: TYPE = ThSmartsPrivate.TerminalType; ROPE: TYPE = Thrush.ROPE; firstTone: LarkState = FIRST[ThSmartsPrivate.ProgressTones]; bStar: Lark.Event = Lark.bStar; bThorp: Lark.Event = Lark.bThorp; enabled: Lark.Event = Lark.enabled; endNum: Lark.Event = Lark.endNum; disabled: Lark.Event = Lark.disabled; reset: Lark.Event = Lark.reset; PD: TYPE = RECORD [ waitForTelco: CARDINAL _ 500, telcoMinOn: CARDINAL _ 60, telcoMinOff: CARDINAL _ 60, backDoorOH: BOOL_FALSE, echoControl: BOOL_TRUE, tonesVolume: CARDINAL _ 2, defaultRingVolume: CARDINAL _ 2, subduedVolumeInterval: CARDINAL_1, feepVolume: CARDINAL _ 0 ]; pd: REF PD _ NEW[PD_[]]; callTimeoutOK: BOOL_FALSE; -- set to keep Thrush alive when debugging a Lark. LSwitches: TYPE = ThSmartsPrivate.LSwitches; LState: TYPE = ThSmartsPrivate.LState; lDevs: ARRAY LSwitches OF Lark.Device = [ crossBar, offHookRelay, aRelay, sideTone, ringEnable, revertRelay, revertHookswitch, led, spMode, crossBar--random...not used-- ]; lStateForLetter: ARRAY CHAR['A..'Z] OF LSwitches = [ none, none, none, none, none, -- A to E revert, revertHook, hook, aSwitch, hook, none, led, -- F to L none, none, none, none, none, -- M to Q ringO, sideTone, spMode, none, none, none, none, none, -- R to Y xBarAll -- Z -- ]; LSTrans: TYPE = { nop, -- nothing to do set, -- enter specified state (usu. step to recovery) without taking any other actions. zap, zpu, -- reset Lark hardware (u means unconnect first) trk, tkn, -- Set for electronic phone connection (n means silence tones first) frd, frn, -- Trunk-to-network forwarding versions of trk, tkn (frn probably doesn't exist; wrong end <>) tlk, -- like supervision, but must also adjust switching. sup, spn, -- supervision, OK to change connection, key table. (n means silence tones first) ksp, -- key supervision, OK to change key table. sgl, sgn, -- Do trunk signalling (n means silence tones first) fls, -- Flash the phone line rng, rgu, -- Set for ringing (u means unconnect first, r means repeating tone) dia, diu, -- Set for dial tone (tones should be more generic and user-programmable than this!) rbk, rbu, -- Set for ring back bzy, bzu, -- Set for busy tone err, eru, -- Set for error tone sil, -- silence tones, ksp obtains fai, -- enter failed state, by Smarts-level request. Don't complain, just do it. Make sure process goes away. rec, -- move from failed state to recovering state, but complain to caller that Lark has failed, via signal. X -- invalid transition; complain, then remain in present state (go idle?) }; lsTrans: ARRAY LarkState OF ARRAY LarkState OF LSTrans = [[ <> nop, zap, X, X, X, X, X, X, X, X, X, X, X, X, X ],[-- non (none) X, nop, spn, sgl, trk, frd, X, fai, X, rng, nop, dia, rbk, bzy, err ],[-- idl (idle) X, zpu, sup, X, X, X, X, fai, X, rgu, nop, diu, rbu, bzu, eru ],[-- tlk (talking) X, zap, X, ksp, trk, frd, X, fai, X, X, nop, X, X, X, X ],[-- sig (trkSignalling) X, zap, X, X, ksp, X, fls, fai, X, X, nop, X, X, X, X ],[-- trk (trkTalking) X, zpu, X, X, X, sup, X, fai, X, X, nop, diu, rbu, bzu, eru ],[-- fwd (trkForwarding) X, zap, X, X, trk, X, sup, fai, X, X, nop, X, X, X, X ],[-- fls (trkFlash) set, rec, rec, rec, rec, rec, rec, set, set, rec, rec, rec, rec, rec, rec ],[-- fai (failed) set, nop, nop, nop, nop, nop, nop, nop, nop, nop, nop, nop, nop, nop, nop ],[-- rec (recovering) X, zap, spn, sgn, tkn, frn, X, fai, X, ksp, sil, dia, rbk, bzy, err ],[-- rng (ringing) X, zap, tlk, sgl, trk, frd, X, fai, X, rng, ksp, dia, rbk, bzy, err ],[-- shh (silence) X, zap, spn, sgn, tkn, frn, X, fai, X, rng, sil, ksp, rbk, bzy, err ],[-- dia (dialTone) X, zap, spn, sgn, tkn, frn, X, fai, X, rng, sil, dia, ksp, bzy, err ],[-- rbk (ringBack) X, zap, spn, sgn, tkn, frn, X, fai, X, rng, sil, dia, rbk, ksp, err ],[-- bzy (busyTone) X, zap, spn, sgn, tkn, frn, X, fai, X, rng, sil, dia, rbk, bzy, ksp ] -- err (errorTone) ]; <> TDisconn: TYPE = { X, disconnect }; tDisconn: ARRAY LSTrans OF TDisconn = [ -- zpu, rgu, diu, rbu, bzu, eru X, X, X, disconnect, X, X, X, X, X, X, X, X, X, X, X, X, disconnect, X, disconnect, X, disconnect, X, disconnect, X, disconnect, X, X, X, X ]; TDoTones: TYPE = { X, doTones, stopTones }; tDoTones: ARRAY LSTrans OF TDoTones = [ -- rng, rgu, dia, diu, rbk, rbu, bzy, bzu, err, eru; tkn, spn, sgn, sil X, X, X, X, X, stopTones, X, X, X, X, stopTones, X, X, stopTones, X, doTones, doTones, doTones, doTones, doTones, doTones, doTones, doTones, doTones, doTones, stopTones, X, X, X ]; THookState: TYPE = { X, reset, spkrTrans }; tHookState: ARRAY LSTrans OF THookState = [ -- zap, zpu; trk, tkn, tlk, spn, fls, dia, diu, rbk, rbu, bzy, bzu, err, eru, sil X, X, reset, reset, spkrTrans, spkrTrans, X, X, spkrTrans, X, spkrTrans, X, X, X, spkrTrans, X, X, spkrTrans, spkrTrans, spkrTrans, spkrTrans, spkrTrans, spkrTrans, spkrTrans, spkrTrans, spkrTrans, X, X, X ]; TSwitch: TYPE = { X, switch, switchIfDiff }; tSwitch: ARRAY LSTrans OF TSwitch = [-- zap, zpu, trk, tkn, frd, frn, tlk, spn, sgl, sgn, fls; rng, rgu, dia, diu, rbk, rbu, bzy, bzu, err, eru X, X, switch, switch, switch, switch, switch, switch, switch, X, switch, X, switch, switch, switch, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switchIfDiff, switch, X, X, X ]; TSetKey: TYPE = { X, setKey }; tSetKey: ARRAY LSTrans OF TSetKey = [ -- trk, tkn, frd, frn, tlk, sup, spn, ksp, sgl, sgn, fls, rng, rgu, dia, diu, rbk, rbu, bzy, bzu, err, eru, sil X, X, X, X, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, setKey, X, X, X ]; ToneSpec: TYPE = REF ToneSpecRec; ToneSpecRec: TYPE = RECORD [ f1, f2: Lark.Hertz, on, off: Lark.Milliseconds, repetitions: CARDINAL, volume: CARDINAL, delayForCadence: Lark.Milliseconds, oneRing: BOOL, ringTune: ROPE, -- a PlayTune or other tune specification tuneDuration: INTEGER, --duration of ringing tune in millisec notes: LIST OF BeepRef --ringing tune in [frequency, duration] pairs ]; BeepRef: TYPE = REF Beep; Beep: TYPE = RECORD[beepFreq: CARDINAL, beepTime: CARDINAL]; --Hertz and millisecs ADisconnectType: TYPE = { aDisconnect }; aDisconnect: REF ADisconnectType _ NEW[ADisconnectType_aDisconnect]; ANoTonesType: TYPE = { aNoTones }; aNoTones: REF ANoTonesType _ NEW[ANoTonesType_aNoTones]; AFlashWaitType: TYPE = { aFlashWait }; aFlashWait: REF AFlashWaitType _ NEW[AFlashWaitType_aFlashWait]; <> SetRingingParameters: PUBLIC ENTRY PROC[ info: LarkInfo, ringMode: ThSmartsPrivate.RingMode_internal, ringEnable: ThSmartsPrivate.RingEnable_on, ringVolume: CARDINAL_pd.defaultRingVolume, ringInterval: INT_NULL, -- Seconds to disable ringTune: ROPE -- a PlayTune to be played when normal ringing is enabled. See Play.df for documentation ] = { ENABLE UNWIND=>NULL; gvDetails: Names.GVDetails; changeEnable: BOOL; IF info=NIL THEN RETURN; changeEnable _ ringEnable#info.ringEnable; info.ringMode _ ringMode; info.ringEnable _ ringEnable; info.ringVolume _ ringVolume; info.ringTune _ ringTune; info.ringTime _ BasicTime.Update[ BasicTime.Now[], ringInterval]; <> IF ~changeEnable THEN RETURN; SELECT ringEnable FROM on, subdued, off => NULL; ENDCASE => RETURN; IF ([,gvDetails] _ Names.GetDefaultDetails[info.netAddress]).results # ok THEN RETURN; gvDetails.ringEnable _ SELECT ringEnable FROM on=>'R, subdued=>'S, off=>'O, ENDCASE=>'R; gvDetails.larkSpec _ TRUE; Names.SetGVDetails[gvDetails]; }; EnterLarkState: PUBLIC ENTRY PROC[ info: LarkInfo, newState: LarkState, sInfo: SmartsInfo ] = { ENABLE UNWIND=>NULL; EnterLarkSt[info, newState, sInfo]; }; EnterLarkSt: PUBLIC INTERNAL PROC[ info: LarkInfo, newState: LarkState, sInfo: SmartsInfo ]={ ENABLE UNWIND=>NULL; newSpec: LIST OF ThSmartsPrivate.LarkStateSpec = LIST[[newState, sInfo]]; trans: LSTrans _ lsTrans[info.larkState][newState]; oldState: LarkState = info.larkState; cDesc: ConvDesc_NIL; keyTable: Lark.KeyTable; spec: Lark.ConnectionSpec; f1, f2: Lark.Hertz_0; on, off: Lark.Milliseconds_0; repetitions: CARDINAL_0; delayForCadence: Lark.Milliseconds_0; volume: CARDINAL_pd.tonesVolume; -- what else? sw, oneRing: BOOL_FALSE; echoAction: REF_NIL; <> SELECT trans FROM nop => RETURN; -- Certifiably nothing at all to do, or inappropriate time to do it. set => { info.larkState_newState; RETURN; }; X => { Log.Problem["Invalid LarkState Transition", $Lark, info]; RETURN; }; rec => { info.larkState_recovering; LarkFailed[sInfo]; --RETURN--}; fai => { info.larkState _ failed; Log.Problem["Lark failure requested by server", $Lark, info]; info.larkProcess _ NIL; NOTIFY info.stateChange; -- Be sure process notices failure and disappears. RETURN; }; ENDCASE; info.larkState_newState; IF sInfo#NIL THEN cDesc _ ThSmartsPrivate.GetConvDesc[sInfo]; IF cDesc#NIL THEN { IF cDesc.newKeys THEN keyTable _ cDesc.cState.keyTable; IF cDesc.newSpec THEN spec _ cDesc.cState.spec; }; <> <> SELECT tDisconn[trans] FROM disconnect => { <> IF ThNet.pd.debug THEN Deb[ info, 'd ]; QueueLarkAction[info, aDisconnect]; }; ENDCASE; <> SELECT trans FROM dia, diu => { f1_350; f2_440; on_5000; repetitions_2; }; -- to handset receiver rbk, rbu => { f1_440; f2_480; on_2000; off_4000; repetitions_2; }; bzy, bzu => { f1_480; f2_620; on_500; off_500; repetitions_10; }; err, eru => { f1_480; f2_620; on_250; off_250; repetitions_20; }; rng, rgu => { timedOut: BOOL= BasicTime.Period[from: info.ringTime, to: BasicTime.Now[]] > 0; <> f1_440; f2_480; on_2000; off_4000; repetitions_1; volume_info.ringVolume; IF info.ringMode=trunk THEN { on_600; off_600; repetitions_2; }; SELECT info.ringEnable FROM off => trans _ sil; offTimed => IF timedOut THEN info.ringEnable_on ELSE trans _ sil; subduedTimed => IF timedOut THEN info.ringEnable_on; ENDCASE; SELECT info.ringEnable FROM -- Above select can change values, thus this one. subduedTimed, subdued => { volume _ volume+pd.subduedVolumeInterval; on _ 500; oneRing_TRUE; }; on => IF info.ringMode=trunk THEN delayForCadence_4000; ENDCASE; }; ENDCASE; SELECT tDoTones[trans] FROM doTones => { IF ThNet.pd.debug THEN Deb[ info, 'T ]; QueueLarkAction[info, aNoTones]; --try to cure the dial-tone bug QueueLarkAction[info, NEW[ToneSpecRec_ [f1, f2, on, off, repetitions, volume, delayForCadence, oneRing, IF info.larkState=ringing THEN info.ringTune ELSE NIL, 0, NIL]]]; }; stopTones => { IF ThNet.pd.debug THEN Deb[ info, 't ]; QueueLarkAction[info, aNoTones]; }; ENDCASE; <> <> SELECT tHookState[trans] FROM reset => SELECT info.hookState FROM spkr, monitor => { info.hookState_onhook; info.terminalType_std; }; -- going totally idle ENDCASE; spkrTrans => IF info.hookState=onhook THEN {-- dialtone, direct connect or ringback, Hafra info.hookState _ spkr; info.terminalType _ IF sInfo.larkInfo.radio THEN radio ELSE spkr; }; ENDCASE; -- no state change cases. sw_FALSE; IF info.terminalType#info.lastTerminalType THEN sw_TRUE; SELECT tSwitch[trans] FROM switch => sw_TRUE; switchIfDiff => IF oldState { IF ThNet.pd.debug THEN Deb[info, 'F]; QueueLarkAction[info, RopeToDTMF[sInfo.phoneNumber]]; }; ENDCASE; IF keyTable#NIL THEN SELECT tSetKey[trans] FROM setKey => { IF ThNet.pd.debug THEN Deb[info, 'K]; cDesc.newKeys_FALSE; QueueLarkAction[info, keyTable]; }; ENDCASE; IF spec#NIL THEN SELECT trans FROM sup, spn, tlk, frd, frn => { IF ThNet.pd.debug THEN Deb[info, 'C, int[LOOPHOLE[spec.localSocket.socket]], int[LOOPHOLE[spec.remoteSocket.socket]], card[spec.remoteSocket.net], card[spec.remoteSocket.host]]; cDesc.newSpec_FALSE; QueueLarkAction[info, spec]; }; ENDCASE; IF echoAction#NIL THEN { IF ThNet.pd.debug THEN Deb[info, 'E]; QueueLarkAction[info, echoAction]; }; IF info.newActions=NIL THEN RETURN; IF info.larkProcess=NIL THEN TRUSTED { Process.Detach[info.larkProcess _ FORK LarkSupervisor[ info ]]; }; NOTIFY info.stateChange; Log.SLOG[100000B]; }; LarkFailed: PUBLIC ERROR [sInfo: SmartsInfo] = CODE; <<***************** Internal Procedures ********************>> <> <", QuickState[newState]], $LarkDetailed, info];>> <<>> LarkSupervisor: PROCEDURE[ info: LarkInfo ] = { <> <> <> <> ENABLE UNWIND => NULL; continuingTones: ToneSpec_NIL; waitTime: INTEGER _ 10000; req: REF; GetAction: ENTRY PROC [info: LarkInfo] RETURNS [ref: REF_NIL] = INLINE { IF info.larkState=failed OR info.larkState=recovering THEN { info.newActions_NIL; continuingTones_NIL; } ELSE ref_DequeueLarkAction[info]; }; TRUSTED { Process.EnableAborts[@info.stateChange]; }; WHILE (req_GetAction[info])#NIL OR continuingTones#NIL DO { -- Deal with communications failure. ENABLE { RPC.CallFailed => IF callTimeoutOK THEN RESUME ELSE { Log.Problem["Call Failed", $Lark, info]; GOTO Failed; }; ABORTED => { Log.Problem["LarkSupervisor aborted", $Lark, info]; GOTO Failed; }; ANY => { Log.Problem["Unknown Lark failure", $Lark, info]; GOTO Failed; }; }; flashWait: BOOL_FALSE; DoTones: PROC[ttD: ToneSpec, newTones: BOOL] = { ringATune: BOOLEAN; PrepareTuneProc: PlayOps.BeepProc = TRUSTED { waitTime _ waitTime+beepTime; ttD.notes _ LOOPHOLE[List.Append[l2: CONS[NEW[Beep _ [beepFreq, beepTime]], NIL], l1: LOOPHOLE[ttD.notes]]]; }; <> <<[]_info.interface.GenerateTones[shh: info.shh, f1: beepFreq, f2: 0, modulation: 0, repetitions: 1, on: beepTime, off: 0, waveTable: ttD.volume, queueIt: TRUE, notify: [nothing, 0C]]>> <<};>> IF ttD=NIL THEN RETURN; ringATune _ NOT Rope.IsEmpty[ttD.ringTune]; --IsEmpty if NIL or "" in rope Log.SLOG[100000B]; IF newTones AND ringATune THEN TRUSTED { --prepare the ringing tune for playout waitTime _ 0; PlayOps.PlayString[music: ttD.ringTune, beepProc: PrepareTuneProc]; ttD.tuneDuration_ waitTime; } ELSE IF ringATune THEN waitTime _ ttD.tuneDuration --continuing ringing tune ELSE waitTime _ (ttD.on+ttD.off)*ttD.repetitions; --continuing some other tones IF newTones THEN waitTime _ MAX[1000, waitTime - 2000]; --1 secs minimum wait IF ~ttD.oneRing THEN continuingTones _ ttD; IF ~newTones AND ttD.delayForCadence#0 THEN { []_info.interface.GenerateTones[shh: info.shh, f1: 0, f2: 0, modulation: 0, repetitions: 1, on: ttD.delayForCadence, off: 0, waveTable: ttD.volume, queueIt: TRUE, notify: [nothing, 0C]]; waitTime _ waitTime + ttD.delayForCadence; }; IF ringATune THEN { FOR bl: LIST OF BeepRef _ ttD.notes, bl.rest UNTIL bl = NIL DO beep: BeepRef _ bl.first; []_info.interface.GenerateTones[shh: info.shh, f1: beep.beepFreq, f2: 0, modulation: 0, repetitions: 1, on: beep.beepTime, off: 0, waveTable: ttD.volume, queueIt: TRUE, notify: [nothing, 0C]]; ENDLOOP; } ELSE []_info.interface.GenerateTones[shh: info.shh, f1: ttD.f1, f2: ttD.f2, modulation: 0, repetitions: ttD.repetitions, on: ttD.on, off: ttD.off, waveTable: ttD.volume, queueIt: ~newTones, notify: [nothing, 0C]]; }; IF req#NIL THEN Log.SLOG[100000B]; IF req#NIL THEN WITH req SELECT FROM d: REF ADisconnectType => { info.interface.Disconnect[ shh: info.shh, buffer: out1]; info.interface.Disconnect[ shh: info.shh, buffer: in1]; }; w: REF AFlashWaitType => { flashWait_TRUE; waitTime _ 600; }; toneSpec: ToneSpec => DoTones[toneSpec, TRUE]; a: REF ANoTonesType => { continuingTones_NIL; []_info.interface.GenerateTones[shh: info.shh, f1: 0, f2: 0, modulation: 0, repetitions: 0, on:0, off: 0, waveTable: 0, queueIt: FALSE, notify: [nothing, 0C]]; }; echoParameters: Lark.EchoParameters => []_info.interface.EchoSupression[shh: info.shh, echo: echoParameters]; commands: Lark.CommandEvents => IF commands#NIL THEN IF commands[0].device=touchPad THEN { []_info.interface.GenerateTones[ info.shh, 0, 0, 0, pd.waitForTelco, 0, 1, 3, FALSE, [nothing, 0C]]; []_info.interface.Feep[shh: info.shh, on: pd.telcoMinOn, off: pd.telcoMinOff, notify: [tones, 'F], waveTable: pd.feepVolume, queueIt: TRUE, events: commands]; } ELSE info.interface.Commands[ info.shh, commands ]; keyTable: Lark.KeyTable => info.interface.SetKeyTable[shh: info.shh, table: keyTable]; spec: Lark.ConnectionSpec => { Log.SLOG[100000B]; spec.buffer _ out1; info.interface.Connect[shh: info.shh, specs: spec ]; <> spec.buffer _ in1; info.interface.Connect[shh: info.shh, specs: spec ]; }; ENDCASE; { moreTones: BOOL_FALSE; WaitQ: ENTRY PROC[info: LarkInfo] RETURNS [continue: BOOL, moreTones: BOOL] = TRUSTED { ENABLE UNWIND=>NULL; IF info.newActions#NIL AND ~flashWait THEN RETURN[TRUE, FALSE]; IF info.larkState=failed OR info.larkState=recovering THEN RETURN[FALSE, FALSE]; IF info.larkState=idle THEN continuingTones _ NIL; Process.SetTimeout[@info.stateChange, Process.MsecToTicks[waitTime]]; WAIT info.stateChange; waitTime _ 10000; RETURN[info.newActions#NIL OR info.larkState#idle, info.newActions=NIL AND continuingTones#NIL]; }; IF ~(([,moreTones]_WaitQ[info]).continue) THEN EXIT; IF moreTones THEN DoTones[continuingTones, FALSE]; }; EXITS Failed => { P: ENTRY PROC[info: LarkInfo] = {IF info.larkState#recovering THEN info.larkState_failed;}; P[info]; EXIT; }; }; ENDLOOP; info.larkProcess _ NIL; }; <> QueueLarkAction: INTERNAL PROC[info: LarkInfo, ref: REF] = { elt: LIST OF REF = LIST[ref]; lst: LIST OF REF = info.lastAction; Log.SLOG[100000B]; IF info.newActions=NIL THEN info.newActions _ elt ELSE IF lst=NIL THEN Thrush.pERROR ELSE lst.rest _ elt; info.lastAction _ elt; }; DequeueLarkAction: INTERNAL PROC[info: LarkInfo] RETURNS [ref: REF] = INLINE { elt: LIST OF REF _ info.newActions; IF elt=NIL THEN RETURN[NIL]; ref_elt.first; info.newActions _ elt.rest; }; QueueCommandSequence: INTERNAL PROC[ info: LarkInfo, commands: ROPE, lState: LONG POINTER TO LState, scratchEv: Lark.CommandEvents] RETURNS[echoAction: REF_NIL]= TRUSTED { eventIndex: INTEGER_-1; c: CHAR; i: NAT; index: INTEGER; event: Lark.Event; events: Lark.CommandEvents _ scratchEv; nextState: LState _ []; len: NAT; echoAction _ echosOff[lState.echoStyle]; IF commands=NIL THEN RETURN; -- status quo len _ commands.Length[]; FOR i IN [0..len) DO SELECT (c_commands.Fetch[i]) FROM 'J, 'j => IF ~pd.backDoorOH THEN LOOP; ENDCASE; SELECT c FROM 'Z => { lState.xbar_ALL[0]; lState.lSw _ ALL[Lark.enabled]; event _ Lark.reset; }; 'X, 'x => { row: NAT_ Digit[commands.Fetch[i+1]]; outputs: PACKED ARRAY [0..8) OF BOOLEAN _ LOOPHOLE[nextState.xbar[row]]; outputs[Digit[commands.Fetch[i+2]]] _ (c='X); nextState.xbar[row] _ LOOPHOLE[outputs]; i_i+2; LOOP; }; 'E, 'e => { nextState.echoStyle _ commands.Fetch[i_i+1]; echoAction _ echosOn[nextState.echoStyle]; }; 'M, 'm => { nextState.voiceMode _ SELECT commands.Fetch[i_i+1] FROM '0 => Lark.o3i1, '1 => Lark.o2i2, '2 => Lark.o1i1, ENDCASE => ERROR; }; ENDCASE=> { IF c IN ['a..'z] THEN { event _ Lark.disabled; c_c-('a-'A); } ELSE event _ Lark.enabled; IF lStateForLetter[c]#none THEN nextState.lSw[lStateForLetter[c]] _ event; }; ENDLOOP; IF nextState=lState^ THEN RETURN [NIL]; IF nextState.echoStyle=lState.echoStyle OR ~pd.echoControl THEN echoAction_NIL; FOR iteration: NAT IN [0..1] DO -- 0: compute size; 1: fill in result sequence. index_-1; IF nextState.voiceMode#lState.voiceMode THEN events[index_index+1] _ [voiceMode, nextState.voiceMode]; FOR i: LSwitches DECREASING IN LSwitches DO IF nextState.lSw[i]#lState.lSw[i] THEN events[index_index+1] _ [lDevs[i], nextState.lSw[i]]; ENDLOOP; FOR i: NAT IN [0..8) DO IF nextState.xbar[i]#lState.xbar[i] THEN { outputs: PACKED ARRAY[0..8) OF BOOLEAN = LOOPHOLE[lState.xbar[i]]; nxtOutputs: PACKED ARRAY[0..8) OF BOOLEAN = LOOPHOLE[nextState.xbar[i]]; FOR j: NAT IN [0..8) DO IF outputs[j]#nxtOutputs[j] THEN events[index_index+1] _ [ Lark.Device[LOOPHOLE[IF nxtOutputs[j] THEN 23 ELSE 22]], LOOPHOLE[i*16+j] ]; ENDLOOP; }; ENDLOOP; IF index=-1 THEN { events_NIL; EXIT; }; IF iteration=0 THEN events _ NEW[Lark.CommandEventSequence[index+1]]; ENDLOOP; QueueLarkAction[info, events]; lState^ _ nextState; lState.lSw[xBarAll] _ Lark.disabled; }; Digit: PROC[c: CHAR] RETURNS [digit: NAT] = INLINE { RETURN[c-'0]; }; RopeToDTMF: PROC [r: Thrush.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 c: CHAR = r.Fetch[j]; ce.e[j] _ [touchPad, SELECT c FROM IN ['0..'9] => LOOPHOLE[128 + c - '0], IN ['a..'d] => LOOPHOLE[138 + c - 'a], IN ['\001..'\037] => LOOPHOLE[LOOPHOLE[c,INTEGER]*10], -- 100 ms. pauses, 12-14 illegal! '* => Lark.bStar, '# => Lark.bThorp, ENDCASE => Lark.bStar]; ENDLOOP; }; Deb: PROC[info: LarkInfo, c: CHAR, p1, p2, p3, p4: IO.Value_[null[]]] = { s: IO.STREAM; IF ~ThNet.pd.debug THEN RETURN; s_IO.ROS[]; s.PutF["<%g", char[c]]; SELECT c FROM 'M => s.PutF["-- %g", p1]; 'C => { s.PutF[" -- [%b, %b]", p3, p4]; s.PutF[" %b(%d), %b(%d)", p1, p1, p2, p2]; }; ENDCASE; s.PutRope[">\r"]; Log.Report[s.RopeFromROS[], $LarkDetailed, info]; }; QuickState: ARRAY LarkState OF IO.Value = [ rope["none"], rope["idle"], rope["talking"], rope["trunkSignalling"], rope["trunkTalking"], rope["trunkForwarding"], rope["trunkFlashing"], rope["failed"], rope["recovering"], rope["ringing"], rope["silence"], rope["dialTone"], rope["ringBack"], rope["busyTone"], rope["errorTone"]]; toneStdCommand: ROPE = "SX01X14X06"; toneSpkrCommand: ROPE = "LSX03X14X06"; toneMonitorCommand: ROPE = "SX01X03X14X06"; silentSignalling: ROPE _ "HIX02X14"; noisySignalling: ROPE _ "HISTX02X10X21X26X14"; -- same as trunk talking (feedback problems?) noisierSignalling: ROPE _ "HITLX02X30X23X26X24"; -- same as spkr trunk talking (feedback problems?) trunkSignalling: ROPE _ silentSignalling; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<0 dec1 co1>> <<1 Xmtr Rcvr>> <<2 from Telewall to Telewall>> <<3 mike speaker>> <<4 silence DTMF receiver>> <<5 dec2 co2>> <<6 line 1 out line 1 in>> <<7 line 2 out line 2 in>> larkCommands: ARRAY TerminalType OF ARRAY LarkState OF ROPE _ [ <> [ NIL, -- none "Z", -- idle "SX01X06X10X14", -- talking trunkSignalling, -- trunkSignalling "HISTX02X10X21X26X14", -- trunkTalking, codec-assisted electronic mode "E3HIX02X20X24", -- trunkForwarding, trunk to remote Lark connection. (need gain setting for echo?) "Z", -- trunkFlashing, on-hook for a second. <<"STX02X10X21X26X14", -- trunkFlashing, on-hook but otherwise unchanged.>> "Z", -- failed "Z", -- recovering "RX03X06", -- ringing "SX14", -- silence toneStdCommand, toneStdCommand, toneStdCommand, toneStdCommand -- tones ], <> [ NIL, -- none "Z", -- idle "E1LX03X06X30X14", -- talking "HIX02X14X06", -- trunkSignalling "E2M1THILX30X02X25X26X24X53", -- trunkTalking, gain-controlled digital mode "E3HIX02X20X24", -- trunkForwarding; device stuff for this mode doesn't have much meaning. "Z", -- trunkFlashing, on-hook for a second. <<"TLX02X30X23X26X24", -- trunkFlashing>> "Z", -- failed "Z", -- recovering "RX03X06", -- ringing "LX14", -- silence toneSpkrCommand, toneSpkrCommand, toneSpkrCommand, toneSpkrCommand -- tones ], <> [ NIL, -- none "Z", -- idle "SX01X03X06X10X14", -- talking "HIX02X14X06", -- trunkSignalling "HISTLX02X10X21X23X14X26", -- trunkTalking, codec-assisted electronic mode "E3HIX02X20X24", -- trunkForwarding, trunk to remote Lark connection. (meaning?) "Z", -- trunkFlashing, on-hook for a second. <<"STLX10X21X23X14X26", -- trunkFlashing>> "Z", -- failed "Z", -- recovering "RX03X06", -- ringing "SX14", -- silence toneMonitorCommand, toneMonitorCommand, toneMonitorCommand, toneMonitorCommand -- tones ], <> [ NIL, -- none "Z", -- idle "SX01X06X60X14", -- talking "HIX02X14X06", -- trunkSignalling "Z", -- trunkTalking "E3HIX02X20X24", -- trunkForwarding, trunk to remote Lark connection. (meaning?) "Z", -- trunkFlashing <<"STLX10X21X23X14X26", -- trunkFlashing>> "Z", -- failed "Z", -- recovering "RX03X06", -- ringing "SX14", -- silence toneStdCommand, toneStdCommand, toneStdCommand, toneStdCommand -- tones ] ]; echoStyleFD: REF _ NEW[Lark.EchoParameterRecord _[ <> buffer: out1, buffer2Controlled: FALSE, buffer1Controlled: TRUE, decayTime: 5, gain: [ 1024, 2048, 2048, 2048, 32767 ] ]]; echoStyleFwd: REF _ echoStyleFD; echoStyleBD: REF _ NEW[Lark.EchoParameterRecord _[ <> buffer: in2, buffer2Controlled: FALSE, buffer1Controlled: TRUE, decayTime: 10, gain: [ 2048, 4096, 8192, 16384, 32767 ] ]]; echoStyleNoFD: REF _ NEW[Lark.EchoParameterRecord _[ <> buffer: out1, -- not interesting buffer2Controlled: FALSE, buffer1Controlled: FALSE, decayTime: 0, gain: [ 0, 0, 0, 0, 0 ] ]]; echoStyleNoFwd: REF _ echoStyleNoFD; echoStyleNoBD: REF _ NEW[Lark.EchoParameterRecord _[ <> buffer: in2, -- not interesting buffer2Controlled: FALSE, buffer1Controlled: FALSE, decayTime: 0, gain: [ 0, 0, 0, 0, 0 ] ]]; echosOn: ARRAY CHAR['0..'3] OF REF_[ NIL, echoStyleFD, echoStyleBD, echoStyleFwd ]; echosOff: ARRAY CHAR ['0..'3] OF REF_[ NIL, echoStyleNoFD, echoStyleNoBD, echoStyleNoFwd ]; Nice.View[pd, "Lark Out PD"]; }.