Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Pascal/HISOFTPASCAL2,0-1.DMS/in.adf/HSPascal/AmigaDemos/Speech.pas

Pascal/Delphi Source File | 1992-01-16 | 5.3 KB | 188 lines

{--------------------------------------------------------------------------

                     HighSpeed Pascal for the Amiga

                         SPEECH SYNTH INTERFACE

                  Programmed by Martin Eskildsen 1991

                  Copyright (c) 1991 by D-House I ApS
                         All rights reserved


  Version : Date (dd.mm.yy) : Comment
  -----------------------------------
    1.00 : 06.11.91 : First version
    1.01 : 16.12.91 : Updated for final Amiga unit
--------------------------------------------------------------------------}

unit Speech;

INTERFACE

uses Narrator, Translator, Exec, Amiga;

type
  Parameters    = (PitchParam, VolumeParam, SexParam, RateParam, ModeParam,
                   FreqParam);
  ParamSet      = set of Parameters;
  Sex           = (male, female);
  Mode          = (human, robot);
  PitchRange    = MINPITCH..MAXPITCH;
  VolumeRange   = MINVOL..MAXVOL;
  FreqRange     = MINFREQ..MAXFREQ;
  RateRange     = MINRATE..MAXRATE;

function  OpenSpeech : boolean;         { TRUE = success }
procedure CloseSpeech;

procedure Say(s : string);

procedure SetFrequency(n : FreqRange);
procedure SetRate     (n : RateRange);
procedure SetPitch    (n : PitchRange);
procedure SetMode     (n : Mode);
procedure SetSex      (n : Sex);
procedure SetVolume   (n : VolumeRange);

procedure DefaultParameters(p : ParamSet);

IMPLEMENTATION

const
  AudioChannelMasks : array [1..4] of byte = (3, 5, 10, 12);

type
  pNarrator_rb  = ^tNarrator_rb;

var
  writeNarrator : pNarrator_rb;
  writePort     : pMsgPort;
  output_buf    : packed array [0..2047] of char;
  SpeechLive    : boolean;              { TRUE = speech is opened }

function OpenSpeech : boolean;
label 1;                { Oh yes, labels are "allowed" when sensible! }
const Revision = 0;

  procedure CloseDown;
  begin
    if TranslatorBase       <> NIL then CloseLibrary(pLibrary(TranslatorBase));
    if writePort^.mp_sigbit <> -1  then DeletePort(writePort);
    if writeNarrator        <> NIL then begin
      CloseDevice(pIORequest(writeNarrator));
      DeleteExtIO(pIORequest(writeNarrator))
    end
  end;

begin
  if SpeechLive then goto 1;                     { Get out of here if open }
  SpeechLive := FALSE;        { Default state in case something goes wrong }
  FillChar(output_buf, sizeof(output_buf), #0);             { Empty buffer }

  TranslatorBase := pLibrary(OpenLibrary('translator.library', Revision));
  if TranslatorBase = NIL then begin    { Abort if error }
    CloseDown;
    goto 1
  end;

  writePort     := CreatePort(NIL,0);
  writeNarrator := pNarrator_rb(CreateExtIO(writePort, sizeof(tNarrator_rb)));

  with writeNarrator^ do begin
    ch_masks := @AudioChannelMasks;             { Audio channes to use }
    nm_masks := sizeof(AudioChannelMasks);      { Number of channels }
    mouths   := 0;                              { No mouth }
    with message do begin
      IO_data    := @output_buf;                { Where to get data from }
      IO_command := CMD_WRITE;                  { This is a Write block }
      IO_offset  := 0;
      IO_length  := 1                           { Only one char right now }
    end                                         { ( = #0 ) }
  end;

  if OpenDevice('narrator.device', 0, pIORequest(writeNarrator), 0) <> 0 then begin
    CloseDown;
    goto 1
  end;

  DefaultParameters([SexParam, RateParam, VolumeParam, PitchParam,
                     FreqParam, ModeParam]);

  SpeechLive := TRUE;           { Success! }
  1:                            { Where to go if problems }
  OpenSpeech := SpeechLive
end;

procedure CloseSpeech;
begin
  if SpeechLive then begin
    CloseLibrary(pLibrary(TranslatorBase));
    DeletePort(writePort);
    CloseDevice(pIORequest(writeNarrator));
    DeleteExtIO(pIORequest(writeNarrator));
    SpeechLive := FALSE
  end
end;

procedure Say(s : string);
var
  return : longint;
  i      : integer;
begin
  s := s + #0;
  return := Translate(@s[1], length(s), @output_buf, sizeof(output_buf) - 1);
  i := 0;  while output_buf[i] <> #0 do inc(i);         { C str. length }
  writeNarrator^.message.IO_length := i;
  return := DoIO(pIORequest(writeNarrator))
end;

procedure SetFrequency(n : FreqRange);
begin
  writeNarrator^.sampfreq := n
end;

procedure SetRate(n : RateRange);
begin
  writeNarrator^.rate := n
end;

procedure SetPitch(n : PitchRange);
begin
  writeNarrator^.pitch := n
end;

procedure SetMode(n : Mode);
begin
  writeNarrator^.mode := ord(n)       { Trick! As n is an enumerated type }
end;                                  { it has values 0 and 1 which are }
                                      { the same values as NATURALF0 (0) }
                                      { and ROBOTICF0 (1), so all we need }
                                      { is to construct our subrange proper-}
                                      { ly (human, robot) }

procedure SetSex(n : Sex);
begin
  writeNarrator^.sex := ord(n)        { As above }
end;

procedure SetVolume(n : VolumeRange);
begin
  writeNarrator^.volume := n
end;

procedure DefaultParameters(p : ParamSet);
begin
  if SexParam    in p then SetSex      (male);
  if VolumeParam in p then SetVolume   (DEFVOL);
  if RateParam   in p then SetRate     (DEFRATE);
  if ModeParam   in p then SetMode     (human);
  if PitchParam  in p then SetPitch    (DEFPITCH);
  if FreqParam   in p then SetFrequency(DEFFREQ)
end;

begin
  writeNarrator := NIL;
  SpeechLive := FALSE
end.