unit uttsProsodia;

interface
uses Classes, sysUtils, dialogs;

function inicProsodia (arqConfigProsodia: string): boolean;
function preProsodia (texto: string): TStringList;
procedure aplicaProsodia (fonemas: TStringList; var mbrolaCmd: TStringList);
function calculaCurvaProsodia (palavrasComCodigos: TStringList;
                               comProsodia:boolean): TStringList;

implementation

type
    str2 = string[2];
    str3 = string[3];

    TDuracao = record
         dif: string[2];
         dur: integer;
    end;

type
    TChave = record
         palavra: string;
         funcao: str2;
    end;

type
    TProsodia = record
         codAnt, codAtual, codProx: str3;
         codificacao: string;
    end;

var maxFon: integer;
    tabDur: array [1..100] of TDuracao;
    maxChaves: integer;
    tabChaves: array [1..300] of TChave;
    maxProsodia: integer;
    tabProsodia: array [1..100] of TProsodia;

var
    hertz: integer;
    tabHertz: array ['0'..'9'] of integer;

{--------------------------------------------------------}

procedure ordenaChaves;
var i, j: integer;
    temp: TChave;
begin
    for i := 1 to maxChaves-1 do
        for j := 2 to maxChaves do
            if tabChaves[i].palavra > tabChaves[j].palavra then
                begin
                    temp := tabChaves[i];
                    tabChaves[i] := tabChaves[j];
                    tabChaves[j] := temp;
                end;
end;

{--------------------------------------------------------}

function buscaChave (qual: string): str2;
var ini, fim, meio: integer;
begin
    qual := AnsiUpperCase(qual);
    ini := 1;
    fim := maxChaves;

    buscaChave := '';
    while ini <= fim do
        begin
            meio := (ini + fim) div 2;
            if tabChaves[meio].palavra = qual then
                begin
                    buscaChave := tabChaves[meio].funcao;
                    ini := fim + 1;
                end
            else
            if tabChaves[meio].palavra < qual then
                 fim := meio-1
            else
                 ini := meio+1;
        end;
end;

{--------------------------------------------------------}

function inicProsodia (arqConfigProsodia: string): boolean;
var arqProsodia: textFile;
    s, sequencia: string;
    p: integer;
    c: char;

label achouDuracao, achouChaves, achouProsodia;
begin
    inicProsodia := false;
    maxFon := 0;
    hertz := 230;

    assignFile (arqProsodia, arqConfigProsodia);
    {$I-}  reset (arqProsodia);  {$I+}
    if ioresult <> 0 then
        begin
            showMessage ('Configuração da prosódia não foi achada');
            exit;
        end;

    while not eof (arqProsodia) do
        begin
            readln (arqProsodia, s);
            if trim(s) = '[DURAÇÃO]' then goto achouDuracao;
        end;

    showMessage ('Duração dos difones errada ou ausente');
    exit;

achouDuracao:
    while not eof (arqProsodia) do
        begin
           readln (arqProsodia, s);
           if (s = '') or (s[1] = ';') or (s[1] = '*') then
               continue;
           if s[1] = '[' then break;

           maxFon := maxFon + 1;
           with tabDur [maxFon] do
               begin
                   p := pos ('=', s);
                   if p = 0 then
                       begin
                           showMessage ('Configuração da prosódia: fonema errado: ' + s);
                           exit;
                       end;
                   dif := trim (copy (s, 1, p-1));
                   try
                       dur := strToInt (trim (copy (s, p+1, 999)));
                   except
                       showMessage ('Configuração da prosódia: fonema errado: ' + s);
                       exit;
                   end;
               end;
        end;
    closeFile (arqProsodia);

{---------------------------}

    reset (arqProsodia);
    while not eof (arqProsodia) do
        begin
            readln (arqProsodia, s);
            if trim(s) = '[CHAVES]' then goto achouChaves;
        end;

    showMessage ('Prosódia: palavras chaves ausentes');
    exit;

achouChaves:
    while not eof (arqProsodia) do
        begin
           readln (arqProsodia, s);
           if (s = '') or (s[1] = ';') or (s[1] = '*') then
               continue;
           if s[1] = '[' then break;

           maxChaves := maxChaves + 1;
           with tabChaves [maxChaves] do
               begin
                   p := pos ('=', s);
                   if p = 0 then
                       begin
                           showMessage ('Configuração da prosódia: chave errada: ' + s);
                           exit;
                       end;
                   palavra := ansiUppercase (trim (copy (s, 1, p-1)));
                   funcao := ansiUppercase (trim (copy (s, p+1, 999)));
               end;
        end;

    ordenaChaves;

