unit uttsSintese;

interface
uses Windows, Classes, Dialogs, sysutils, mmsystem;

var
    suavizaJuncao: boolean;

procedure carregaBaseDifones (base: string);
procedure falaDifones (lines: TStrings; nomeArq: string);

implementation

var
    fala: array [0..500000] of byte;

type
    TDifo = record
        dif1, dif2: string[2]; { difones }
        nomeArqDifo, ident: string;
        p1, p2, p3: integer;   { posição do início, fronteira e fim }
    end;

type
    TVETAMOSTRAS = array [0..100000] of smallInt;
    PVETAMOSTRAS = ^TVETAMOSTRAS;

var veloc: integer;
    ndifo: integer;
    tabDifo: array [1..2000] of TDIFO;
    nomeBase: string;

const
    waveHeaderSize = 44;

procedure genWavHdr (pvet: pchar; veloc: longint; bits, channels: word; size: longint);
const
    wavHdr: array [0..waveHeaderSize-1] 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;

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 carregaBaseDifones (base: string);
var arq: textFile;
    s: string;
begin
    nomeBase := base;
    assignFile (arq, nomeBase);

    ndifo := 0;
    try
        reset (arq);
        while not eof (arq) do
             begin
                 readln (arq, s);
                 if s = '' then continue;

                 if s[1] = '!' then
                     veloc := strToInt (copy (s, 2, 9))
                 else
                     begin
                         ndifo := ndifo + 1;
                         with tabDifo [ndifo] do
                             begin
                                 dif1 := pegaPalavra (s);
                                 dif2 := pegaPalavra (s);
                                 nomeArqDifo := pegaPalavra (s);
                                 ident := pegaPalavra (s);
                                 p1 := strToInt (pegaPalavra(s));
                                 p2 := strToInt (pegaPalavra(s));
                                 p3 := strToInt (pegaPalavra(s));
                             end;
                     end;
             end;
        closeFile (arq);
    except
        showMessage ('Base ' + nomeBase + ' não encontrada');
    end;
end;

procedure rampaFrequencia (pOrig: PVETAMOSTRAS; nOrig: integer;
                           pDest: PVETAMOSTRAS; var nDest: integer;
                           perc1, perc2: real);
var
    delta, vari: real;
    t, x, y: real;
    i, x0: integer;


begin
    delta := perc1;
    vari  := (perc2-perc1) / norig;

    x := 0;
    i := 0;
    repeat
        t := frac (x);
        x0 := trunc (x);
        y := (1-t)*porig^[x0] + t*porig^[x0 + 1];
        pDest^[i] := trunc(y);
        x := x + delta + (i*vari);
        i := i + 1;
    until x0 >= nOrig-1;

    nDest := i;
end;

function acrescentaFala (var pfala: pchar; ultDifo, difo: string; durDifo: integer): boolean;
type
    TVetSuaviza = array [0..199] of smallInt;

var i, x: integer;
    arqSom: file;
    dir: string;
    bufAux: TVetSuaviza;
    p: ^TVetSuaviza;
    t: real;
begin
    dir := nomeBase;
    while (dir <> '') and (dir[length(dir)] <> '\') do
        delete (dir, length(dir), 1);

    for i := 1 to ndifo do   // colocar aqui uma tabela de acesso direto
        with tabDifo [i] do
             begin
                 if (dif1 = ultDifo) and (dif2 = difo) then
                      begin
                          assignFile (arqSom, dir+ '\' + nomeArqDifo);
                          reset (arqSom, 1);
                          if suavizaJuncao and (pfala > @fala[200+waveHeaderSize]) then
                              begin
                                  seek (arqSom, waveHeaderSize+(p1*2)-400);
                                  blockRead (arqSom, bufaux, 400);
                                  p := @pfala[-400];
                                  for x := 0 to 199 do
                                      begin
                                          t := x / 200;
                                          p[x] := trunc ((1-t) * p[x] + t * bufaux[x]);
                                      end;
                              end;

                          seek (arqSom, waveHeaderSize+p1*2);
                          blockRead (arqSom, pfala^, (p3-p1)*2);
                          closefile (arqSom);
                          pfala := pfala + (p3-p1)*2;

                          acrescentaFala := true;
                          exit;
                      end;
             end;

    acrescentaFala := false;
    showMessage ('Não achado o difone ' + ultDifo + '-' + difo);
end;

procedure falaDifones (lines: TStrings; nomeArq: string);
var i: integer;
    lido, difo, ultdifo, temp: string;
    pfala: pchar;
    durDifo: integer;
    arqSom: file;

begin
    ultdifo := '_';
    pfala := @fala[waveHeaderSize];

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

            difo := pegaPalavra (lido);

            if (difo <> '') and (difo[1] = '>') then delete (difo, 1, 1);
            if (difo <> '') and (difo[1] = '¨') then delete (difo, 1, 1);

            temp := pegaPalavra (lido);
            if temp = '' then
                durDifo := 100
            else
                durDifo := strToInt (temp);

            if not acrescentaFala (pfala, ultDifo, difo, durDifo) then
                begin
                    acrescentaFala (pfala, ultDifo, 'y', 50);
                    acrescentaFala (pfala, 'y', difo, 50);
                end;
            ultDifo := difo;
        end;

    genWavHdr (@fala, 16000, 16, 1, pfala-@fala[waveHeaderSize]);
    if nomeArq = '' then
        sndplaySound (@fala, SND_ASYNC+SND_MEMORY)
    else
        begin
            assign (arqSom, nomeArq);
            rewrite (arqSom, 1);
            blockWrite (arqSom, fala, pfala-@fala[0]);
            closefile (arqSom);
        end;
end;

end.