home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TPTALK.ZIP
/
SPEECH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-04-23
|
4KB
|
164 lines
{Speech is a program unit which uses phonemes to speak through}
{the PC's speaker port.}
{This program was derived from a program found in }
{the IBMPRO forum library of Compuserve called TPSPCH.ARC }
{ Authors: David Neal Dubois, Michael Day }
{ released by authors to the public domain as of 22 April 1989 }
{$F+} {<-- must be compiled as Far}
Unit Speech;
interface
const
SpeedDelay : word = 20;
Resolve : word = 1;
PhonemeSize : word = $023F;
SpeedCal : word = 11; {how long it takes to say "hello"}
var
WorkSpeed : word;
procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
procedure TalkPhoneme(Snd:boolean; Phoneme:string);
procedure Speak(S:string); { Allows any non-alphabetic sperator }
function InitSpeed:word;
procedure CalibrateSpeech(Snd:boolean);
{-----------------------------------------------}
implementation
{$F+}
procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
external;
{$L Talker.OBJ}
{$F+}
procedure TalkDataLink; external;
{$L TalkData.OBJ}
{$F+}
function InitSpeed:word; external;
{$L InitSpd.OBJ}
{-----------------------------------------------}
procedure CalibrateSpeech(Snd:boolean);
var SysClk : longint absolute $40:$6C;
StartTime,EndTime : longint;
TestCal : word;
function Cal:word;
begin
StartTime := SysClk;
TalkPhoneme(Snd,' ');
TalkPhoneme(Snd,'H');
TalkPhoneme(Snd,'EH');
TalkPhoneme(Snd,'L');
TalkPhoneme(Snd,'OH');
EndTime := SysClk;
Cal := EndTime - StartTime;
end;
begin
TestCal := 0;
Resolve := 8;
SpeedDelay := 1;
while TestCal < SpeedCal do
begin
TestCal := Cal;
if TestCal < SpeedCal then
begin
Inc(SpeedDelay,SpeedCal-TestCal);
if (SpeedDelay > 8) and (Resolve > 1) then
begin
Resolve := Resolve shr (SpeedDelay shr 3);
SpeedDelay := 1;
end;
end;
end;
end;
{---------------------------------------------------}
procedure TalkPhoneme(Snd:boolean; Phoneme:string);
const
PhonemeList : array [ 1 .. 35 ] of string [ 2 ]
= ( 'U', 'A', ' ', 'B', 'D', 'G',
'J', 'P', 'T', 'K', 'W', 'Y',
'R', 'L', 'M', 'N', 'S', 'V',
'F', 'H', 'Z', 'AW', 'AH', 'UH',
'AE', 'OH', 'EH', 'OO', 'IH', 'EE',
'WH', 'SH', 'TZ', 'TH', 'ZH' );
var
I, N : integer;
Found : boolean;
begin
for I := 1 to length ( Phoneme ) do
Phoneme [ I ] := upcase ( Phoneme [ I ] );
if Phoneme = 'I' then
begin
TalkPhoneme (true, 'AH' ); { "I" is special. Is treated as combo. }
TalkPhoneme (true, 'EE' );
end
else
begin
Found := false; { Search list }
for I := 1 to 35 do
if PhonemeList [ I ] = Phoneme then
begin
N := I;
Found := true;
end;
if Found then
begin
write ( Phoneme, ' ' );
Talker ( ptr( seg(TalkDataLink),
ofs(TalkDataLink) + pred(N) * PhonemeSize ),
PhonemeSize, SpeedDelay, Resolve, Snd);
end;
end;
end;
{-----------------------------------------------}
procedure Speak(S:string); { Allows any non-alphabetic sperator }
const
SpaceDelay = 10;
var
Phoneme : string;
I : integer;
C : char;
procedure Dump;
begin
if Phoneme <> '' then
TalkPhoneme (true, Phoneme );
end;
begin { Speak }
Phoneme := '';
for I := 1 to length ( S ) do
begin
C := S [ I ];
case C of
' ' : begin
Dump;
TalkPhoneme (true, ' ' );
end;
'a' .. 'z',
'A' .. 'Z' : Phoneme := Phoneme + C
else begin
Dump;
Phoneme := '';
end;
end;
end;
Dump;
end;
{-----------------------------------------------}
begin
WorkSpeed := InitSpeed;
end.