{---------------------------}

    reset (arqProsodia);
    while not eof (arqProsodia) do
        begin
            readln (arqProsodia, s);
            if trim(s) = '[PROSÓDIA]' then goto achouProsodia;
        end;

    showMessage ('Prosódia: especificações ausentes');
    exit;

achouProsodia:
    while not eof (arqProsodia) do
        begin
           readln (arqProsodia, s);
           if (s = '') or (s[1] = ';') or (s[1] = '*') then
               continue;
           if s[1] = '[' then break;
           s := ansiUpperCase (s);

           if copy (s, 1, 6) = 'HERTZ=' then
               begin
                   delete (s, 1, 6);
                   s := trim (s);
                   hertz := strToInt (s);
                   continue;
               end;

           if copy (s, 1, 9) = 'TABHERTZ=' then
               begin
                   delete (s, 1, 9);
                   s := s + ',';
                   for c := '0' to '9' do
                       begin
                           p := pos (',', s);
                           tabHertz[c] := strToInt (trim(copy (s, 1, p-1)));
                           delete (s, 1, p);
                       end;
                   continue;
               end;

           maxProsodia := maxProsodia + 1;
           with tabProsodia [maxProsodia] do
               begin
                   p := pos ('=', s);
                   if p = 0 then
                       begin
                           showMessage ('Configuração da prosódia: chave errada: ' + s);
                           exit;
                       end;

                   codificacao := trim (copy (s, p+1, 999));
                   sequencia := trim (copy (s, 1, p-1)) + '|||';

                   p := pos ('|', sequencia);
                   codAnt := copy (sequencia, 1, p-1);
                   delete (sequencia, 1, p);
                   p := pos ('|', sequencia);
                   codAtual := copy (sequencia, 1, p-1);
                   delete (sequencia, 1, p);
                   p := pos ('|', sequencia);
                   codProx := copy (sequencia, 1, p-1);
               end;
        end;

    inicProsodia := true;
end;

{--------------------------------------------------------}

function preProsodia (texto: string): TStringList;
const
   alfabeto: set of char =
        ['A','E','I','O','U','À','Á','Â','Ã','É','Ê','Ì','Í','Ó','Ô','Õ','Ù','Ú','Ü',
         'a','e','i','o','u','à','á','â','ã','é','ê','ì','í','ó','ô','õ','ù','ú','ü',
         'b'..'d','f'..'h','j'..'n','p'..'t','v'..'z', 'ç', 'ñ',
         'B'..'D','F'..'H','J'..'N','P'..'T','V'..'Z', 'Ç', 'Ñ'];

   fimDeFrase: set of char = ['.', '!' , '?'];

var pt: integer;
    saida: TStringList;
    pal: string;
    e_especial: boolean;
    ch: str2;

    procedure pegaPalavra (var palavra: string; var especial: boolean);
    var s: string;
    begin
        s := '';
        especial := true;
        while (pt <= length (texto)) and (texto[pt] = ' ') do
            pt := pt + 1;

        if (pt < length (texto)) and
                 (texto[pt] = '.') and (texto[pt+1] = '.') then
            begin
                palavra := '.-';
                while (pt <= length (texto)) and (texto[pt] = '.') do
                    pt := pt + 1;
                exit;
            end;

        if (pt <= length (texto)) and (not (texto[pt] in alfabeto)) then
            begin
                palavra := texto[pt] + texto[pt];
                especial := true;
                pt := pt + 1;
                exit;
            end;

        while (pt <= length (texto)) and (texto[pt] in alfabeto) do
            begin
                s := s + texto[pt];
                pt := pt + 1;
            end;

        palavra := s;
        especial := false;
    end;

begin
    pt := 1;
    saida := TStringList.Create;
    saida.add ('[--]');   { início de frase normal }

    while pt <= length (texto) do
        begin
            pegaPalavra (pal, e_especial);
            if pal = '' then break;

            if e_especial then
                begin
                    ch := pal;
                    pal := ch[1];
                end
            else
                begin
                    ch := buscaChave(pal);
                    if ch = '' then
                        ch := 'XX';
                end;

            saida.Add ('[' + ch + ']' + pal);
            if (pal <> '') and (pal[1] in fimDeFrase) then
                begin
                   saida.Add ('[--]');
                end;
        end;

    preProsodia := saida;
