unit uttsPreproc;

interface
uses sysUtils;

function preProcessa (texto: string): string;
function soletragem (c: char): string;

{--------------------------------------------------------}

implementation

type strNome = string [20];

const
    tabUnid: array [0..9] of strNome =
          ('zero', 'um', 'dois', 'três', 'quatro',
           'cinco', 'seis', 'sete', 'oito', 'nove');

    tabDez: array [0..9] of strNome =
          ('dez','onze','doze','treze','quatorze',
           'quinze','dezesseis','dezessete','dezoito','dezenove');

    tabDezena: array [2..9] of strNome =
          ('vinte','trinta','quarenta','cinqüenta',
           'sessenta','setenta','oitenta','noventa');

    tabCentena: array [0..9] of strNome =
          ('cem','cento','duzentos','trezentos','quatrocentos','quinhentos',
           'seiscentos','setecentos','oitocentos','novecentos');

    tabMil: array [0..4] of strNome =
          ('trilhão ','bilhão ','milhão ','mil ','');

    tabMils: array [0..4] of strNome =
          ('trilhões ','bilhões ','milhões ','mil ','');

    e: strNome = ' e ';

var textoSai: string;
    texto: string;


{--------------------------------------------------------}

function numeroParaString (v: cardinal): string;
var num, s: string;
    posConector: boolean;

{--------------------------------------------------------}

    function convmil (s: strNome): string;
    var conv: string;
    label fim;
    begin
        conv := '';

        if s = '000' then
            goto fim;

        if s = '100' then
            begin
               conv := tabCentena [0];
               goto fim;
            end;

        if s[1] <> '0' then
            begin
                conv := tabCentena [ord(s[1]) - ord('0')];
                if copy (s, 2, 2) = '00' then
                    goto fim;
                conv := conv + e;
                posConector := true;
            end;

        if s[2] = '1' then
            begin
                conv := conv + tabDez [ord(s[3]) - ord('0')];
                goto fim;
            end;

        if s[2] <> '0' then
            begin
                conv := conv + tabDezena [ord(s[2]) - ord('0')];
                if copy (s, 3, 1) = '0' then
                    goto fim;
                conv := conv + e;
                posConector := true;
            end;


        if s[3] > '0' then
            conv := conv + tabUnid [ord(s[3]) - ord('0')];

    fim:
        convMil := conv;
    end;

{--------------------------------------------------------}

    function conv3 (s: string; i: integer): string;
    var conv: string;
        tresdig: strNome;

    begin
        tresdig := copy (s, 1+i*3, 3);
        conv := convmil (tresdig);
        if tabMil [i] <> '' then
           if tresdig <> '000' then
               if tresdig = '001' then
                   conv := conv + ' ' + tabMil [i]
               else
                   conv := conv + ' ' + tabMils [i];

        conv3 := conv;
    end;

{--------------------------------------------------------}

var
    i, ultMilhar: integer;
    smils: array [0..4] of string;
    conect : strNome;

begin
    if v = 0 then
        begin
            numeroParaString := tabUnid [0];
            exit;
        end;

    str (v, num);
    num := '00000000000000' + num;
    num := copy (num, length(num)-14, 15);
    s := '';

    ultMilhar := 4;

    for i := 0 to 4 do
        begin
            smils[i] := conv3 (num, i);
            if smils[i] <> '' then
                ultMilhar := i;
        end;

    conect := '';
    for i := 0 to ultMilhar do
        begin
            posConector := false;

            if (i = ultMilhar) and (smils [i] <> '') and (not posconector) then
                s := s + conect + smils[i]
            else
                s := s + smils[i];

            if smils[i] <> '' then    // esta heurística não está boa
                conect := 'e ';
        end;

    if (copy (s, 1, 6) = 'um mil') and (copy (s, 1, 7) <> 'um milh') then
         delete (s, 1, 3);

    numeroParaString := s;
end;

{--------------------------------------------------------}

function numeroFeminino (s: string): string;
begin
    if copy (s, length(s)-1, 2) = 'um' then
       numeroFeminino := s + 'a'
    else

    if copy (s, length(s)-3, 4) = 'dois' then
        numeroFeminino := copy (s, 1, length(s)-4) + 'duas'

    else
        numeroFeminino := s;
end;

{--------------------------------------------------------}

function numeroParaTexto (texto: string; var i: integer): string;
var saida: string;
    j, n: integer;

