lukrw@vax1.cc.lehigh.edu (05/28/90)
Since there seems to be quite a bit of interest in playing digitized
sound on PC speakers, I'm including the source for a small Turbo Pascal
program to demonstrate the technique. This program can be easily
modified for any type of sample data. -- Kevin Weiner
---------------------------------------------------------------------------
program spkr;
{ This Turbo Pascal program demonstrates a technique for playing
digitized sound through the speaker on faster 286's or 386's. This
method employs pulse width modulation at 16KHz to produce the equivalent
of 6-bit resolution. Basically, the system timer interrupt is taken
over and speeded up to 16KHz, rather than the normal 18.2 Hz. At each
interrupt, the next sound sample (scaled to a range of 0-72) is used as
the duty cycle for the speaker timer, i.e., the amount of time the
output stays high between interrupts. Low-pass filtering by the ear is
mainly responsible for reconstruction of the original signal. This
technique is equivalent to that being employed in "many times"
over-sampling systems, where it is cheaper to use very high speed 1-bit
DACs and low pass filter the output, rather than using costly
high-resolution DACs at lower rates.
Sound input to the program is assumed to be 16-bit samples in Turtle
Beach SampleVision format, though it would be fairly easy to substitute
another source. The program expects one command line parameter, which
is the name of the SampleVision file. Rate conversion to 16KHz is done
assuming the nearest 8KHz increment in the sampling range 8KHz to 48KHz.
There is currently a problem which has yet to be satisfactorily
resolved. Occasionally a high-pitched shrill will be heard over the
sound. This appears to related to the initialization sequence of the
programmable interval timer. In general, however, the sound quality
is very intelligible, especially for voice. Note that unless the
original signal is highly compressed, the low sound level of the pc
speaker will result in very soft output. In fact, pushing the sample
level beyond clipping may actually help in some cases. (Remember, this
is meant to be merely functional, not audiophile quality). Good Luck! }
{$r-,s-}
uses dos, crt;
const
blocksize = 16383; { Samples are stored in up to 30 }
maxblocks = 30; { blocks of 16K }
type
loop = record {Misc SampleVision data structures}
start, stop: longint;
looptype: byte;
count: integer;
end;
marker = record
name: packed array [1..10] of char;
pos: longint;
end;
block = array [1..blocksize] of byte; {One chunk of sample values}
blockptr = ^block;
var
header: record {SV file header}
id: packed array [1..18] of char;
ver: packed array [1..4] of char;
comment: packed array [1..60] of char;
name: packed array [1..30] of char;
samplesize: longint;
end;
trailer: record {SV file trailer}
fill: integer;
loops: array [1..8] of loop;
markers: array[1..8] of marker;
note: byte;
rate, smpte, cycle: longint;
end;
headersize, trailersize: integer;
infile: file;
iname: string;
buf: array [1..blocksize] of integer;
blocks: array [1..maxblocks] of blockptr;
nblocks, lastblocksize: integer;
currentblock: blockptr;
blocknum, samplenum, samplelen: integer;
nsamples, ticks: longint;
nextsample, rateinc, ratemask, alt: byte;
irqmask: byte; {IRQ mask for PIC}
savevec8: pointer; {Saved interrupt vector}
function inport(x: integer): byte;
inline($5a/$eb/$00/$ec); {Read port}
procedure cli;
inline($fa); {Clear interrupts}
procedure sti;
inline($fb); {Enable interrupts}
procedure restore;
{ Restore DOS timer and update system time }
var
dostime: ^longint;
begin
cli;
port[$43] := $34; {Restore counter 0}
port[$40] := $ff;
port[$40] := $ff;
port[$61] := inport($61) and $fc; {Turn off speaker}
dostime := ptr($0040,$006c); {Fix DOS time of day counter}
ticks := ticks + samplenum;
ticks := ticks div rateinc;
if ratemask <> 0 then ticks := ticks * 2;
dostime^ := dostime^ + ticks * $48 div $ffff;
setintvec(8, savevec8); {Restore old interrupt}
port[$21] := irqmask;
sti;
end;
procedure timerint; interrupt;
{Routine called at each timer interrupt (16K times/sec)}
begin
port[$42] := nextsample; {Set speaker pulse width}
{ Prepare sample for next interrupt so there is no delay.
The funny formulas just allow for proper stepping through
the array at different sample rates. }
samplenum := samplenum + rateinc and alt;
alt := alt xor ratemask;
if samplenum > samplelen then {At end of block}
begin
inc(blocknum);
if blocknum > nblocks then
restore {Done}
else
begin {Set up next block}
currentblock := blocks[blocknum];
if blocknum = nblocks then
samplelen := lastblocksize;
samplenum := 1;
ticks := ticks + blocksize; {Keep track of total interrupts }
end; { so we can fix up system clock }
end;
nextsample := currentblock^[samplenum];
port[$20] := $20; {Ack int to PIC}
end;
procedure idle;
{ Just waste time here while interrupt routine does the real work }
begin
repeat
until blocknum > nblocks;
end;
procedure startsound;
{ Initialize the actual sound process }
begin
samplenum := 1; {Prepare first sample}
if nblocks > 1 then
samplelen := blocksize
else
samplelen := lastblocksize;
blocknum := 1;
currentblock := blocks[blocknum];
nextsample := currentblock^[1];
ticks := 0;
cli; {Disable interrupts}
irqmask := inport($21); {Save interrupt mask}
port[$21] := $fe; {Enable only timer int}
getintvec(8, savevec8); {Get int 8 address}
setintvec(8, @timerint); {Substitute interrupt routine}
port[$43] := $90; {Ctr 2, mode 0, LSB only}
port[$42] := $00; {Init ctr 2}
port[$61] := inport($61) or 3; {Enable speaker, gate counter}
port[$43] := $34; {Ctr 0, mode 2, LSB+MSB}
port[$40] := $48; {LSB; period = 72 * .84 microsec}
port[$40] := $00; {MSB}
sti; {Re-enable interrupts}
end;
procedure initsamp;
{ Set up to read sample data }
var i: integer;
begin
iname := paramstr(1);
if iname = '' then
begin
writeln('File name not specified');
halt;
end;
{$i-}
assign(infile, iname);
reset(infile, 1);
{$i+}
if ioresult <> 0 then
begin
writeln('File ',iname,' not found');
halt;
end;
headersize := sizeof(header);
trailersize := sizeof(trailer);
blockread(infile, header, headersize, i);
if i <> headersize then halt;
end;
procedure getsample;
{ Load sample data }
var
i, k, b, size, len: integer;
done: boolean;
ptr: blockptr;
begin
initsamp;
nsamples := header.samplesize;
if nsamples > memavail then {Read as much as will fit in memory}
nsamples := memavail div blocksize * blocksize;
nblocks := nsamples div blocksize;
lastblocksize := nsamples - nblocks * blocksize;
if lastblocksize <> 0 then
nblocks := nblocks + 1;
write('Reading');
k := 1;
done := false;
repeat
if k = nblocks then
size := lastblocksize
else
size := blocksize;
blockread(infile, buf, size*2, len);
write('.');
len := len div 2;
if len <> size then
begin
writeln('Error reading file');
halt;
end;
new(ptr);
blocks[k] := ptr;
for i := 1 to len do
begin
b := buf[i] div 920 + 36; {Scale to range of 0-72 (samples
are 16 bits). Change 920 to a
smaller value to increase volume,
but beware of clipping. }
if b > 72 then
b := 72
else if b < 0
then b := 0;
ptr^[i] := b;
end;
k := k + 1;
if k > nblocks then done := true;
until done;
blockread(infile, trailer, trailersize, i);
{ Compute parameters for rate conversion }
alt := 7;
k := trailer.rate div 1000;
case k of {Rate centers}
5..12: begin rateinc := 1; ratemask := 7; end; {8K}
13..20: begin rateinc := 1; ratemask := 0; end; {16K}
21..28: begin rateinc := 3; ratemask := 7; end; {24K}
29..36: begin rateinc := 2; ratemask := 0; end; {32K}
37..44: begin rateinc := 5; ratemask := 7; end; {40K}
45..52: begin rateinc := 3; ratemask := 0; end; {48K}
else
begin
writeln('Sample rate not supported: ',trailer.rate);
halt;
end;
end {case};
close(infile);
writeln('Done');
end;
begin
getsample;
startsound;
idle;
end.