end;

{--------------------------------------------------------}

function calculaCurvaProsodia (palavrasComCodigos: TStringList;
                               comProsodia:boolean): TStringList;
var s0, s, sp, cod: string;
    cAnt, cAtual, cProx: str2;
    i, ult, pr: integer;
    ultValor: char;
    listaComCurva: TStringList;

begin
    s  := '';
    sp := '';
    ultValor := '5';
    listaComCurva := TStringList.create;

    ult := palavrasComCodigos.count-1;
    for i := 0 to ult+1 do
        begin
            if (i <= ult) and (palavrasComCodigos[i] = '') then continue;

            s0 := s;
            s := sp;
            if i > ult then sp := ''
                       else sp := palavrasComCodigos[i];

            if s = '' then continue;

            cAnt   := copy (s0, 2, 2);
            cAtual := copy (s , 2, 2);
            cProx  := copy (sp, 2, 2);

            cod := '';
            for pr := 1 to maxProsodia do
                with tabProsodia[pr] do
                    begin
                        if ((codAnt   = '') or (codAnt   = cAnt  )) and
                           ((codAtual = '') or (codAtual = cAtual)) and
                           ((codProx  = '') or (codProx  = cProx )) then
                                begin
                                    cod := codificacao;
                                    break;
                                end;
                end;

            if cod = '' then
                cod := '555'
            else
            if cod[1] = '?' then
                cod[1] := ultValor;

            ultValor := cod[3];
            listaComCurva.add (cod + '|' + copy (s, 5, 999));
        end;

    calculaCurvaProsodia := listaComCurva;
end;

{--------------------------------------------------------}

procedure aplicaProsodia (fonemas: TStringList; var mbrolaCmd: TStringList);
var i, f: integer;
    s, prosodia: string;
    duracao, amplif: integer;
    cod: str3;
    estado: (inicio, estavel, tonica, fim);
    ultimaLetra: boolean;
    tamanho: integer;

label guarda;

    function calculaProsodia: string;
    begin
        calculaProsodia := '';

        case estado of
            inicio:
                begin
                    calculaProsodia := '40 ' + intToStr((tabHertz[cod[1]] * hertz) div 100);
                    estado := estavel;
                end;

            tonica:
                begin
                    calculaProsodia :=
                          ' 20 ' + intToStr((tabHertz[cod[2]] * hertz) div 100);
                    estado := fim;
                end;
            fim:
                if ultimaLetra then
                        calculaProsodia :=
                              ' 30 ' + intToStr((tabHertz[cod[3]] * hertz) div 100);
        end;
    end;

begin
    mbrolaCmd := TStringList.create;
    amplif := 100;
    cod := '555';
    estado := inicio;
    tamanho := 0;

    for i := 0 to fonemas.count-1 do
        begin
            prosodia := '';

            s := fonemas[i];
            ultimaLetra := (i = fonemas.count-1) or (fonemas[i+1] = '');

            if s = '' then
                begin
                    amplif := 100;
                    goto guarda;
                end;

            if (copy (s, 1, 1) = ';') and (copy (s, 5, 1) = '|') then
                begin
                    cod := copy (s, 2, 3);
                    delete (s, 2, 4);
                    tamanho := length (s);
                    estado := inicio;
                    goto guarda;
                end;

            if s[1] = '>' then
                begin
                     amplif := 145;
                     delete (s, 1, 1);
                     if (s <> '') and (s[1] = '¨') then
                         delete (s, 1, 1);
                     estado := tonica;
                end
            else
                if s[1] = '¨' then
                     begin
                         delete (s, 1, 1);
                         amplif := 100;
                     end;

            if s[1] = '_' then
                begin
                    duracao := strToInt (trim (copy(s, 3, 999)));
                    s := '_';
                end
            else
                begin
                    duracao := 100;
                    for f := 1 to maxFon do
                        if s = tabDur[f].dif then
                            begin
                                duracao := tabdur[f].dur;
                                if (tamanho > 10) and (estado < tonica) then
                                    duracao := duracao * 80 div 100;
                                break;
                            end;
                end;

            s := s + ' ' + intToStr (duracao * amplif div 100);

            prosodia := calculaProsodia;
            if prosodia <> '' then
                 s := s + ' ' + prosodia;

    guarda:
            mbrolaCmd.Add (s);
        end;
end;

end.