begin
    saida := '';

    n := 0;
    for j := i to length (texto) do
        begin
            if texto[j] in ['0'..'9'] then
                n := (n * 10) + (ord(texto[j]) - ord('0'))
            else
            if (texto[j] = '.') and (length(texto) <= j+3) and
                (texto[j+1] in ['0'..'9']) and
                (texto[j+2] in ['0'..'9']) and
                (texto[j+3] in ['0'..'9']) then
                    continue
            else
                 break;
            i := j+1;
        end;

    result := numeroParaString(n);
end;

{--------------------------------------------------------}

function preProcessa (texto: string): string;
var i: integer;
    l: char;
    textoSai: string;
begin
    i := 1;
    textoSai := '';
    while i <= length (texto) do
        begin
            if (texto[i] = '-') and (length(texto) > i) and
                (texto[i+1] in ['0'..'9']) then
                textoSai := textoSai + 'menos '
            else
            if texto[i] in ['0'..'9'] then
                begin
                    textoSai := textoSai + numeroParaTexto (texto, i) + ' ';
                    i := i - 1;
                end
            else
                textoSai := textoSai + texto[i];
            i := i + 1;
        end;

    textoSai := trim(textoSai);
    if (textoSai <> '') and (textoSai [length(textoSai)] <> '.') then
        textoSai := textoSai + '.';

    result := textoSai;
end;

{--------------------------------------------------------}

function soletragem (c: char): string;
const
    nomesLetras: array [' '..'~'] of string = (
        { } 'espaço',
        {!} 'exclamação',
        {"} 'aspas',
        {#} 'sustenido',
      { $ } 'cifrão',
        {%} 'percentual',
        {&} 'e-comercial',
        {'} 'apóstrofe',
        {(} 'abre parêntese',
        {)} 'fecha parêntese',
        {*} 'asterisco',
        {+} 'sinal mais',
        {,} 'vírgula',
        {-} 'traço',
        {.} 'ponto',
        {/} 'barra',

        'zéro','um','dois','três','quatro','cinco','seis','séte','oito','nóve',

        {:} 'dois pontos',
        {;} 'ponto e vírgula',
        {<} 'menor que',
        {=} 'igual',
        {>} 'maior que',
        {?} 'interrogação',
        {@} 'arroba',

        'a', 'bê',' cê',' dê','é','éfe','gê','agá','i','jota','cá','éle','ême',
        'ene','ó','pê','quê','érre','ésse','tê','u','vê','dábliu','xis','ípsilon','zê',

        {[} 'abre colchete',
        {\} 'barra invetida',
        {]} 'fecha colchete',
        {^} 'circunflexo',
        {_} 'sublinhado',
        {`} 'crase',

        'a', 'bê',' cê',' dê','é','éfe','gê','agá','i','jota','cá','éle','ême',
        'ene','ó','pê','quê','érre','ésse','tê','u','vê','dábliu','xis','ípsilon','zê',

        {{} 'abre chave',
        {|} 'barra vertical',
        { } 'fecha chave',
        {~} 'til'
    );

    nomesAcentuadas: array ['À'..'Ü'] of string = (

        {À}    'A grave',
        {Á}    'A agudo',
        {Â}    'A circunflexo',
        {Ã}    'A com til',
        {Ä}    'A com trema',
        {Å}    'A bola',
        {Æ}    'A É',
        {Ç}    'cedilha',
        {È}    'É grave',
        {É}    'É agudo',
        {Ê}    'É circunflexo',
        {Ë}    'É com trema',
        {Ì}    'I grave',
        {Í}    'I agudo',
        {Î}    'I circunflexo',
        {Ï}    'I com trema',
        {Ð}    'Dê cortado',
        {Ñ}    'N com til',
        {Ò}    'Ó grave',
        {Ó}    'Ó agudo',
        {Ô}    'Ó circunflexo',
        {Õ}    'Ó com til',
        {Ö}    'Ó tremado',
        {×}    'vezes',
        {Ø}    'Ó cortado',
        {Ù}    'U grave',
        {Ú}    'U agudo',
        {Û}    'U circunflexo',
        {Ü}    'U com trema'
    );

begin
    if c in [' '..'~'] then
        result := nomesLetras [c]
    else
    if c in ['À'..'Ü'] then
        result := nomesAcentuadas [c]
    else
    if ord (c) > $e0 then
        result := soletragem (chr (ord (c) - 32))
    else
        result := ' código ' + numeroParaString (ord(c));
end;

end.
