home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sound / talker / speech.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-23  |  4.3 KB  |  164 lines
  1. {Speech is a program unit which uses phonemes to speak through}
  2. {the PC's speaker port.}
  3.  
  4. {This program was derived from a program found in }
  5. {the IBMPRO forum library of Compuserve called TPSPCH.ARC }
  6. { Authors: David Neal Dubois,  Michael Day }
  7. { released by authors to the public domain as of 22 April 1989 }
  8.  
  9. {$F+}     {<-- must be compiled as Far}
  10. Unit Speech;
  11. interface
  12.  
  13. const
  14.   SpeedDelay  : word = 20;
  15.   Resolve     : word = 1;
  16.   PhonemeSize : word = $023F;
  17.   SpeedCal    : word = 11; {how long it takes to say "hello"}
  18.  
  19. var
  20.   WorkSpeed : word;
  21.  
  22.   procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
  23.   procedure TalkPhoneme(Snd:boolean; Phoneme:string);
  24.   procedure Speak(S:string);      { Allows any non-alphabetic sperator }
  25.   function InitSpeed:word;
  26.   procedure CalibrateSpeech(Snd:boolean);
  27.  
  28. {-----------------------------------------------}
  29. implementation
  30.  
  31. {$F+}
  32.   procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
  33.     external;
  34.   {$L Talker.OBJ}
  35.  
  36. {$F+}
  37.   procedure TalkDataLink; external;
  38.   {$L TalkData.OBJ}
  39.  
  40. {$F+}
  41.   function InitSpeed:word; external;
  42.   {$L InitSpd.OBJ}
  43.  
  44.  
  45. {-----------------------------------------------}
  46.  
  47.   procedure CalibrateSpeech(Snd:boolean);
  48.   var SysClk : longint absolute $40:$6C;
  49.       StartTime,EndTime : longint;
  50.       TestCal : word;
  51.     function Cal:word;
  52.     begin
  53.       StartTime := SysClk;
  54.       TalkPhoneme(Snd,' ');
  55.       TalkPhoneme(Snd,'H');
  56.       TalkPhoneme(Snd,'EH');
  57.       TalkPhoneme(Snd,'L');
  58.       TalkPhoneme(Snd,'OH');
  59.       EndTime := SysClk;
  60.       Cal := EndTime - StartTime;
  61.     end;
  62.  
  63.   begin
  64.     TestCal := 0;
  65.     Resolve := 8;
  66.     SpeedDelay := 1;
  67.     while TestCal < SpeedCal do
  68.     begin
  69.       TestCal := Cal;
  70.       if TestCal < SpeedCal then
  71.       begin
  72.         Inc(SpeedDelay,SpeedCal-TestCal);
  73.         if (SpeedDelay > 8) and (Resolve > 1) then
  74.         begin
  75.           Resolve := Resolve shr (SpeedDelay shr 3);
  76.           SpeedDelay := 1;
  77.         end;
  78.       end;
  79.     end;
  80.   end;
  81.  
  82.   {---------------------------------------------------}
  83.   procedure TalkPhoneme(Snd:boolean; Phoneme:string);
  84.  
  85.   const
  86.     PhonemeList : array [ 1 .. 35 ] of string [ 2 ]
  87.                 = ( 'U',  'A',  ' ',  'B',  'D',  'G',
  88.                     'J',  'P',  'T',  'K',  'W',  'Y',
  89.                     'R',  'L',  'M',  'N',  'S',  'V',
  90.                     'F',  'H',  'Z',  'AW', 'AH', 'UH',
  91.                     'AE', 'OH', 'EH', 'OO', 'IH', 'EE',
  92.                     'WH', 'SH', 'TZ', 'TH', 'ZH' );
  93.   var
  94.     I, N : integer;
  95.     Found : boolean;
  96.   begin
  97.     for I := 1 to length ( Phoneme ) do
  98.       Phoneme [ I ] := upcase ( Phoneme [ I ] );
  99.     if Phoneme = 'I' then
  100.       begin
  101.         TalkPhoneme (true, 'AH' );      { "I" is special. Is treated as combo. }
  102.         TalkPhoneme (true, 'EE' );
  103.       end
  104.     else
  105.       begin
  106.         Found := false;                          { Search list }
  107.         for I := 1 to 35 do
  108.           if PhonemeList [ I ] = Phoneme then
  109.             begin
  110.               N := I;
  111.               Found := true;
  112.             end;
  113.         if Found then
  114.           begin
  115.             write ( Phoneme, ' ' );
  116.             Talker ( ptr( seg(TalkDataLink),
  117.                           ofs(TalkDataLink) + pred(N) * PhonemeSize ),
  118.                           PhonemeSize, SpeedDelay, Resolve, Snd);
  119.  
  120.           end;
  121.       end;
  122.   end;
  123.  
  124. {-----------------------------------------------}
  125.   procedure Speak(S:string);      { Allows any non-alphabetic sperator }
  126.   const
  127.     SpaceDelay = 10;
  128.   var
  129.     Phoneme : string;
  130.     I       : integer;
  131.     C       : char;
  132.  
  133.     procedure Dump;
  134.     begin
  135.       if Phoneme <> '' then
  136.         TalkPhoneme (true, Phoneme );
  137.     end;
  138.  
  139.   begin { Speak }
  140.     Phoneme := '';
  141.     for I := 1 to length ( S ) do
  142.       begin
  143.         C := S [ I ];
  144.         case C of
  145.           ' '        : begin
  146.                          Dump;
  147.                          TalkPhoneme (true, ' ' );
  148.                        end;
  149.           'a' .. 'z',
  150.           'A' .. 'Z' : Phoneme := Phoneme + C
  151.           else         begin
  152.                          Dump;
  153.                          Phoneme := '';
  154.                        end;
  155.         end;
  156.       end;
  157.     Dump;
  158.   end;
  159.  
  160. {-----------------------------------------------}
  161. begin
  162.    WorkSpeed := InitSpeed;
  163. end.
  164.