aws-sdk-delphi-samples/ReadWhatYouSee/DataModules.TextToSpeech.pas at main · appercept/aws-sdk-delphi-samples · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
unit DataModules.TextToSpeech;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections,
  AWS.Polly;

type
  TTextToSpeechDM = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    FClient: IPollyClient;
    FLanguageCode: string;
    FVoice: IPollyVoice;
    FVoices: TList<IPollyVoice>;
    procedure LoadVoices;
    function SelectAllVoicesForLanguage(const ALanguageCode: string): TList<IPollyVoice>;
    function SelectVoiceForLanguage(const ALanguageCode: string): IPollyVoice;
    procedure SetLanguageCode(const ALanguageCode: string);
    function VoiceSupportsLanguage(const ALanguageCode: string): Boolean;
    property Client: IPollyClient read FClient;
    property Voices: TList<IPollyVoice> read FVoices;
  public
    function ConvertTextToSpeech(const AText: string; out AFileName: string): Boolean;

    property LanguageCode: string read FLanguageCode write SetLanguageCode;
    property Voice: IPollyVoice read FVoice;
  end;

var
  TextToSpeechDM: TTextToSpeechDM;

implementation

{%CLASSGROUP 'FMX.Controls.TControl'}

{$R *.dfm}

function TTextToSpeechDM.ConvertTextToSpeech(const AText: string; out AFileName: string): Boolean;
var
  LRequest: IPollySynthesizeSpeechRequest;
  LResponse: IPollySynthesizeSpeechResponse;
  LAudioFile: TFileStream;
begin
  LRequest := TPollySynthesizeSpeechRequest.Create;
  if Voice.SupportedEngines.Contains('neural') then
    LRequest.Engine := 'neural'
  else
    LRequest.Engine := 'standard';
  LRequest.LanguageCode := Voice.LanguageCode;
  LRequest.OutputFormat := 'mp3';
  LRequest.Text := AText;
  LRequest.VoiceId := Voice.Id;
  LResponse := Client.SynthesizeSpeech(LRequest);
  if LResponse.IsSuccessful then
  begin
    AFileName := Format('ReadWhatYouSee%s.mp3', [FormatDateTime('yyyymmddhhnnsszzz', Now)]);
    LAudioFile := TFileStream.Create(AFileName, fmCreate);
    try
      LAudioFile.CopyFrom(LResponse.AudioStream);
    finally
      LAudioFile.Free;
    end;
    Result := True;
  end
  else
    Result := False;
end;

procedure TTextToSpeechDM.DataModuleCreate(Sender: TObject);
begin
  FClient := TPollyClient.Create;
  FVoices := TList<IPollyVoice>.Create;
  LoadVoices;
end;

procedure TTextToSpeechDM.DataModuleDestroy(Sender: TObject);
begin
  FVoices.Free;
  FClient := nil;
end;

procedure TTextToSpeechDM.LoadVoices;
var
  LRequest: IPollyDescribeVoicesRequest;
  LResponse: IPollyDescribeVoicesResponse;
  LMore: Boolean;
begin
  LRequest := TPollyDescribeVoicesRequest.Create;
  LMore := True;
  while LMore do
  begin
    LResponse := Client.DescribeVoices(LRequest);
    if LResponse.IsSuccessful then
    begin
      Voices.AddRange(LResponse.Voices);
      LRequest.NextToken := LResponse.NextToken;
      LMore := not LRequest.NextToken.IsEmpty;
    end
    else
      LMore := False;
  end;
end;

function TTextToSpeechDM.SelectAllVoicesForLanguage(
  const ALanguageCode: string): TList<IPollyVoice>;
var
  LVoice: IPollyVoice;
begin
  Result := TList<IPollyVoice>.Create;
  for LVoice in Voices do
  begin
    if LVoice.LanguageCode.Equals(ALanguageCode) then
      Result.Add(LVoice);
  end;
end;

function TTextToSpeechDM.SelectVoiceForLanguage(
  const ALanguageCode: string): IPollyVoice;
var
  LVoices: TList<IPollyVoice>;
  LVoice: IPollyVoice;
begin
  LVoices := SelectAllVoicesForLanguage(ALanguageCode);
  try
    if LVoices.Count = 0 then
      Exit(nil);

    for LVoice in LVoices do
      if LVoice.SupportedEngines.Contains('neural') then
        Exit(LVoice);
    Result := LVoices.First;
  finally
    LVoices.Free;
  end;
end;

procedure TTextToSpeechDM.SetLanguageCode(const ALanguageCode: string);
begin
  FLanguageCode := ALanguageCode;
  if not VoiceSupportsLanguage(ALanguageCode) then
    FVoice := SelectVoiceForLanguage(FLanguageCode);
end;

function TTextToSpeechDM.VoiceSupportsLanguage(
  const ALanguageCode: string): Boolean;
begin
  if not Assigned(FVoice) then
    Exit(False);

  Result := Voice.LanguageCode.Equals(ALanguageCode);
end;

end.