<> <> <> <> <<>> <> <<>> <> <<>> <> <<>> DIRECTORY BasicTime USING [earliestGMT, Now, Period], BluejayUtils USING [DescribeTune, DescribeInterval], BluejayUtilsRpcControl USING [ImportInterface, UnimportInterface], Convert USING [IntFromRope, RopeFromInt], FinchSmarts USING [CurrentFinchState, FinchState, GetProcs, Procs, RecordReason], IO USING [card, GetCard, GetInt, int, PutFR, RIS, rope, STREAM], LoganBerry USING [AttributeType, AttributeValue, Entry, Error, ErrorCode, Open, OpenDB, ReadEntry, WriteEntry], LoganBerryRpcControl USING [ImportInterface, UnimportInterface], LupineRuntime USING [BindingError], <> Rope USING [Cat, Concat, ROPE], <> Thrush USING [EncryptionKey, IntervalSpecs, Tune, VoiceInterval], UserProfile USING [Token], UserCredentials USING [CredentialsChangeProc, Get, RegisterForChange], VoiceRope, VoiceUtils USING [Problem, RnameToRspec] ; VoiceRopeImpl: CEDAR PROGRAM -- Should this be a monitor? IMPORTS BasicTime, BluejayUtils, BluejayUtilsRpcControl, Convert, FinchSmarts, IO, LoganBerry, LoganBerryRpcControl, LupineRuntime, Rope, UserCredentials, UserProfile, VoiceUtils EXPORTS VoiceRope ~ BEGIN OPEN VoiceRope; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; <> <> <> <> <> <<];>> <<>> <> <> <> <> <> <> <> <> <<];>> defaultHandle: Handle_NIL; TuneList: TYPE = LoganBerry.Entry; <> <> Open: PUBLIC PROC[voiceRopeDBName: Rope.ROPE _ NIL, voiceRopeDBInstance: Rope.ROPE _ NIL, localName: Rope.ROPE _ NIL, Complain: PROC[complaint: Rope.ROPE]_NIL] RETURNS [handle: Handle] = { <> server: Rope.ROPE _ UserProfile.Token["ThrushClientServerInstance", "Strowger.Lark"]; vdbHandle: VoiceDBHandle; ec: LoganBerry.ErrorCode; expl: ROPE; IF Complain = NIL THEN Complain _ FinchProblem; IF voiceRopeDBInstance = NIL THEN voiceRopeDBInstance _ server; IF voiceRopeDBName = NIL THEN voiceRopeDBName _ Rope.Cat["///", VoiceUtils.RnameToRspec[server].simpleName, "/VoiceRopeDB"]; [vdbHandle, ec, expl] _ OpenDB[voiceRopeDBName, voiceRopeDBInstance, "Morley.Lark"]; IF ec#NIL THEN Complain[expl]; -- Trouble opening; success of future calls in doubt handle _ NEW[HandleRec _ [vdbHandle: vdbHandle, Complain: Complain]]; }; FinchProblem: PROC[complaint: Rope.ROPE] = { VoiceUtils.Problem[complaint, $Finch]; }; StartFinch: PROC[handle: Handle, complain: BOOL_TRUE] RETURNS [state: FinchSmarts.FinchState] = { <> <> RW: PROC[c: Rope.ROPE] = { IF ~complain THEN RETURN; handle.Complain[complaint: c]; }; SELECT (state _ FinchSmarts.CurrentFinchState[]) FROM unknown => RW["Sorry, Finch needs to be loaded and started.\n"]; stopped => RW["Sorry, Finch needs to be connected to telephone server.\nUse \"Finch\" command.\n"]; running => NULL; ENDCASE => ERROR; handle.procs _ IF state=unknown THEN NIL ELSE FinchSmarts.GetProcs[]; }; ValidateHandle: PROC[oldHandle: Handle] RETURNS [handle: Handle] = { handle _ oldHandle; IF handle=NIL THEN { IF defaultHandle=NIL THEN defaultHandle _ Open[]; handle _ defaultHandle; }; }; Record: PUBLIC PROC[handle: Handle _ NIL] RETURNS [voiceRope: VoiceRope] = { <> ENABLE LoganBerry.Error => { handle.Complain[explanation]; CONTINUE; }; <> interval: Thrush.VoiceInterval; key: Thrush.EncryptionKey; reason: FinchSmarts.RecordReason; tune: Thrush.Tune; handle _ ValidateHandle[handle]; IF StartFinch[handle]#running THEN RETURN; <<-- no BeepTune until we store SysNoises in the new voice database>> <> [reason, tune, interval, key] _ handle.procs.recordTune[queueIt: TRUE]; IF reason#ok THEN RETURN; <> IF interval.length = -1 THEN interval.length _ BluejayUtils.DescribeTune[tune].size * 8000; voiceRope _ WriteVoiceRope[handle: handle.vdbHandle, struct: SimpleTuneList[tune, interval, key]]; }; <> Play: PUBLIC PROC[handle: Handle_NIL, voiceRope: VoiceRope, queueIt: BOOL_TRUE, failOK: BOOL_FALSE, wait: BOOL_FALSE] = { <> < play after all other record/playback requests are satisfied.>> < playing is optional; leave connection open if tune doesn't exist.>> < wait until things appear to be started properly, or have failed.>> ENABLE LoganBerry.Error => { handle.Complain[explanation]; CONTINUE; }; tune: Thrush.Tune; interval: Thrush.VoiceInterval; key: Thrush.EncryptionKey; struct: TuneList; handle _ ValidateHandle[handle]; IF StartFinch[handle]#running THEN RETURN; struct _ ReadVoiceRope[handle.vdbHandle, voiceRope].struct; IF struct=NIL THEN { handle.Complain["No such voice rope to play."]; RETURN;}; UNTIL struct=NIL DO [tune, interval, key, struct] _ NextTuneOnList[struct]; []_handle.procs.playbackTune[tune: tune, interval: interval, key: key, queueIt: queueIt, failOK: failOK, wait: wait]; ENDLOOP; }; Stop: PUBLIC PROC[handle: Handle _ NIL] = { <> ENABLE UNWIND => NULL; handle _ ValidateHandle[handle]; IF StartFinch[handle, FALSE]#running THEN RETURN; handle.procs.stopTune[]; }; <> <> Retain: PUBLIC PROC [ <> <> handle: Handle _ NIL, voiceRope: VoiceRope, refID: Rope.ROPE, refIDType: Rope.ROPE ] ~ { handle _ ValidateHandle[handle]; }; Forget: PUBLIC PROC [ <> <> handle: Handle _ NIL, refID: Rope.ROPE, refIDType: Rope.ROPE ] ~ { handle _ ValidateHandle[handle]; }; <> Cat: PUBLIC PROC [handle: Handle _ NIL, vr1, vr2, vr3, vr4, vr5: VoiceRope _ NIL] RETURNS [new: VoiceRope] ~ { <> struct: TuneList; IF vr1 = NIL THEN RETURN[NIL]; handle _ ValidateHandle[handle]; struct _ ReadVoiceRope[handle.vdbHandle, vr1].struct; IF vr2 # NIL THEN struct _ CatEntries[struct, ReadVoiceRope[handle.vdbHandle, vr2].struct]; IF vr3 # NIL THEN struct _ CatEntries[struct, ReadVoiceRope[handle.vdbHandle, vr3].struct]; IF vr4 # NIL THEN struct _ CatEntries[struct, ReadVoiceRope[handle.vdbHandle, vr4].struct]; IF vr5 # NIL THEN struct _ CatEntries[struct, ReadVoiceRope[handle.vdbHandle, vr5].struct]; new _ WriteVoiceRope[handle.vdbHandle, struct]; }; <<>> Substr: PUBLIC PROC [handle: Handle _ NIL, vr: VoiceRope, start: INT _ 0, len: INT _ LAST[INT]] RETURNS [new: VoiceRope] ~ { <> struct: TuneList; handle _ ValidateHandle[handle]; struct _ ReadVoiceRope[handle.vdbHandle, vr].struct; IF struct=NIL THEN { handle.Complain["No such voice rope."]; RETURN[NIL];}; struct _ TuneListInterval[struct, start, len]; new _ WriteVoiceRope[handle.vdbHandle, struct]; }; <<>> Replace: PUBLIC PROC [handle: Handle _ NIL, vr: VoiceRope, start: INT _ 0, len: INT _ LAST[INT], with: VoiceRope _ NIL] RETURNS [new: VoiceRope] ~ { <> base, struct: TuneList; handle _ ValidateHandle[handle]; base _ ReadVoiceRope[handle.vdbHandle, vr].struct; IF base=NIL THEN { handle.Complain["No such voice rope."]; RETURN[NIL];}; struct _ TuneListInterval[CopyEntry[base], 0, start]; struct _ CatEntries[struct, ReadVoiceRope[handle.vdbHandle, with].struct]; struct _ CatEntries[struct, TuneListInterval[base, start+len]]; new _ WriteVoiceRope[handle.vdbHandle, struct]; }; <<>> Length: PUBLIC PROC [handle: Handle _ NIL, vr: VoiceRope] RETURNS [len: INT] ~ { <> header: LoganBerry.Entry; value: LoganBerry.AttributeValue; handle _ ValidateHandle[handle]; header _ ReadVoiceRope[handle.vdbHandle, vr].header; IF header = NIL THEN { handle.Complain["No such voice rope."]; RETURN[0];}; value _ GetAttributeValue[entry: header, type: $Length]; len _ Convert.IntFromRope[value]; }; <<>> <> DescribeRope: PUBLIC PROC [handle: Handle _ NIL, vr: VoiceRope, minSilence: INT _ -1] RETURNS [noise: IntervalSpecs] ~ { struct: TuneList; tuneSpec: Thrush.IntervalSpecs; tune: Thrush.Tune; interval: Thrush.VoiceInterval; noiseEnd: IntervalSpecs _ NIL; -- last item on current list of noise intervals samples: INT _ 0; handle _ ValidateHandle[handle]; struct _ ReadVoiceRope[handle.vdbHandle, vr].struct; UNTIL struct=NIL DO [tune: tune, interval: interval, rest: struct] _ NextTuneOnList[struct]; tuneSpec _ BluejayUtils.DescribeInterval[targetTune: tune, targetInterval: interval, minSilence: minSilence].intervals; UNTIL tuneSpec = NIL DO IF noiseEnd = NIL THEN { noise _ LIST[[start: samples + tuneSpec.first.interval.start - interval.start, length: tuneSpec.first.interval.length]]; noiseEnd _ noise; } ELSE { noiseEnd.rest _ LIST[[start: samples + tuneSpec.first.interval.start - interval.start, length: tuneSpec.first.interval.length]]; noiseEnd _ noiseEnd.rest; }; tuneSpec _ tuneSpec.rest; ENDLOOP; samples _ samples + interval.length; ENDLOOP; }; <<>> <> <> OpenDB: PROC[dbName, instance, localName: Rope.ROPE] RETURNS [handle: VoiceDBHandle _ NIL, openEc: LoganBerry.ErrorCode _ NIL, expl: Rope.ROPE] = { ENABLE LoganBerry.Error => { openEc _ ec; expl _ explanation; CONTINUE; }; handle _ NEW[VoiceDBHandleRec _ [voiceRopeDBName: dbName.Concat[".df"], voiceInterestDBName: dbName.Concat["Refs.df"]]]; handle.instance _ instance; ImportLoganberryAndBluejay[instance]; handle.voiceRopeDB _ LoganBerry.Open[dbName: handle.voiceRopeDBName]; <> }; ImportLoganberryAndBluejay: PROC[instance: ROPE] = { <> < NULL;>> <<};>> TRUSTED { LoganBerryRpcControl.UnimportInterface[!LupineRuntime.BindingError => CONTINUE]; BluejayUtilsRpcControl.UnimportInterface[!LupineRuntime.BindingError => CONTINUE]; }; LoganBerryRpcControl.ImportInterface[["Loganberry.Lark", instance]]; BluejayUtilsRpcControl.ImportInterface[["BluejayUtils.Lark", instance]]; }; ReadVoiceRope: PROC [handle: VoiceDBHandle, voiceRope: VoiceRope] RETURNS [header: LoganBerry.Entry, struct: TuneList] ~ { <> actualLength: INT; IF voiceRope = NIL THEN RETURN[NIL, NIL]; header _ LoganBerry.ReadEntry[db: handle.voiceRopeDB, key: $VRID, value: voiceRope.ropeID].entry; struct _ EntryToTuneList[header]; <> actualLength _ Convert.IntFromRope[GetAttributeValue[header, $Length]]; IF voiceRope.length # actualLength OR voiceRope.start # 0 THEN struct _ TuneListInterval[list: struct, start: voiceRope.start, len: voiceRope.length]; }; <<>> WriteVoiceRope: PROC [handle: VoiceDBHandle, struct: TuneList, len: INT _ 0] RETURNS [voiceRope: VoiceRope] ~ { <> id: ROPE; entry: LoganBerry.Entry; interval: Thrush.VoiceInterval; IF len = 0 THEN { -- must compute length of voice rope list: TuneList _ struct; UNTIL list = NIL DO [interval: interval, rest: list] _ NextTuneOnList[list]; len _ len + interval.length; ENDLOOP; }; id _ GenerateUniqueID[]; entry _ struct; entry _ CONS[[$Length, Convert.RopeFromInt[len]], entry]; <> entry _ CONS[[$Creator, UserCredentials.Get[].name], entry]; entry _ CONS[[$VRID, id], entry]; LoganBerry.WriteEntry[db: handle.voiceRopeDB, entry: entry ! LoganBerry.Error => IF ec = $ValueNotUnique THEN {id _ BadUniqueID[]; entry.first.value _ id; RETRY}]; voiceRope _ NEW[VoiceRopeInterval _ [ropeID: id, start: 0, length: len]]; }; <<>> CatEntries: PROC [e1, e2: LoganBerry.Entry] RETURNS [LoganBerry.Entry] ~ { <> ptr: LoganBerry.Entry _ e1; IF ptr = NIL THEN RETURN[e2]; UNTIL ptr.rest = NIL DO ptr _ ptr.rest; ENDLOOP; ptr.rest _ e2; RETURN[e1]; }; CopyEntry: PROC [entry: LoganBerry.Entry] RETURNS [LoganBerry.Entry] ~ { <> new, end: LoganBerry.Entry; IF entry = NIL THEN RETURN[NIL]; new _ LIST[entry.first]; end _ new; FOR e: LoganBerry.Entry _ entry.rest, e.rest WHILE e # NIL DO end.rest _ LIST[e.first]; end _ end.rest; ENDLOOP; RETURN[new]; }; GetAttributeValue: PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] ~ { FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN RETURN[e.first.value]; ENDLOOP; RETURN[NIL]; }; <<>> <> <> SimpleTuneList: PROC [tune: Thrush.Tune, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey] RETURNS [list: TuneList] ~ { <> list _ LIST[[$TID, Convert.RopeFromInt[tune]], [$Key, MarshalKey[key]], [$SL, MarshalInterval[interval]]]; }; NextTuneOnList: PROC [list: TuneList] RETURNS [tune: Thrush.Tune, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey, rest: TuneList] ~ { <> tune _ Convert.IntFromRope[list.first.value]; key _ UnmarshalKey[list.rest.first.value]; interval _ UnmarshalInterval[list.rest.rest.first.value]; rest _ list.rest.rest.rest; }; EntryToTuneList: PROC [entry: LoganBerry.Entry] RETURNS [TuneList] ~ { <> IF entry = NIL THEN RETURN[NIL]; UNTIL entry.first.type = $TID DO entry _ entry.rest ENDLOOP; RETURN[entry]; }; <<>> TuneListInterval: PROC [list: TuneList, start: INT, len: INT _ LAST[INT]] RETURNS [new: TuneList] ~ { <> interval: Thrush.VoiceInterval; -- the current tune's interval prevSamples: INT; -- number of samples in entry excluding the current tune interval samples: INT; -- number of samples in entry including the current tune interval intervalMustChange: BOOLEAN _ FALSE; prevSamples _ 0; interval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ interval.length; UNTIL samples > start DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[NIL]; interval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ samples + interval.length; ENDLOOP; <> new _ list; IF prevSamples # start THEN { -- don't want first part of existing interval interval.start _ interval.start + start - prevSamples; interval.length _ interval.length - (start - prevSamples); intervalMustChange _ TRUE; }; <> IF (len # LAST[INT]) AND (samples >= start + len) THEN { -- interval contained within a single tune interval interval.length _ len; list.rest.rest.rest _ NIL; -- truncate list since we have has much as we need intervalMustChange _ TRUE; }; IF intervalMustChange THEN new.rest.rest.first.value _ MarshalInterval[interval]; IF (len = LAST[INT]) OR (samples >= start + len) THEN -- no need to go on RETURN[new]; UNTIL samples >= start + len DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[new]; interval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ samples + interval.length; ENDLOOP; <> IF samples # start + len THEN { -- want only first part of tune interval list.rest.rest.first.value _ MarshalInterval[[start: interval.start, length: start + len - prevSamples]]; }; list.rest.rest.rest _ NIL; -- truncate list since we have has much as we need RETURN[new]; }; <<>> <> MarshalKey: PROC [key: Thrush.EncryptionKey] RETURNS [r: ROPE] ~ TRUSTED { cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE [LONG[@key]]; r _ IO.PutFR["%bB %bB", IO.card[cardKey[0]], IO.card[cardKey[1]]]; }; UnmarshalKey: PROC [r: ROPE] RETURNS [key: Thrush.EncryptionKey] ~ TRUSTED { cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE[LONG[@key]]; keyStream: IO.STREAM _ IO.RIS[r]; cardKey[0] _ IO.GetCard[keyStream]; cardKey[1] _ IO.GetCard[keyStream]; }; MarshalInterval: PROC [interval: Thrush.VoiceInterval] RETURNS [r: ROPE] ~ INLINE { <> r _ IO.PutFR["%g %g", IO.int[interval.start], IO.int[interval.length]]; }; <<>> UnmarshalInterval: PROC [r: ROPE] RETURNS [interval: Thrush.VoiceInterval] ~ INLINE { <> s: IO.STREAM _ IO.RIS[r]; interval.start _ IO.GetInt[s]; interval.length _ IO.GetInt[s]; }; <<>> <> <> <<>> <> <<>> <> userName: ROPE; counter: INT; kicks: INT; -- for instrumentation purposes GenerateUniqueID: PROC [] RETURNS [id: ROPE] ~ { timestamp: INT _ MAX[counter, BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]]; id _ IO.PutFR["%g#%g", IO.rope[userName], IO.int[timestamp]]; counter _ counter + 1; }; BadUniqueID: PROC [] RETURNS [id: ROPE] ~ { <> counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]+1; -- kick the counter kicks _ kicks + 1; id _ GenerateUniqueID[]; }; NewUser: UserCredentials.CredentialsChangeProc ~ { userName _ UserCredentials.Get[].name; }; InitUniqueID: PROC [] RETURNS [] ~ { counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]; kicks _ 0; userName _ UserCredentials.Get[].name; UserCredentials.RegisterForChange[NewUser]; }; <> InitUniqueID[]; <<>> END. <> <> <> <> <> <<>>