TonePlayImpl:
CEDAR
PROGRAM
IMPORTS Atom, IO, Process, Real, RealFns, UXIO, UnixErrno, UnixSysCalls
EXPORTS TonePlay
~ BEGIN
ROPE: TYPE = Rope.ROPE;
ampScale:
NAT = 256;
Note, amp is kept scaled up by ampScale for better precision
A power of 2 scale is more efficient
MuLawByte: TYPE = TonePlay.MuLawByte;
AudioBuf: TYPE = TonePlay.AudioBuf;
pi: REAL ¬ 3.14159;
K: CARD = 64*1024;
L: CARD = 8*1024;
M: CARD = 8159;
audioDrain: INT = 04000040403B; -- Hex 20004103; ioctl for audio device drain.
audioFlush: INT = 04000051405B; -- Hex 20005305; ioctl for audio device flush.
decodeArray: REF DecodeArray ¬ InitDecodeArray[];
DecodeArray: TYPE = ARRAY BYTE OF TonePlay.Scaled;
InitDecodeArray:
PROC
RETURNS [
REF DecodeArray] ~ {
This information is derived from the data sheet on the Intel 2910A (mu-Law).
array: REF DecodeArray ¬ NEW[DecodeArray];
FOR b:
BYTE
IN
BYTE
DO
m: MuLawByte = [byte[b]];
i: INT ¬ 0;
rem: BYTE = m.rem;
SELECT m.octant
FROM
0 => i ¬ 8159-256*rem;
1 => i ¬ 4063-128*rem;
2 => i ¬ 2015-64*rem;
3 => i ¬ 991-32*rem;
4 => i ¬ 479-16*rem;
5 => i ¬ 223-8*rem;
6 => i ¬ 95-4*rem;
7 => IF rem # 15 THEN i ¬ 31-2*rem;
ENDCASE;
IF NOT m.positive THEN i ¬ -i;
i ¬ i * (K/L);
array[b] ¬ [int[i]];
ENDLOOP;
RETURN [array];
};
encodeArray:
REF EncodeArray ¬ InitEncodeArray[];
EncodeArray: TYPE = PACKED ARRAY EncodeArrayIndex OF BYTE;
EncodeArrayIndex: TYPE = [0..M];
InitEncodeArray:
PROC
RETURNS [
REF EncodeArray] ~ {
array: REF EncodeArray ¬ NEW[EncodeArray];
adj: REAL ¬ 1.0/L;
FOR i: EncodeArrayIndex
IN EncodeArrayIndex
DO
array[i] ¬ HeavyEncode[REAL[i]*adj];
ENDLOOP;
RETURN [array];
};
EncodeScaled:
--PUBLIC-- PROC [s: TonePlay.Scaled]
RETURNS [
BYTE] ~ {
Encodes for s in the range [-1.0 .. 1.0], clipping if s is not in that range.
neg: BOOL ¬ FALSE;
b: BYTE ¬ 0;
index: EncodeArrayIndex ¬ EncodeArrayIndex.LAST;
IF s.int < 0 THEN {s.int ¬ -s.int; neg ¬ TRUE};
s.card ¬ s.card / (K/L);
IF s.card < index THEN index ¬ LOOPHOLE[s.card, EncodeArrayIndex];
b ¬ encodeArray[index];
IF neg THEN b ¬ b MOD 128;
RETURN [b];
};
HeavyEncode:
--PUBLIC-- PROC [r:
REAL]
RETURNS [
BYTE] ~ {
Binary search assuming decodeArray is valid, but not using encodeArray. r is assumed to be in the range [-1.0 .. 1.0].
hiIndex: BYTE ¬ 255;
loIndex: BYTE ¬ 0;
increasing: BOOL ¬ TRUE;
r ¬ r * K;
IF r <= 0 THEN hiIndex ¬ 127 ELSE loIndex ¬ 128;
IF decodeArray[hiIndex].int < decodeArray[loIndex].int THEN increasing ¬ FALSE;
DO
IF (hiIndex-loIndex) > 1
THEN {
midIndex: BYTE = (hiIndex+loIndex)/2;
midValue: REAL = REAL[decodeArray[midIndex].int];
IF increasing
THEN
IF r >= midValue THEN loIndex ¬ midIndex ELSE hiIndex ¬ midIndex
ELSE
IF r <= midValue THEN loIndex ¬ midIndex ELSE hiIndex ¬ midIndex;
}
ELSE {
hiValue: REAL = REAL[decodeArray[hiIndex].int];
loValue: REAL = REAL[decodeArray[loIndex].int];
IF ABS[hiValue-r] < ABS[loValue-r] THEN RETURN [hiIndex] ELSE RETURN [loIndex];
};
ENDLOOP;
};
RealToScaled:
PROC [r:
REAL]
RETURNS [TonePlay.Scaled] ~ {
RETURN [[int[Real.Floor[r*K+0.5]]]];
};
ScaledToReal:
PROC [s: TonePlay.Scaled]
RETURNS [
REAL] ~ {
RETURN [REAL[s.int] / K];
};
AddScaled:
--PUBLIC-- PROC [s1, s2: TonePlay.Scaled]
RETURNS [TonePlay.Scaled] ~ {
RETURN [[int[s1.int+s2.int]]];
};
SubScaled:
PROC [s1, s2: TonePlay.Scaled]
RETURNS [TonePlay.Scaled] ~
INLINE {
RETURN [[int[s1.int-s2.int]]];
};
MulScaled:
PROC [s1, s2: TonePlay.Scaled]
RETURNS [TonePlay.Scaled] ~ {
neg: BOOL ¬ FALSE;
res: CARD ¬ 0;
IF s1.int < 0 THEN {s1.int ¬ - s1.int; neg ¬ TRUE};
IF s2.int < 0 THEN {s2.int ¬ - s2.int; neg ¬ NOT neg};
IF s1.card > s2.card
THEN {t: TonePlay.Scaled ¬ s1; s1 ¬ s2; s2 ¬ t};
Assert: s1 <= s2
IF s1.card # 0
THEN {
lo1: CARD = s1.card MOD K;
lo2: CARD = s2.card MOD K;
hi1: CARD = s1.card / K;
hi2: CARD = s2.card / K;
IF lo2 = 0
THEN {
IF hi1 # 0 THEN res ¬ (hi1 * hi2) * K;
IF lo1 # 0 THEN res ¬ res + (lo1 * hi2);
}
ELSE {
IF hi1 # 0 THEN res ¬ (hi1 * hi2) * K + (lo2 * hi1);
IF lo1 # 0 THEN res ¬ res + (lo1 * hi2) + (lo1 * lo2) / K;
};
IF neg THEN res ¬ 0 - res;
};
RETURN [[card[res]]];
};
SinScaled:
PROC [s: TonePlay.Scaled]
RETURNS [TonePlay.Scaled] ~
INLINE {
This actually returns Sin[s*twoPi]
RETURN [sinScaled[(s.card / (K/L)) MOD L]];
};
sinScaled: REF ScaledArray ¬ InitSinScaled[];
ScaledArray: TYPE = ARRAY ScaledArrayIndex OF TonePlay.Scaled;
ScaledArrayIndex: TYPE = [0..L);
InitSinScaled:
PROC [debug: TonePlay.
STREAM ¬
NIL]
RETURNS [
REF ScaledArray] ~ {
table: REF ScaledArray ¬ NEW[ScaledArray];
cvt: REAL ¬ 2.0*pi/L;
FOR i: ScaledArrayIndex
IN ScaledArrayIndex
DO
r: REAL = i*cvt;
sin: REAL = RealFns.Sin[r];
s: TonePlay.Scaled ¬ RealToScaled[sin];
table[i] ¬ s;
IF table[i] # s THEN ERROR;
IF debug #
NIL
AND s.int = 0
THEN {
IO.PutF[debug, "In InitSinScaled, i = %g, i*cvt = %g, sin = %g\n",
[integer[i]], [real[r]], [real[sin]] ];
};
ENDLOOP;
RETURN [table];
};
GenTone:
PUBLIC
PROC [buf: TonePlay.AudioBuf] ~ {
r1, r2: GenSampleResult ¬ skip;
sample1, sample2: TonePlay.Scaled;
buf.toneA.amp ¬ buf.toneB.amp ¬ [int[0]];
buf.toneA.rem ¬ buf.toneA.fadeInSteps;
buf.toneB.rem ¬ buf.toneB.fadeInSteps;
buf.toneA.state ¬ buf.toneB.state ¬ fadeIn;
DO
out: TonePlay.Scaled ¬ [int[0]];
[r1, sample1] ¬ GenSample[buf, buf.toneA];
[r2, sample2] ¬ GenSample[buf, buf.toneB];
IF r1=quit AND r2=quit THEN EXIT;
IF r1=takeSample THEN out ¬ sample1;
IF r2=takeSample THEN out ¬ AddScaled[out, sample2];
buf.data[buf.pos] ¬ EncodeScaled[out];
buf.pos ¬ (buf.pos + 1) MOD TonePlay.audioDataMod;
IF buf.pos = 0 THEN buf.flush[buf, TonePlay.audioDataMod];
ENDLOOP;
};
GenSampleResult: TYPE ~ { skip, takeSample, quit };
GenSample:
PROC[buf: TonePlay.AudioBuf, tone: TonePlay.FMToneSpec]
RETURNS[result: GenSampleResult ¬ skip, out: TonePlay.Scaled ¬ [int[0]]] ~ {
Could check here or somewhere for nothing to do for this frequency.
SELECT tone.state
FROM
fadeIn => {
tone.amp.int ¬ tone.amp.int + tone.ampFadeIn.int;
IF tone.amp.int > tone.ampInit.int THEN tone.amp.int ¬ tone.ampInit.int;
IF tone.rem = 0
THEN {
tone.state ¬ normal; tone.rem ¬ tone.normalSteps; RETURN[skip, out];};
};
normal => {
tone.amp ¬ tone.ampInit;
IF tone.rem = 0
THEN {
tone.state ¬ fadeOut; tone.rem ¬ tone.fadeOutSteps; RETURN[skip, out];};
};
fadeOut => {
tone.amp.int ¬ tone.amp.int - tone.ampFadeOut.int;
IF tone.amp.int < 0 THEN tone.amp.int ¬ 0;
IF tone.rem = 0
THEN {
tone.state ¬ zero; tone.rem ¬ tone.zeroSteps; RETURN[skip, out]; };
};
zero => {
tone.amp.int ¬ 0;
IF tone.rem = 0 THEN RETURN[quit, out];
};
ENDCASE;
IF tone.amp.int > 0
THEN {
sin2: TonePlay.Scaled = MulScaled[SinScaled[tone.phase2], tone.phaseRatio];
temp: TonePlay.Scaled = [int[tone.phase1.int+sin2.int]];
trueAmp: TonePlay.Scaled = [card[tone.amp.card / ampScale]];
Note, amp is kept scaled for better precision
out ¬ MulScaled[SinScaled[temp], trueAmp];
};
IF tone.delaySteps # 0
THEN {
delayPos: TonePlay.AudioHistoryIndex
= LOOPHOLE[tone.histPos - tone.delaySteps, CARDINAL] MOD TonePlay.audioHistoryMod;
delayValue: TonePlay.Scaled ¬ tone.history[delayPos];
delayValue ¬ MulScaled[delayValue, tone.delayRatio];
out ¬ [int[out.int + delayValue.int]];
};
tone.history[tone.histPos] ¬ out;
tone.histPos ¬ (tone.histPos + 1) MOD TonePlay.audioHistoryMod;
tone.phase1.int ¬ tone.phase1.int + tone.phaseStep1.int;
tone.phase2.int ¬ tone.phase2.int + tone.phaseStep2.int;
tone.rem ¬ tone.rem - 1;
RETURN[takeSample, out];
};
BufFlush:
PROC [buf: TonePlay.AudioBuf, len:
NAT] ~
TRUSTED {
ENABLE
UXIO.Error => {
errno: UnixErrno.Errno ¬ GetErrno[];
IF errno = EINTR OR errno = EABORTED THEN ERROR ABORTED ELSE ERROR;
};
Process.CheckForAbort[];
IF len # 0
AND buf.st #
NIL
THEN
IO.UnsafePutBlock[buf.st, [LOOPHOLE[@buf.data], 0, len]];
buf.pos ¬ 0;
};
GetErrno:
PROC
RETURNS [UnixErrno.Errno] ~ {
RETURN[UnixErrno.GetErrno[]];
};
This generates a fair amount of buffer space that must later be reclaimed. Consider a way to re-use buf's instead of regenerating them.
OpenAudioDeviceForWrite:
PUBLIC
PROC[defaultAmplitude:
REAL]
RETURNS [buf: AudioBuf] ~ {
buf ¬ NEW[TonePlay.AudioBufRep];
buf.toneA ¬ NEW[TonePlay.FMToneSpecBody];
buf.toneB ¬ NEW[TonePlay.FMToneSpecBody];
buf.toneA.ampDefault ¬ buf.toneB.ampDefault ¬ defaultAmplitude;
buf.flush ¬ BufFlush;
buf.st ¬ UXIO.CreateFileStream["/dev/audio", write];
buf.self ¬ Process.GetCurrent[];
};
CloseWriteAudioDevice:
PUBLIC PROC[buf: AudioBuf, discardQueued: BOOL¬FALSE] ~ TRUSTED {
There's now enough concurrency in all this to warrant some monitors.
None in place at the moment.
IF buf.st#
NIL
THEN {
fd: UnixTypes.FD;
res: UnixTypes.RES;
st: IO.STREAM ¬ buf.st;
fdRef: REF UnixTypes.FD;
IF buf.self=NIL THEN RETURN;
IF buf.self#Process.GetCurrent[] THEN ERROR;
Process.CheckForAbort[];
fdRef ¬ NARROW[Atom.GetPropFromList[st.propList, $FD]];
IF fdRef=NIL THEN RETURN;
fd ¬ fdRef;
IF ~discardQueued
THEN res ¬
UnixSysCalls.IOCtl4[d: fd, request: audioDrain, argp: LOOPHOLE[@res], doInIOP: TRUE]
ELSE res ¬
UnixSysCalls.IOCtl4[d: fd, request: audioFlush, argp: LOOPHOLE[2], doInIOP: TRUE];
IO.Close[st];
};
buf.st ¬ NIL;
buf.self ¬ NIL;
};
PlayTonePair:
PUBLIC
PROC [buf: AudioBuf, time:
REAL, freq1:
REAL, freq2:
REAL] ~ {
PlayTonePairReally[buf, time, 0, freq1, freq2];
BufFlush[buf, buf.pos];
};
PlayTonePairReally:
PROC [buf: AudioBuf, time:
REAL, ampAdj:
INT, freq1:
REAL, freq2:
REAL] ~ {
freq1: REAL ← 440.0; -- examples
freq2: REAL ← 457.0;
time: REAL ← 1.0;
amp: REAL ¬ buf.toneA.ampDefault;
fadeInTime: REAL ¬ 0.00;
fadeOutTime: REAL ¬ 0.00;
phaseRatio: REAL ¬ 1.0;
delayTime: REAL ¬ 0.0;
delayRatio: REAL ¬ 0.8;
pauseTime: REAL ¬ 0.0;
IF buf.self=NIL THEN RETURN;
IF buf.self#Process.GetCurrent[] THEN ERROR;
Process.CheckForAbort[];
SELECT ampAdj
FROM
< 0 => amp ¬ amp / ampAdj*(-1.4);
> 0 => amp ¬ amp * ampAdj * 1.4;
ENDCASE;
buf.toneA.phaseStep1 ¬ RealToScaled[freq1/L];
buf.toneB.phaseStep1 ¬ RealToScaled[freq2/L];
buf.toneA.ampInit ¬ buf.toneB.ampInit ¬ RealToScaled[amp*ampScale];
buf.toneA.phaseStep2 ¬ buf.toneB.phaseStep2 ¬ RealToScaled[0.0];
buf.toneA.phaseRatio ¬ buf.toneB.phaseRatio ¬ RealToScaled[phaseRatio];
buf.toneA.delaySteps ¬ buf.toneB.delaySteps ¬ (RealToScaled[delayTime].card / (K/L)) MOD TonePlay.audioDataMod;
buf.toneA.delayRatio ¬ buf.toneB.delayRatio ¬ RealToScaled[delayRatio];
buf.toneA.fadeInSteps ¬ buf.toneB.fadeInSteps ¬ RealToScaled[fadeInTime].int / (K/L);
buf.toneA.normalSteps ¬ buf.toneB.normalSteps ¬ RealToScaled[time].int / (K/L);
buf.toneA.fadeOutSteps ¬ buf.toneB.fadeOutSteps ¬ RealToScaled[fadeOutTime].int / (K/L);
buf.toneA.zeroSteps ¬ buf.toneB.zeroSteps ¬ RealToScaled[pauseTime].int / (K/L);
IF buf.toneA.fadeInSteps <= 0
THEN buf.toneA.ampFadeIn.int ¬ buf.toneB.ampFadeIn.int ¬ 0
ELSE buf.toneA.ampFadeIn.int ¬ buf.toneB.ampFadeIn.int ¬ buf.toneA.ampInit.int / buf.toneA.fadeInSteps;
IF buf.toneA.fadeOutSteps <= 0
THEN buf.toneA.ampFadeOut.int ¬ buf.toneB.ampFadeOut.int ¬ 0
ELSE buf.toneA.ampFadeOut.int ¬ buf.toneB.ampFadeOut.int ¬ buf.toneA.ampInit.int / buf.toneA.fadeOutSteps;
GenTone[buf];
};
PlayRingTune:
PUBLIC
PROC [buf: AudioBuf, toneSpec: TuneParse.ToneSpec] ~ {
What's the write way to right silence into one of these streams?
FOR tones: TuneParse.ToneList ¬ toneSpec.tones, tones.rest
WHILE tones#
NIL
DO
IF tones.first.on#0
THEN
PlayTonePairReally[buf, (tones.first.on+0.0)/1000.0, toneSpec.volume, tones.first.f1, tones.first.f2];
IF tones.first.off#0
THEN
PlayTonePairReally[buf, (tones.first.off+0.0)/1000.0, 0, 0.0, 0.0];
ENDLOOP;
BufFlush[buf, buf.pos];
};
Stop:
PUBLIC
PROC [buf: AudioBuf] ~ {
self: PROCESS;
IF buf#NIL AND (self¬buf.self)#NIL THEN Process.Abort[self];
};