{--------------------------------------------------------}
{
{     Rotinas de fala do DOSVOX para Windows
{
{     Autor: José Antonio Borges
{
{     Em Janeiro/98
{
{--------------------------------------------------------}

unit dvwin;
interface

uses dvcrt, WinProcs, winTypes, mmsystem, strings, dvtradut, dvinter, dvlenum, dvHora;

function sintAmbiente (nomeSecao, nomeAmbiente: string): string;
procedure sintInic (veloc: integer; dirSons: string);
procedure sintFim;
procedure sintParam (quanto, minimo, interv: integer; corta, acelera: boolean);
procedure sintTeclaCorta (teclaCorta: boolean);
procedure sintVeloc (n: integer);

function  sintFalando: boolean;
procedure sintCarac (c: char);
procedure sintSom (nomeSom: string);

procedure geraCabWav (pvet: pchar; tamSom: longint);
procedure sintClek;
procedure sintBip;
procedure sintSoletra (s: string);
procedure sintetiza (s: string);

function sintEditaCampo (var campo: string; x, y, tamanho, tamVisual: integer;
                     altera: boolean): char;
function  sintEdita (var campo: string; x, y, tamanho: integer;
                         altera: boolean): char;
procedure sintReadLn (var s: string);
function  sintReadKey: char;
procedure sintReadint (var n: integer);
procedure sintLeTecla (var c1, c2: char);

procedure sintWrite (s: string);
procedure sintWriteLn (s: string);
procedure sintWriteint (n: longint);

function existeArqSom (nomeSom: string): boolean;

function maiuscAnsi (s: string): string;
procedure limpaBufTec;
function compactaLinha (nome: string): string;

var
    sintFalaPont: boolean;
    sintCursorX: integer;

procedure calaBoca;

const
    ALTF1   = #104;

    CTLF1 = #94;
    CTLF2 = #95;
    CTLF3 = #96;
    CTLF4 = #97;
    CTLF5 = #98;
    CTLF6 = #99;
    CTLF7 = #100;
    CTLF8 = #101;
    CTLF9 = #102;
    CTLF10 = #103;
    CTLF11 = #104;
    CTLF12 = #105;

    F1    = #59;
    F2    = #60;
    F3    = #61;
    F4    = #62;
    F5    = #63;
    F6    = #64;
    F7    = #65;
    F8    = #66;
    F9    = #67;
    F10   = #68;
    F11   = #69;
    F12   = #70;

    INS   = #82;
    DEL   = #83;
    HOME  = #71;
    TEND  = #79;
    PGUP  = #73;
    PGDN  = #81;
    CIMA  = #72;
    BAIX  = #80;
    ESQ   = #75;
    DIR   = #77;
    ENTER = #13;
    BS    = #08;
    ESC   = #27;
    TAB   = #09;

    CTLPGUP  = #132;
    CTLPGDN  = #118;
    CTLESQ   = #115;
    CTLDIR   = #116;
    CTLBS    = #127;
    CTLENTER = #10;

    SHIFTINS = #254;
    CTLINS   = #255;

    GOTFOCUS = #$EE;
    NOFOCUS  = #$EF;



implementation

var
    fon: string;
    nomeDirSom, nomeDirLetras: string;
    falando: boolean;
    hsom: THandle;
    psom: pchar;
    acelerando: boolean;

{--------------------------------------------------------}
{                inicializa sistema de fala
{--------------------------------------------------------}

procedure sintInic (veloc: integer; dirSons: string);
var n: integer;
    arq: file;
begin
    calaBoca;
    if sintAmbiente ('DOSVOX', 'MINIVOX') = 'SIM' then
        veloc := 2;
    if veloc < 1 then
         val (sintAmbiente ('TRADUTOR', 'VELOCIDADE'), veloc, n);

    if (veloc < 1) or (veloc > 4) then veloc := 2;

    case veloc of
        1: sintBDSom := 'DIFONES';
        2: sintBDSom := 'DIFONES3';
        3: sintBDSom := 'DIFONES2';
        4: sintBDSom := 'DIFONES3';
    end;

    n := tradinic;
    if (n <> 0) and
       ((veloc = 2) or (veloc = 4)) then    {evita falha para usuarios antigos }
        begin
            tradFim;
            sintBDSom := 'DIFONES2';
            tradInic;
        end;

    if n <> 0 then
        begin
            writeln ('Erro de inicialização: ', n );
            writeln ('Banco de dados de voz: ', sintBDSom);
            tradfim;

            readln;
            doneWincrt;
        end;

    nomeDirSom := dirSons;
    if nomeDirSom <> '' then
        if nomeDirSom [length (nomeDirSom)] <> '\' then
            nomeDirSom := nomeDirSom + '\';

    n := GetPrivateProfileString('TRADUTOR', 'DIRLETRAS',
         'c:\dosvox\som\letras\', @nomeDirLetras[1], 80, 'DOSVOX.INI');
    nomeDirLetras[0] := chr(n);
    if nomeDirLetras [length(nomeDirLetras)] <> '\' then
        nomeDirLetras := nomeDirLetras + '\';

    sintVeloc (veloc);

    hsom := globalAlloc (GMEM_MOVEABLE or GMEM_SHARE, 20000);
    pSom := globalLock (hsom);
end;

{--------------------------------------------------------}
{                finaliza sistema de fala
{--------------------------------------------------------}

procedure sintFim;
begin
    while sintFalando do;
    if pSom <> NIL then
        begin
            globalUnlock (hsom);
            globalFree (hsom);
        end;
    pSom := NIL;
    tradfim;
end;

{--------------------------------------------------------}
{                seleciona a velocidade
{--------------------------------------------------------}

procedure sintParam (quanto, minimo, interv: integer; corta, acelera: boolean);
begin
    paramFala (quanto, minimo, interv, corta, acelera);
    acelerando := acelera;
end;

{--------------------------------------------------------}
{            seleciona o diretorio de ambiente
{--------------------------------------------------------}

function sintAmbiente (nomeSecao, nomeAmbiente: string): string;
var n: integer;
    returnString: string;
begin
    if nomeSecao = '' then nomeSecao := 'DOSVOX';
    nomeSecao := nomeSecao + #$0;
    nomeAmbiente := nomeAmbiente + #$0;
    n := GetPrivateProfileString(@nomeSecao[1], @nomeAmbiente[1],
         '', @returnString[1], 80, 'DOSVOX.INI');
    returnString[0] := chr(n);
    sintAmbiente := returnString;
end;

{--------------------------------------------------------}
{             gera cabecalho do formato WAV
{--------------------------------------------------------}

const TAMCABWAV = 44;

procedure geraCabWav (pvet: pchar; tamSom: longint);
const
    cabWav: array [0..43] of byte = (
        $52, $49, $46, $46, $ff, $ff, $ff, $ff, $57, $41, $56, $45, $66, $6d, $74, $20,
        $10, $00, $00, $00, $01, $00, $01, $00, $11, $2b, $00, $00, $11, $2b, $00, $00,
        $01, $00, $08, $00, $64, $61, $74, $61, $ff, $ff, $ff, $ff);

var l: longint;
begin
    move (cabWav, pvet^, 44);
    l := tamSom;
    move (l, pvet[40], 4);
    l := l + 36;
    move (l, pvet[4], 4);

    if acelerando then
       l := 17000
    else
       l := 11025;
    move (l, pvet[24], 4);
    move (l, pvet[28], 4);
end;

{--------------------------------------------------------}
{                seleciona a velocidade
{--------------------------------------------------------}

procedure sintVeloc (n: integer);
var
    c, s, i, erro: integer;

begin
   if sintAmbiente ('DOSVOX', 'MINIVOX') = 'SIM' then
        n := 2;

   c := 0;
   val (sintAmbiente ('TRADUTOR', 'CORTEFON'), c, erro);
   s := 0;
   val (sintAmbiente ('TRADUTOR', 'SOBRAFON'), s, erro);
   i := 0;
   val (sintAmbiente ('TRADUTOR', 'INTERPAL'), i, erro);

   case n of
      1: sintParam (1000, 1000, 100, false, false);
      2: sintParam (400, 1000, 0, false, false);
      3: sintParam (c, s, i, false, false);
      4: sintParam (200, 0, 0, true, true);
   end;
end;

{--------------------------------------------------------}
{                     ve se falando
{--------------------------------------------------------}

function sintFalando: boolean;
begin
    if keypressed then   { ativa looping de mensagens do Windows }
        begin
            sndplaysound (NIL, snd_async);
            sintFalando := false;
        end
    else
        sintFalando := not sndplaysound (NIL, snd_async+snd_nostop);
    keypressed;          { ativa looping do Windows }
end;

{--------------------------------------------------------}
{               produz um som na memoria
{--------------------------------------------------------}

procedure produzSom (nomeArq: string);
var arq: file;
    l: longint;
begin
    assign (arq, nomeArq);
    {$I-} reset (arq, 1);  {$i+}
    if ioresult <> 0 then
        begin
            sintBip;
            exit;
        end;

    while sintFalando do;      { interrompe com keypressed }

    {$I-} blockRead (arq, pSom^, fileSize (arq));  {$I+}
    if ioresult <> 0 then;
    geraCabWav (pSom, fileSize (arq)-TAMCABWAV);

    sndplaysound (pSom, snd_async+snd_memory);

    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then;
end;

{--------------------------------------------------------}
{                ecoa um Caractere
{--------------------------------------------------------}

procedure sintCarac (c: char);
var
    s: string;
begin
    str (ord(c), s);
    produzSom (dirletras + '_' + s + '.wav');
end;

{--------------------------------------------------------}
{      sintetiza som assincrono testando keypressed
{--------------------------------------------------------}

procedure sintSom (nomeSom: string);
var
    nomeArq: array [0..128] of char;
begin
    if nomeSom[1] = '_' then
        begin
            nomeSom := nomeDirLetras + nomeSom + '.wav';
            produzSom (nomeSom);
        end
    else
        begin
            nomeSom := nomeDirSom + nomeSom + '.wav';
            strPCopy (nomeArq, nomeSom);
            while sintFalando do;      { interrompe com keypressed }
            if keypressed then exit;
            sndPlaySound (nomeArq, snd_async);
        end;
end;

{--------------------------------------------------------}
{           verifica se existe arquivo de som
{--------------------------------------------------------}

function existeArqSom (nomeSom: string): boolean;
var arqSom: file;
begin
    existeArqSom := true;
    nomeSom := nomeDirSom + nomeSom + '.wav';
    assign (arqSom, nomeSom);
    {$I-} reset (arqSom);  {$I+}
    if ioresult <> 0 then
        existeArqSom := false
    else
        close (arqSom);
end;

{--------------------------------------------------------}
{                    faz um clek
{--------------------------------------------------------}

procedure SintClek;
var i, t: integer;
    v: array [0..50+TAMCABWAV] of byte;
begin
    for i := 0 to 39 do
        v[i+TAMCABWAV] := random($60)+$80;
    for i := 40 to 50 do
        v[i+TAMCABWAV] := $80;
    geraCabWav (@v, 51);

    while sintFalando do;      { interrompe com keypressed }
    if not keypressed then
        sndPlaySound (@v, snd_async + snd_memory);
end;

{--------------------------------------------------------}
{                   toca um bip
{--------------------------------------------------------}

Procedure SintBip;
var i, j: integer;
    t, tempo: word;
    v: array [0..600+TAMCABWAV] of byte;
    c: char;

begin
    i := TAMCABWAV;
    while i < 600+TAMCABWAV do
        begin
            v[i] := $80; inc (i);
            v[i] := $70; inc (i);
            v[i] := $60; inc (i);
            v[i] := $50; inc (i);
            v[i] := $40; inc (i);
            v[i] := $50; inc (i);
            v[i] := $60; inc (i);
            v[i] := $70; inc (i);
        end;

    v[600+TAMCABWAV] := $80;
    geraCabWav (@v, 601);

    while sintFalando do;      { interrompe com keypressed }
    sndPlaySound (@v, snd_async + snd_memory);
    delay (50);
end;

{--------------------------------------------------------}
{                soletra uma cadeia
{--------------------------------------------------------}

procedure sintSoletra (s: string);
var i: integer;
begin
    if keypressed then exit;
    for i := 1 to length (s) do
        sintCarac (s[i]);
end;

{--------------------------------------------------------}
{         le uma tecla falando, sem ecoar na tela
{--------------------------------------------------------}

function sintReadKey: char;
var c: char;
begin
    while sintFalando do;
    c := readkey;
    sndPlaySound (NIL, snd_async);
    sintCarac (c);
    sintReadKey := c;
end;

{--------------------------------------------------------}
{               escreve e fala uma cadeia
{--------------------------------------------------------}

procedure sintWrite (s: string);
begin
    write (s);
    while sintFalando do;
    sintetiza (s);
end;

{--------------------------------------------------------}
{        escreve e fala uma cadeia pulando linha
{--------------------------------------------------------}

procedure sintWriteLn (s: string);
begin
    sintWrite (s);
    writeln;
end;

{--------------------------------------------------------}
{        escreve e fala um numero pulando linha
{--------------------------------------------------------}

procedure sintWriteint (n: longint);
var s: string;
begin
    str (n, s);
    sintWrite (s);
end;


{--------------------------------------------------------}
{              trata os sinais de pontuacao
{--------------------------------------------------------}

procedure trataPontuacao (s: string);
begin
    if keypressed then exit;

    while sintFalando do;

    if sintFalaPont then sintcarac (s[1]);

    case s[1] of
        '.':   if (length (s) > 1) and (s[2] = ' ') then
                   delay (400)
               else
                   if not sintFalaPont then sintCarac (s[1]);   { evita repetir letra }

        ',':   if (length (s) > 1) and (s[2] = ' ') then
                   delay (200)
               else
                   if not sintFalaPont then sintCarac (s[1]);   { evita repetir letra }

        ';', ':', '(', ')':   delay (300);
    end;
end;

{--------------------------------------------------------}
{                   sintetiza uma cadeia
{--------------------------------------------------------}

procedure sintetiza (s: string);
var fon: string;
    encontrouHifen: boolean;
    subcad: string;
    i, erro: integer;
    x: longint;
    c: char;

    ultLetra: char;
    nrepUlt: integer;

    p : pchar;

const
    alfa: set of char = [' ', 'A'..'Z', 'a'..'z', #128..#255];
    alfapuro: set of char = ['A'..'Z', 'a'..'z', #128..#255];

begin
    ultLetra := ' ';
    nrepUlt := 0;

    s := s + ' ';
    while s <> '' do
        begin
            while s[1] = '0' do
                begin
                    sintSom ('_zero');
                    delete (s, 1, 1);
                end;

            if s[1] in ['1'..'9'] then
                begin
                    encontrouHifen := false;
                    subcad := '';
                    while (s <> '') and (s[1] in ['0'..'9', '-']) do
                        begin
                            subcad := subcad + s[1];
                            if s[1] = '-' then
                                encontrouHifen := true;
                            delete (s, 1, 1);
                        end;
                    if encontrouHifen then  { provavel numero de telefone }
                        sintSoletra (subcad)
                    else
                        begin
                            if length (subcad) > 5 then
                                sintSoletra (subcad)
                            else
                                begin
                                    val (subcad, x, erro);
                                    falaNumeroConv (numeroParaString (x), MASCULINO);
                                end;
                        end;
                end
            else

            if s[1] in alfa then
                begin
                    subcad := '';
                    while (s <> '') and (s[1] in Alfa) do
                        begin
                            subcad := subcad + s[1];
                            delete (s, 1, 1);
                        end;

                    if length (subcad) > 70 then
                        begin
                            i := 70;
                            while (i < length (subcad)) and (subcad [i] <> ' ') do
                                i := i + 1;
                            compilaFonemas (copy (subcad, 1, i), fon);
                            falaFonemas (fon, false);
                            delete (subcad, 1, i);
                        end;

                    if subcad <> '' then
                        begin
                            compilaFonemas (subcad, fon);
                            falaFonemas (fon, false);
                        end;

                    if (s[1] = '-') and (s[2] in alfapuro) then
                        delete (s, 1, 1);
                end
            else

                begin
                    c := s[1];

                    if ultLetra = c then
                        begin
                            nrepUlt := nrepUlt + 1;
                            if nrepUlt > 3 then
                                begin
                                    sintClek;
                                    c := ' ';
                                end;
                        end
                    else
                        begin
                            nrepUlt := 0;
                            ultLetra := c;
                        end;

                    if c in ['.', ',', ';', ':', '(', ')'] then
                        trataPontuacao (s)
                    else
                    if (c <> ' ') and (c <> #$09) and (not keypressed) then
                        sintCarac (c);

                    delete (s, 1, 1);
                end;
        end;
end;

{--------------------------------------------------------}
{             calcula uma string em maiuscula
{--------------------------------------------------------}

function maiuscAnsi (s: string): string;
var x: string;
    i: integer;
begin
    x := s;
    for i:= 1 to length (s) do
        if x[i] in ['a'..'z'] then
            x[i] := upcase (x[i])
        else
            if x[i] in [#$e0..#$ff] then
                x[i] := chr (ord(x[i]) - $20);
    maiuscAnsi := x;
end;

{--------------------------------------------------------}
{                limpa o buffer do teclado
{--------------------------------------------------------}

procedure limpaBufTec;
var c: char;
begin
    while keypressed do
        c := readkey;
end;

{--------------------------------------------------------}
{                 le uma tecla, ecoando
{--------------------------------------------------------}

procedure sintLeTecla (var c1, c2: char);
label inicio;
begin
inicio:
    while sintFalando do;
    c2 := ' ';
    c1 := readkey;
    if c1 = #0 then c2 := readkey;

    if (c1 = #0) and (c2 = F8) then
        begin
            falaHora;
            goto inicio;
        end;

    if (c1 <> GOTFOCUS) and (c1 <> NOFOCUS) then
        if c1 in [#32..#126, #127..#255] then
            begin
                sintCarac (c1);
                write (c1);
            end;
end;

{--------------------------------------------------------}
{     tira brancos do inicio e do fim de uma cadeia
{--------------------------------------------------------}

function compactaLinha (nome: string): string;
var s: string;
    i: integer;
begin
    s := nome;
    for i := 1 to length (s) do
        s[i] := upcase(s[i]);

    s := s + '*';
    while s[1] = ' ' do
        s := copy (s, 2, length(s)-1);
    s := copy (s, 1, length(s)-1);

    s := '*' + s;
    while s[length(s)] = ' ' do
        s := copy (s, 1, length(s)-1);
    s := copy (s, 2, length(s)-1);
    compactaLinha := s;
end;

{--------------------------------------------------------}
{                    edita um item
{--------------------------------------------------------}

function sintEditaCampo (var campo: string; x, y, tamanho, tamVisual: integer;
                     altera: boolean): char;
var c, c2: char;
    curx, i: integer;
    fonemas: string;
    primeiraVez: boolean;
    colInic: integer;

label fechaCampo;

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

    procedure caracComum (c: char);
    begin
        if not altera then
            exit;

        if curx > tamanho then
            begin
                sintBip;
                exit;
            end;

        if falando then
            sintCarac (c);
        insert (c, campo, curx);
        delete (campo, tamanho+1, 1);
        curx := curx + 1;
    end;

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

    procedure delCarac;
    var campoPc: string;
        c: char;
    begin
        if not altera then
            exit;

        c := campo [curx];
        delete (campo, curx, 1);
        campo := campo + ' ';

        gotoxy (x, y);
        campoPC := copy (campo, colinic, tamVisual);
        write (campoPC);

        sintSom ('_DEL');
        sintCarac(c);
    end;

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

    function temVogal (s: string): boolean;
    const
        CONSOANTES: set of char =
        ['B','C','D','F','G','H','J','K','L','M',
         'N','P','Q','R','S','T','V','X','Z'];

    var i: integer;

    begin
        temVogal := true;
        for i := 1 to length (s) do
             if not (upcase (s[i]) in CONSOANTES) then exit;
        temVogal := false;
    end;

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

    procedure falaPalavra;
    var palavra: string;
        c: char;
        i, salvacur: integer;
    begin
        campo := campo + #0;
        salvacur := curx;
        while (campo [curx] = ' ') do
            curx := curx + 1;

        c := upcase (campo [curx]);
        case c of
            #0: sintBip;

            'A'..'Z', #128..#255:
                begin
                    palavra := '';
                    repeat
                        palavra := palavra + campo[curx];
                        curx := curx + 1;
                    until not (upcase (campo[curx]) in
                            ['A'..'Z', #128..#255]);
                    if temVogal (palavra) then
                        sintetiza (palavra)
                    else
                        sintSoletra (palavra);
                end;

            '0'..'9', '-':
                begin
                    palavra := '';
                    repeat
                        palavra := palavra + campo[curx];
                        curx := curx + 1;
                    until not (campo[curx] in ['0'..'9']);
                    sintetiza (palavra);
                end;

        else
            begin
                palavra := campo [curx];
                curx := curx + 1;
                sintSoletra (palavra);
            end;
        end { case };

        campo := copy (campo, 1, length(campo)-1);
        if c = #0 then
            curx := salvacur;
    end;

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

    procedure avancaPalavra;
    var tam: integer;
        c: char;
    begin
        tam := length (campo);
        campo := campo + ' @';

        c := campo [curx];
        if c <> ' ' then
            if c in ['0'..'9'] then
                repeat
                    curx := curx + 1;
                    c := campo [curx];
                until not (c in ['0'..'9'])
            else
                repeat
                    curx := curx + 1;
                    c := campo [curx];
                until not (c in ['a'..'z', 'A'..'Z', #128..#255]);

        if c = ' ' then
            repeat
                curx := curx + 1;
                c := campo [curx];
            until c <> ' ';

        campo := copy (campo, 1, tam);

        if curx > tam+1 then
            begin
                curx := length(campo)+1;
                repeat
                    curx := curx - 1;
                until (curx = 0) or (campo[curx] <> ' ');
                curx := curx + 1;
                sintBip;
            end
        else
            sintClek;
    end;

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

    procedure recuaPalavra;
    var tam: integer;
        c: char;
    begin
        tam := length (campo);
        campo := ' @' + campo;
        curx := curx + 2;

        repeat
            curx := curx - 1;
            c := campo [curx];
        until c <> ' ';

        if c in ['0'..'9'] then
            repeat
                curx := curx - 1;
                c := campo [curx];
            until not (c in ['0'..'9'])
        else
            repeat
                curx := curx - 1;
                c := campo [curx];
            until not (c in ['a'..'z', 'A'..'Z', #128..#255]);

        campo := copy (campo, 3, tam);
        curx := curx - 1;

        if curx <= 0 then
            begin
                curx := 1;
                sintBip;
            end
        else
            sintClek;
    end;

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

var campoPc: string;
    buf: array [1..255] of char;
    xx: integer;
    temLetras: boolean;
    sn: string[6];
    v: integer;

label moveu;
begin
    if tamanho > 255 then
        tamanho := 255;

    if tamVisual > tamanho then
        tamVisual := tamanho;
    with currentWindow do
        if (y = bottom-top+1) and (x+tamVisual > right-left+1) then
            tamVisual := tamVisual - 1;

    campo := copy (campo, 1, tamanho);
    while length (campo) < tamanho do
        campo := campo + ' ';

    primeiraVez := true;
    curx := 1;
    colInic := 1;

    repeat
        if curx < colInic then colInic := curx;
        if curx > colinic+tamVisual then colInic := curx-tamVisual;

        gotoxy (x, y);
        campoPC := copy (campo, colinic, tamVisual);
        write (campoPC);
        gotoxy (curx-colinic+x, y);

        c := readkey;
        sndPlaySound (NIL, snd_async);

        if c = #0 then
            begin
                c2 := readkey;
                case c2 of
                    ESQ: if curx <= 1 then
                              sintBip
                          else
                              begin
                                  curx := curx - 1;
                                  sintCarac (campo [curx]);
                              end;

                    DIR: begin
                              if curx >= length (campo) then
                                  sintBip
                              else
                                  begin
                                      sintCarac (campo [curx]);
                                      curx := curx + 1;
                                  end;
                         end;

                    HOME: curx := 1;

                    TEND:  begin
                              curx := length (campo)+1;
                              repeat
                                  curx := curx - 1;
                              until (curx = 0) or (campo[curx] <> ' ');
                              curx := curx + 1;
                          end;

                    DEL: delCarac;

                    F1:  begin
                             if (getKeyState (VK_MENU) shr 15) <> 0 then
                                 begin
                                     c2 := ALTF1;
                                     goto fechaCampo;
                                 end;
                             falaPalavra;
                         end;

                    F4:  begin
                             falando := not falando;
                             if falando then
                                 sintSom ('_FALACI')   {Fala acionada}
                             else
                                 sintSom ('_FALDLG');  {Fala desligada}
                         end;

                    CTLF4:  begin
                                sintSom ('_VELOC');  {Fala desligada}
                                repeat
                                    c := sintReadkey;
                                until not keypressed;
                                if (c <> ESC) and (c <> ENTER) then
                                    begin
                                        sintFim;
                                        v := ord (c) - ord('0');
                                        sintInic (v, nomeDirSom);
                                    end;
                            end;
                    F8:     falaHora;

                    CTLDIR: avancaPalavra;

                    CTLESQ: recuaPalavra;

                    CTLF1:  sintetiza (campo);

                    CTLINS:   begin
                                  xx := length (campo);
                                  repeat
                                      xx := xx - 1;
                                  until (xx = 0) or (campo[xx] <> ' ');
                                  for i := 1 to xx do
                                      buf[i] := campo[i];
                                  buf [xx+1] := #$0;
                                  putClipboard (@buf);
                              end;

                    SHIFTINS:  begin
                                   getClipboard (@buf, length(campo)+1);
                                   fillchar (campo[1], length (campo), ' ');
                                   buf [length(campo)+1] := #$0;
                                   for i := 1 to strLen (@buf)+1 do
                                       begin
                                           if (buf[i] = #$0d) or (buf[i] = #$0a) or
                                              (buf[i] = #$0) then
                                                           goto moveu;
                                           campo[i] := buf [i];
                                       end;
                                   i := strLen (@buf) + 2;
                 moveu:
                                   curx := i;
                               end;

                else
                    goto FechaCampo;
                end
            end
        else
            begin
                c2 := c;
                case c of
                    NOFOCUS: ;
                    GOTFOCUS:  begin
                                   calaBoca;
                                   while sintFalando do;
                                   sintetiza (campo);
                    	       end;

                    ENTER, CTLENTER, ESC: begin
                                    c2 := c;
                                    goto FechaCampo;
                                end;

                    TAB:   goto fechaCampo;

                    BS:    begin
                               if curx = 1 then
                                   sintBip
                               else
                                   begin
                                       curx := curx - 1;
                                       delCarac;
                                   end;
                           end;

                    ^C:    begin
                               str (curx, sn);
                               sintetiza (sn);
                           end;

                    ^D:    if altera then
                           begin
                               for i := curx to length (campo) do
                                   campo [i] := ' ';
                               sintSom ('_APFCPO');
                           end;

                    ^Y:    if altera then
                           begin
                               for i := 1 to length (campo) do
                                   campo [i] := ' ';
                               sintSom ('_CPOAPA');
                               curx := 1;
                           end;

                    #0..#31: ;
                else
                    if primeiraVez then
                        begin
                             temLetras := false;
                             for i := curx to length (campo) do
                                 if campo [i] <> ' ' then
                                     temLetras := true;
                             if temLetras then
                                 begin
                                     sintClek;
                                     while sintFalando do;
                                     sintClek;
                                     while sintFalando do;
                                 end;
                        end;
                    caracComum (c);
                end;
            end;

        primeiraVez := false;
    until false;

fechaCampo:
    sintEditaCampo := c2;
    sintCursorX := curx;

    gotoxy (x, y);
    campoPC := copy (campo, 1, tamVisual);
    write (campoPC);
    gotoxy (x, y);

    curx := tamanho+1;
    repeat
        curx := curx - 1;
    until (curx = 0) or (campo[curx] <> ' ');

    if curx = 0 then
        campo := ''
    else
        campo := copy (campo, 1, curx);
end;

{--------------------------------------------------------}
{                    edita um item
{--------------------------------------------------------}

function sintEdita (var campo: string; x, y, tamanho: integer;
                     altera: boolean): char;
var
    tamVisual: integer;
begin
    with currentWindow do
        tamVisual := right-left+1;
    sintEdita := sintEditaCampo (campo, x, y, tamanho, tamVisual, altera);
end;

{--------------------------------------------------------}
{                le uma cadeia ecoando
{--------------------------------------------------------}

procedure sintReadLn (var s: string);
var c: char;
begin
    s := '';
    c := sintEdita (s, wherex, wherey, 81 - wherex, true);
    writeln;
end;

{--------------------------------------------------------}
{                le um numero ecoando
{--------------------------------------------------------}

procedure sintReadint (var n: integer);
var c: char;
    erro: integer;
    s: string;
begin
    s := '';
    c := sintEdita (s, wherex, wherey, 81 - wherex, true);
    s := compactaLinha (s);
    if s <> '' then
        val (compactaLinha(s), n, erro);
    writeln;
end;

{--------------------------------------------------------}
{                 impede monitvox de falar
{--------------------------------------------------------}

procedure calaBoca;
var arq: file;
begin
    assign (arq, 'c:\calaboca.$$$');
    {$I-} rewrite (arq);  {$I+}
    if ioresult = 0 then;
    {$I-} close (arq);  {$I+}
    if ioresult = 0 then;
end;

procedure sintTeclaCorta (teclaCorta: boolean);
begin
end;

begin
    pSom := NIL;
    falando := true;
    sintFalaPont := true;
    acelerando := false;
end.
