unit uMbrTradutor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mbrPort, umbrPreproc, mmsystem, clipbrd, uMbrVars;
  
type
  TForm1 = class(TForm)
    e_texto: TEdit;
    b_compilar: TButton;
    Memo1: TMemo;
    b_sintetizar: TButton;
    b_parar: TButton;
    b_inicTrad: TButton;
    e_tradutor: TEdit;
    e_excessao: TEdit;
    b_preproc: TButton;
    c_marcaSilabas: TCheckBox;
    c_marcaTonica: TCheckBox;
    b_juntaLinhas: TButton;
    e_difones: TEdit;
    b_inicDifones: TButton;
    CheckBox1: TCheckBox;
    b_falar: TButton;
    Button3: TButton;
    c_crossfade: TCheckBox;
    procedure b_pararClick(Sender: TObject);
    procedure b_sintetizarClick(Sender: TObject);
    procedure b_inicTradClick(Sender: TObject);
    procedure b_compilarClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure b_preprocClick(Sender: TObject);
    procedure b_juntaLinhasClick(Sender: TObject);
    procedure b_inicDifonesClick(Sender: TObject);
    procedure b_falarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure genWavHdr (pvet: pchar; veloc: longint; bits, channels: word; size: longint);
const
    wavHdr: array [0..43] of byte = (
        $52, $49, $46, $46,    {'RIFF'}
        $ff, $ff, $ff, $ff,    {riff size}
        $57, $41, $56, $45, $66, $6d, $74, $20,    {'WAVEFMT '}
        $10, $00, $00, $00,    {hdr size}
        $01, $00, $01, $00, $11, $2b, $00, $00, $11, $2b, $00, $00, $01, $00, $08, $00,  {reg}
        $64, $61, $74, $61,    {'data'}
        $ff, $ff, $ff, $ff);   {data size}

var l: longint;
    p: pointer;
    lpFormat: PPCMWAVEFORMAT;

begin
    new (lpFormat);
    with lpFormat^, lpFormat^.wf do
        begin
            wFormatTag := WAVE_FORMAT_PCM;
            nSamplesPerSec := veloc;
            wBitsPerSample := bits;
            nChannels := channels;
            nBlockAlign := (wBitsPerSample div 8) * nChannels;
            nAvgBytesPerSec := nBlockAlign * nSamplesPerSec;
        end;

    p := @wavHdr[20];
    move (lpFormat^, p^, sizeof (lpFormat^));
    l := size + 36;
    p := @wavHdr[4];
    move (l, p^, sizeof (l));
    p := @wavHdr[40];
    move (size, p^, sizeof (size));

    move (wavHdr, pvet^, sizeof (wavHdr));
    dispose (lpFormat);
end;

procedure TForm1.b_pararClick(Sender: TObject);
begin
    sndPlaySound (NIL, snd_async);
end;

function pegaPalavra (var s: string): string;
var p: string;
begin
    p := '';
    while (s <> '') and ((s[1] = ' ') or (s[1] = ^i)) do
       delete (s, 1, 1);
    while (s <> '') and ((s[1] <> ' ') and (s[1] <> ^i)) do
        begin
            p := p + s[1];
            delete (s, 1, 1);
        end;
    while (s <> '') and ((s[1] = ' ') or (s[1] = ^i)) do
       delete (s, 1, 1);
    result := p;
end;

procedure TForm1.b_sintetizarClick(Sender: TObject);
var i: integer;
    lido: string;
    fala: array of byte;
    numAmostras: integer;
    x, dif1, dif2: string;
    dur: integer;

    procedure acrescentaFala (dif1, dif2: string; dur: integer);
    begin
        // ... completar ...
        setLength (fala, numAmostras*2+44);
        // ... completar ...
    end;

begin
    numAmostras := 0;
    dif1 := #$ff;

    for i := 0 to memo1.lines.count-1 do
        begin
            lido := trim (memo1.lines[i]);
            if (lido = '') or (lido[1] = ';') then continue;

            dif2 := pegaPalavra(lido);
            x := pegaPalavra(lido);
            dur := 0;
            if x <> '' then dur := StrToInt(x);

            if dif1 <> #$ff then
                 acrescentaFala (dif1, dif2, dur);
            dif1 := dif2;
        end;

    genWavHdr (@fala, 16000, 16, 1, numAmostras);
    sndplaySound (@fala, SND_SYNC+SND_MEMORY)
