home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / pastalk.zip / SPEECH.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-25  |  5KB  |  167 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; T : boolean);
  24.   procedure Speak(S:string; T : boolean);      { Allows any non-alphabetic sperator }
  25.   function InitSpeed:word;
  26.   procedure CalibrateSpeech(Snd:boolean; T : 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; T : boolean);
  48.   var SysClk : longint absolute $40:$6C;
  49.       StartTime,EndTime : longint;
  50.       TestCal : word;
  51.  
  52.     function Cal:word;
  53.     begin
  54.       StartTime := SysClk;
  55.       TalkPhoneme(Snd,' ',T);
  56.       TalkPhoneme(Snd,'H',T);
  57.       TalkPhoneme(Snd,'EH',T);
  58.       TalkPhoneme(Snd,'L',T);
  59.       TalkPhoneme(Snd,'OH',T);
  60.       EndTime := SysClk;
  61.       Cal := EndTime - StartTime;
  62.     end;
  63.  
  64.   begin
  65.     TestCal := 0;
  66.     Resolve := 8;
  67.     SpeedDelay := 1;
  68.     while TestCal < SpeedCal do
  69.     begin
  70.       TestCal := Cal;
  71.       if TestCal < SpeedCal then
  72.       begin
  73.         Inc(SpeedDelay,SpeedCal-TestCal);
  74.         if (SpeedDelay > 8) and (Resolve > 1) then
  75.         begin
  76.           Resolve := Resolve shr (SpeedDelay shr 3);
  77.           SpeedDelay := 1;
  78.         end;
  79.       end;
  80.     end;
  81.   end;
  82.  
  83.   {---------------------------------------------------}
  84.   procedure TalkPhoneme(Snd:boolean; Phoneme:string; T : boolean);
  85.  
  86.   const
  87.     PhonemeList : array [ 1 .. 35 ] of string [ 2 ]
  88.                 = ( 'U',  'A',  ' ',  'B',  'D',  'G',
  89.                     'J',  'P',  'T',  'K',  'W',  'Y',
  90.                     'R',  'L',  'M',  'N',  'S',  'V',
  91.                     'F',  'H',  'Z',  'AW', 'AH', 'UH',
  92.                     'AE', 'OH', 'EH', 'OO', 'IH', 'EE',
  93.                     'WH', 'SH', 'TZ', 'TH', 'ZH' );
  94.   var
  95.     I, N : integer;
  96.     Found : boolean;
  97.   begin
  98.     for I := 1 to length ( Phoneme ) do
  99.       Phoneme [ I ] := upcase ( Phoneme [ I ] );
  100.     if Phoneme = 'I' then
  101.       begin
  102.         TalkPhoneme (true, 'AH',T);      { "I" is special. Is treated as combo. }
  103.         TalkPhoneme (true, 'EE',T);
  104.       end
  105.     else
  106.       begin
  107.         Found := false;                          { Search list }
  108.         for I := 1 to 35 do
  109.           if PhonemeList [ I ] = Phoneme then
  110.             begin
  111.               N := I;
  112.               Found := true;
  113.             end;
  114.         if Found then
  115.           begin
  116.             if t = true then write ( Phoneme, ' ' );
  117.             Talker ( ptr( seg(TalkDataLink),
  118.                           ofs(TalkDataLink) + pred(N) * PhonemeSize ),
  119.                           PhonemeSize, SpeedDelay, Resolve, Snd);
  120.  
  121.           end;
  122.       end;
  123.   end;
  124.  
  125. {-----------------------------------------------}
  126.   procedure Speak(S:string; T : boolean);
  127.        { Allows any non-alphabetic sperator }
  128.   const
  129.     SpaceDelay = 10;
  130.   var
  131.     Phoneme : string;
  132.     I       : integer;
  133.     C       : char;
  134.  
  135.     procedure Dump;
  136.     begin
  137.       if Phoneme <> '' then
  138.         TalkPhoneme (true, Phoneme,T);
  139.     end;
  140.  
  141.   begin { Speak }
  142.     Phoneme := '';
  143.     for I := 1 to length ( S ) do
  144.       begin
  145.         C := S [ I ];
  146.         case C of
  147.           ' '        : begin
  148.                          Dump;
  149.                          TalkPhoneme (true, ' ',T);
  150.                        end;
  151.           'a' .. 'z',
  152.           'A' .. 'Z' : Phoneme := Phoneme + C
  153.           else         begin
  154.                          Dump;
  155.                          Phoneme := '';
  156.                        end;
  157.         end;
  158.  
  159.       end;
  160.     Dump;
  161.   end;
  162.  
  163. {-----------------------------------------------}
  164. begin
  165.    WorkSpeed := InitSpeed;
  166. end.
  167.