DIRECTORY
IO,
Atom USING [ GetPropFromList, PutPropOnList ],
Convert USING [ IntFromRope, RopeFromInt ],
GList USING [ Nconc ],
Lark USING [ StatusEvent ],
LarkOpsRpcControl,
LarkSynthesizer USING [ LarkSynthReport ],
Rope USING [ Cat, Concat, FromChar, Length, ROPE, Translate, TranslatorType ],
Synthesizer USING [ BreakText, SynthSpec, SynthSpecs ],
SynthesizerServer,
ThSmartsPrivate USING [ Deb, EnterLarkSt, Fail, FailInt, LarkCallBody, LarkInfo ],
ThNet USING [ pd ],
Thrush USING [ NB ],
VoiceUtils USING [ Problem, ProblemFR ]
;
LarkSynthesizerImpl:
CEDAR MONITOR
LOCKS info
USING info: LarkInfo
IMPORTS IO, Atom, Convert, GList, LarkOpsRpcControl, LarkSynthesizer, Rope, Synthesizer, ThNet, ThSmartsPrivate, VoiceUtils
EXPORTS LarkSynthesizer = {
OPEN IO;
Types and Values
LarkInfo: TYPE = ThSmartsPrivate.LarkInfo;
SynthSpecs: TYPE = Synthesizer.SynthSpecs;
SynthCmd: TYPE = Rope.ROPE;
Per-synthesizer information, linked to LarkInfo
SynthInfo: TYPE = REF SynthInfoBody;
SynthInfoBody:
TYPE =
RECORD [
Synthesizer control values
synthResponse: Rope.ROPE←NIL, -- holds incomplete Synthesizer responses
flushJustFinished: BOOL←FALSE, -- can expect to have to flush synthQueue next time thru LarkSynthesizerImpl.HandleSynthOutput
synthQueue: Synthesizer.SynthSpecs←NIL, -- holds queue of client markers and synthSpecs
textToSpeak: Rope.ROPE←NIL,
clientMarker: INT←maxClientMarker,
controlMarker: INT←maxControlMarker,
ctrlMarkerQueue: LIST OF REF INT←NIL, -- holds queue of control markers
pktsOutstanding: INT𡤀,
flushInProgress: BOOL←FALSE -- consider combining w flushJustFinished?
];
definitions to interface to DECTalk text-to-speech synthesizer; more in ThSmartsPrivate
pReset:
PUBLIC SynthCmd ← "cP;z:cp0\\P;z:pp0\\P;z:ra180\\P;z:np\\[5n";
is ESC. Also explicitly resets voice, rate, etc, because machine reset doesn't.
stopAndFlush:
PUBLIC SynthCmd ← "P;10z\\[5n"
;
DSR brief ([5n) not strictly needed for reset or flush, but makes the DECTalk (which is normally quiet in this case) respond more like the Prose.
commenceSpeech: SynthCmd = "P;z,\\"; -- phonemic comma
indexMarkerStart: SynthCmd = "P;21;"; -- for constructing index commands
indexMarkerLen: INT = 12;
indexMarkerEnd: SynthCmd = "z\\P;z,\\";
The comma pause is to separate this index-reply command from any immediately following one, because of a DECtalk bug which will respond only to the second one when there are two in a row. In particular, there will always be two in a row at the end of a connection.
indexMarkerEndChar: CHAR = 'z;
pResetConfirmEnd: CHAR = 'n;
stopAndFlushEnd: CHAR = 'n; -- for confirm, rename to flushConfirmEnd
flushMarker: INT = 1000;
synthFailure: INT = 1001;
maxControlMarker: INT = 250;
maxClientMarker: INT = 199;
maxTextPktLen:
INT ← 150;
Byte (char) count; RPCLupine.maxDataLength is word count
No bigger than RPCLupine.maxDataLength - 2*indexMarkerLen
minClientMarker: INT = 1;
minControlMarker: INT = 200; -- reserved for packet control
maxPkts: INT = 250 / maxTextPktLen; -- Prose can hold `several hundred' chars
numPkts: INT ← 2;
speechDoneMarker: INT = 255;
speechDone: SynthCmd = "P;21;255z\\P;z,\\";
Commence speech & report back when done. 38 chars counting the preceding index-reply and pause(!), but it is safe, even if the client has explicitly turned mode square on. The index-reply tells us that we are all done. The final comma pause flushes the preceding index-reply, which would otherwise sit in the machine indefinitely.
plainSpeechDone: SynthCmd = " P;21;255z\\ ";
Contains Ctrl Ks as flush chars, which turn phoneme mode off. Only safe if client is neither in explicit phoneme mode (which I detect) nor in mode square on mode & inside square brackets (which I don't).
NconcSpecs: PROC[l1, l2: SynthSpecs] RETURNS [SynthSpecs] = INLINE { RETURN[NARROW[GList.Nconc[l1, l2]]]; };
New request from service to Lark:
AddText:
PUBLIC ENTRY
PROC[
info: LarkInfo, synthSpec: Synthesizer.SynthSpec, filter: BOOL←TRUE, queueIt: BOOL←TRUE] = {
Do some reasonable-state checking? At present, am assuming service did it at the conversation level, and that LarkOut will keep us out of trouble.
Check for really info.textToSpeech? Probably higher up, unless this is higher up.
ENABLE UNWIND => NULL;
newText: Rope.ROPE;
synthInfo: SynthInfo ← GetSynthInfo[info];
IF synthInfo=NIL THEN RETURN; -- error already reported
IF ~queueIt THEN DoSynthFlush[info, stopAndFlush];
IF ThNet.pd.debug
THEN
ThSmartsPrivate.Deb[info, "Rq Prose", rope[synthSpec.textToSpeak], bool[queueIt], int[synthSpec.actionID]];
newText ←
IF ~filter
THEN synthSpec.textToSpeak
ELSE Rope.Translate[base: synthSpec.textToSpeak, translator: FilterText];
synthSpec.
synthMarker ← synthInfo.clientMarker ←
IF synthInfo.clientMarker = maxClientMarker
THEN minClientMarker
ELSE synthInfo.clientMarker + 1;
synthInfo.textToSpeak ← Rope.Cat[synthInfo.textToSpeak, newText, indexMarkerStart,
Convert.RopeFromInt[synthInfo.clientMarker], indexMarkerEnd];
synthInfo.synthQueue ← NconcSpecs[synthInfo.synthQueue, LIST[synthSpec]];
SpeakText[info, synthInfo];
};
Lark-to-Server keyboard events
Only pass on index marker notifications. Swallow or handle all others.
Assume Prose XON / XOFF disabled.
Assume only get the following responses:
On pReset: pResetConfirmOK if everything's okay
cmdLeader <0-16> pResetConfirmEnd otherwise
Index marker response:
Undetermined problem: BEL
HandleAndReport:
PROC [info: LarkInfo, sEvent: Lark.StatusEvent] ~ {
Avoid deadlock - shouldn't call Smarts-level entry procs while holding the LarkIn/Out lock. That's why this isn't an entry procedure.
nb: Thrush.NB;
sS: Synthesizer.SynthSpec ← HandleSynthesizerOutput[info, sEvent];
IF sS=NIL THEN RETURN;
IF (nb ← LarkSynthesizer.LarkSynthReport[sS, $finished]) = $success THEN RETURN;
IF info#NIL AND ~info.failed THEN ThSmartsPrivate.Fail[info, IO.PutFR["Couldn't report text-synthesizer completion -- %g", atom[nb]], TRUE]
ELSE VoiceUtils.ProblemFR["Couldn't report text-synthesizer completion, probably due to earlier failure -- %g", $System, NIL, atom[nb]];
};
HandleSynthesizerOutput:
ENTRY
PROC[info: LarkInfo, commandEvent: Lark.StatusEvent]
RETURNS [sS: Synthesizer.SynthSpec ← NIL] = {
ENABLE UNWIND => NULL;
c: CHAR ← commandEvent.event;
synthInfo: SynthInfo ← GetSynthInfo[info];
IF synthInfo = NIL THEN RETURN; -- error already reported
SELECT c
FROM
IO.BEL => NULL; -- take some error action?
IO.ESC, ';, '\\ => synthInfo.synthResponse ← ""; -- start of some response
'[ => NULL; -- peel this character off
stopAndFlushEnd => {
SynthControlDone[info, synthInfo, flushMarker];
synthInfo.flushJustFinished ← TRUE;
};
indexMarkerEndChar => {
marker: INT;
IF Rope.Length[synthInfo.synthResponse]=0
THEN
RETURN;
For now, we'll assume that this was a successful dictionary entry response.
marker ← Convert.IntFromRope[synthInfo.synthResponse];
IF marker > maxClientMarker
THEN
SynthControlDone[info, synthInfo, marker]
ELSE {
sQ: Synthesizer.SynthSpecs ← synthInfo.synthQueue;
IF sQ=NIL THEN ERROR;
IF
synthInfo.flushJustFinished
THEN {
It's okay to skip ahead in the queue. Except for 1st item in a conversation, which follows an initial RESET, should be to some entry with queueIt=FALSE. Don't report skipped entries as finished; FinchSmarts will take care of skipping ahead in its queue. (May want to add a synthSpec.type = flushed?)
FOR sSkip: Synthesizer.SynthSpecs ← sQ, sSkip.rest
WHILE sSkip#
NIL
DO
IF sSkip.first.synthMarker = marker THEN sQ ← sSkip;
ENDLOOP;
synthInfo.flushJustFinished ← FALSE;
};
IF sQ.first.synthMarker = marker
THEN {
sS ← sQ.first;
synthInfo.synthQueue ← sQ.rest; -- Flush any skipped items.
}
ELSE SynthControlDone[info, synthInfo, synthFailure]; -- fail!!!
};
};
pResetConfirmEnd => { -- this case is now the same as stopAndFlushEnd
IF Convert.IntFromRope[synthInfo.synthResponse] # 0 THEN
SynthControlDone[info, synthInfo, ThSmartsPrivate.synthFailure] -- fail!!!;
ELSE {
SynthControlDone[info, synthInfo, ThSmartsPrivate.flushMarker];
synthInfo.flushJustFinished ← TRUE;
};
};
ENDCASE => synthInfo.synthResponse ←
Rope.Concat[synthInfo.synthResponse, Rope.FromChar[c]];
};
SynthControlDone:
PUBLIC
INTERNAL
PROC[
info: LarkInfo, synthInfo: SynthInfo, marker: INT] = {
problem: Rope.ROPE←NIL; {
marker1: INT;
IF ~info.textToSpeech OR info.failed THEN RETURN;
IF marker= synthFailure
THEN {
problem ← "Text-to-speech service failed"; GOTO Failed; };
IF marker = flushMarker
THEN {
-- Flushing complete
synthInfo.flushInProgress ← FALSE;
synthInfo.ctrlMarkerQueue ← NIL;
synthInfo.pktsOutstanding ← 0;
SpeakText[info, synthInfo];
RETURN;
};
IF synthInfo.ctrlMarkerQueue =
NIL
THEN {
problem ← "Text-to-speech service: empty control marker list"; GOTO Failed; };
marker1 ← NARROW[synthInfo.ctrlMarkerQueue.first, REF INT]^;
IF marker # marker1
THEN {
problem ← "Text-to-speech service: wrong marker received"; GOTO Failed; };
synthInfo.ctrlMarkerQueue ← synthInfo.ctrlMarkerQueue.rest;
synthInfo.pktsOutstanding ← synthInfo.pktsOutstanding-1;
SpeakText[info, synthInfo];
EXITS Failed => ThSmartsPrivate.FailInt[info, problem,
TRUE];
};
};
Utilities
FilterText: Rope.TranslatorType = {
-- PROC [old: CHAR] RETURNS [new: CHAR]
Remove chars that the Prose considers illegal.
SELECT old
FROM
IO.
TAB,
IO.
LF,
IO.
CR,
IO.
ESC => new ← old;
Don't allow user to send reset (ctrl R) for Prose.
Don't allow ctrl K or ctrl Z for DECtalk (terminate clause & phoneme mode)
< IO.SP => new ← IO.SP;
ENDCASE => new ← old;
};
SynthFlush:
PUBLIC ENTRY
PROC[info: LarkInfo] = {
ENABLE UNWIND => NULL;
DoSynthFlush[info, stopAndFlush];
};
SynthReset:
ENTRY
PROC[info: LarkInfo] = {
Arrange to flush outstanding
ENABLE UNWIND => NULL;
DoSynthFlush[info, pReset]
};
DoSynthFlush:
INTERNAL
PROC[info: LarkInfo, synthCmd: SynthCmd] = {
Arrange to flush outstanding
synthInfo: SynthInfo ← GetSynthInfo[info];
IF synthInfo=NIL THEN RETURN; -- failure already reported
IF synthInfo.flushInProgress THEN RETURN;
synthInfo.flushInProgress ← TRUE;
synthInfo.textToSpeak ← "";
IF ThNet.pd.debug
THEN
ThSmartsPrivate.Deb[info, "Rq Prose flush", rope[synthCmd], bool[FALSE], int[0]];
ScheduleCommandString[info, synthCmd];
};
GetSynthInfo:
INTERNAL
PROC[info: LarkInfo]
RETURNS [synthInfo: SynthInfo←
NIL] = {
Synthesizer-specific information is stored on the LarkInfo property list. If that's not true coming in, it's true going out. Also registers the input-handing procedure for keyboard events.
IF info=NIL THEN { VoiceUtils.Problem["No larkInfo at GetSynthInfo", $System]; RETURN; };
info.keyboardEventHandler ← HandleAndReport;
info.keyboardResetHandler ← SynthReset;
synthInfo ← NARROW[Atom.GetPropFromList[info.props, $synthInfo]];
IF synthInfo#NIL THEN RETURN;
synthInfo ← NEW[SynthInfoBody←[]];
info.props ← Atom.PutPropOnList[info.props, $synthInfo, synthInfo];
};
ScheduleCommandString:
PROC[info: LarkInfo, command: SynthCmd] = {
Queues up "IssueCommandString[info, command]" for serial execution by the Lark
ThSmartsPrivate.EnterLarkSt[info, info.larkState,
LIST[NEW[ThSmartsPrivate.LarkCallBody ← [IssueCommandString, command]]]];
};
IssueCommandString:
PROC[info: LarkInfo, clientData:
REF] = {
textPkt: Rope.ROPE = NARROW[clientData];
IF ThNet.pd.debug THEN ThSmartsPrivate.Deb[info, "Issue prose", rope[textPkt]];
info.interface.CommandString[shh: info.shh, device: keyboard, commands: textPkt];
};