end;

procedure TForm1.b_inicTradClick(Sender: TObject);
begin
    fimTradutor;
    if not inicTradutor (e_tradutor.Text, e_excessao.Text) then
        showMessage ('Erro na base de dados do compilador');
    b_inicDifonesClick(sender);
end;

procedure TForm1.b_compilarClick(Sender: TObject);
var fonemas: string;
begin
     marcaSilaba := c_marcaSilabas.Checked;
     marcaTonica := c_marcaTonica.Checked;

     compilaFonemas (e_texto.Text, fonemas);
     if length (fonemas) > 0 then
         memo1.SetTextBuf(@fonemas[1]);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
    b_inicTradClick (sender);
    b_inicDifonesClick (sender);
end;

procedure TForm1.b_preprocClick(Sender: TObject);
begin
    Memo1.clear;
    Memo1.Lines.add (preProcessa (e_texto.text));
end;

procedure TForm1.b_juntaLinhasClick(Sender: TObject);
var i: integer;
    x: integer;
    h, s: string;
begin
    s := '';
    for i := 0 to memo1.Lines.count do
        begin
            if (memo1.lines[i] <> '') and (memo1.lines[i][1] <> ';')  and
                                          (memo1.lines[i][1] <> '[')then
                begin
                    h := trim(memo1.lines[i]);
                    for x := 1 to length (h) do
                        if (h[x] = ' ') or (h[x] = ^I) then
                            begin
                                delete (h, x, 999);
                                break;
                            end;
                    s := s + ' ' + h;
                end;
        end;

    if s <> '' then delete (s, 1, 1);
    memo1.clear;
    memo1.lines.add (s);
    Clipboard.AsText := s;
end;

procedure TForm1.b_inicDifonesClick(Sender: TObject);
var arq: textFile;
    s: string;
    p0, pp: integer;

    function pegaPalavra (s: string; var pp: integer): string;
    begin
        while (pp <= length (s)) and ((s[pp] = ^I) or (s[pp] = ' ')) do
            pp := pp + 1;
        p0 := pp;
        while (pp <= length (s)) and ((s[pp] <> ^I) and (s[pp] <> ' ')) do
            pp := pp + 1;
        pegaPalavra := copy (s, p0, pp-p0);
    end;

begin
    assignFile (arq, e_difones.text);
    ndif := 0;
    try
        reset (arq);
    except
        showMessage ('Base ' + e_difones.text + ' não encontrada');
        exit;
    end;

    try
        while not eof (arq) do
             begin
                 readln (arq, s);
                 s := trim (s);
                 if s = '' then continue;
                 pp := 1;

                 if s[1] = '!' then
                     veloc := strToInt (copy (s, 2, 9))
                 else
                     begin
                        ndif := ndif + 1;
                        with tabDif[ndif] do
                             begin
                                 dif1 := pegaPalavra (s, pp);
                                 dif2 := pegaPalavra (s, pp);
                                 nomeArqDifo := pegaPalavra (s, pp);
                                 ident  := pegaPalavra (s, pp);
                                 pini   := strToint (pegaPalavra (s, pp));
                                 pfront := strToint (pegaPalavra (s, pp));
                                 pfim   := strToint (pegaPalavra (s, pp));
                             end;
                     end;
             end;
    finally
        closeFile (arq);
    end;

end;

procedure TForm1.b_falarClick(Sender: TObject);
var i, k: integer;
    lido, difo: string;
begin
    for i := 0 to memo1.lines.count-1 do
        begin
            difo := '';
            lido := memo1.lines[i];
            for k := 1 to length (lido) do
                begin
                    if lido[k] in ['a'..'z','0'..'9', '@'] then
                        difo := difo + lido[k]
                    else
                        break;
                end;




        end;

    sndPlaySound ('\windows\temp\tsint.wav', snd_async)
end;

end.