{---------------------------------------------------------------------}
{    Projeto DOSVOX - NCE/UFRJ
{    Interface sonora para o banco de dados de legislação
{                da Editora CICBRAS
{    Autor: José Antonio Borges
{    Em 21/04/99
{---------------------------------------------------------------------}

{$M 16536,8192}
program codCivil;
{$R codcivil.res}


uses dvcrt, dvwin, dvmacro, dvInter, dvexec, winprocs, wintypes, strings, win31;

var s: string;
    titulo: array [0..80] of char;
    janOriginal, minhaJan, janCodigo, janFoco: hWnd;
    processando: boolean;
    achados: integer;
    monitorAtivo: boolean;
    nomeArq: string;

c 'agua', 'código de águas
c 'boab', 'estatuto da oab
c 'ccivilc', 'projeto de lei do código civil
c 'ccivl', 'código civil
c 'ccom', 'código comercial
c 'cdcon', 'código de defesa do consumidor
c 'clt', 'consolidação das leis do trabalho
c 'codminas', 'código de mineração
c 'cons88', 'constituição brasileira de 1988
c 'contran', 'código de trânsito brasileiro
c 'cpc', 'código de processo civil
c 'cpenal', 'código penal
c 'cpp', 'código de processo penal
c 'ctrib', 'código tributário nacional
'ecria', 'estatuto da criança e do adolescente
c 'eleitora', 'código eleitoral
c 'fauna', 'código de proteção à fauna
'fgts', 'regulamento do fundo de garantia por tempo de serviço
c 'floresta', 'código florestal
'jtst', 'Jurisprudência do Tribunal Superior do Trabalho
'jurimpas', 'jurisprudências do ministério da previdência e assistência social
'lici', 'lei 8666 de licitações e contratos
'medida', 'medidas provisórias previdenciárias
c 'militar', 'código penal militar
'parecer', 'pareceres previdenciários
c 'pcps', 'plano de custeio da previdência social
c 'pesca', 'código de pesca
'portaria', 'portarias previdenciárias
c 'rbps', 'regulamento de benefícios da previdência social
'ritst', 'regimento interno do Tribunal Superior do Trabalho
c 'rocs', 'regulamento de organização e custeio da Seguridade Social
'rtrab', 'jurisprudência previdenciária
'senado97', 'leis complementares até 1997
'stf', 'jurisprudência do Supremo Tribunal Federal
'stj', 'jurisprudência do Supremo Tribunal de Justiça
'stj2', 'jurisprudência do Supremo Tribunal de Justiça (acórdãos)
'sumgem', 'súmulas de uniformização de jurisprudência predominante dos tribunais brasileiros
'tjb', 'jurisprudência dos Tribunais de Justiça
'trf', 'jurisprudência dos Tribunais Regionais Federais
'trf2', 'jurisprudência dos Tribunais Regionais Federais (acórdãos)
'vocjur', 'vocabulário enciclopédico de tecnologia jurídica e de brocardos latinos'

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

const
    msgTitulo = 'Interface sonora para acesso a legislação - Projeto DOSVOX - NCE/UFRJ';

procedure mensagem (nomeArq: string; nlf: integer);
var i: integer;
    s: string;
begin
    if nomeArq = 'CCINIC' then
        s := 'Acesso sonoro à legislação'
    else
    if nomeArq = 'CCINSCD' then
        s := 'Insira o CD-ROM e aperte ENTER'
    else
    if nomeArq = 'CCAGUARD' then
        s := 'Aguarde a carga do código na memória'
    else
    if nomeArq = 'CCCARGAD' then
        s := 'Código carregado'
    else
    if nomeArq = 'CCPROCAN' then
        s := 'Programa cancelado'
    else
    if nomeArq = 'CCLETXT' then
        s := 'Lendo texto com as setas'
    else
    if nomeArq = 'CCOPPESQ' then
        s := 'A-por artigo  L-leis complementares  T-textos livres'
    else
    if nomeArq = 'CCPESQA' then
        s := 'Informe o número do artigo'
    else
    if nomeArq = 'CCPESQL' then
        s := 'Informe o número da lei ou o assunto entre aspas'
    else
    if nomeArq = 'CCPESQT' then
        s := 'Informe o texto entre aspas'
    else
    if nomeArq = 'CCDESIS' then
        s := 'Desistiu'
    else
    if nomeArq = 'CCENCONT' then
        s := 'Encontrados '
    else
    if nomeArq = 'CCARQDST' then
        s := 'Qual o nome do arquivo destino ? '
    else
    if nomeArq = 'CCADIARQ' then
        s := 'Adicionando a arquivo existente'
    else
    if nomeArq = 'CCQUANT' then
        s := 'Quantas linhas transfiro ? '
    else
    if nomeArq = 'CCERRDSK' then
        s := 'Erro de escrita no arquivo'
    else
    if nomeArq = 'CCERRFEC' then
        s := 'Erro ao fechar o arquivo'
    else
    if nomeArq = 'CCARQINV' then
        s := 'Arquivo inválido'
    else
    if nomeArq = 'CCCODFEC' then
        s := 'Código fechado'
    else
    if nomeArq = 'CCOPCAO' then
        s := 'Sua opção: '
    else
    if nomeArq = 'CCAJUDOP' then
        s := 'Opções:  L-ler C-contínuo G-gravar P-pesquisa +próximo -anterior ESC fim'
    else
        s := '--> Mensagem invalida: ' + nomeArq;

    write (s);
    for i := 1 to nlf do
         writeln;

    if existeArqSom (nomeArq) then
        sintSom (nomearq)
    else
        sintetiza (s);
end;


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

procedure cancelaMonitor;
var janMonitor, janAtual: hWnd;
begin
    janMonitor := findWindow (NIL, 'MONITVOX');
    monitorAtivo := janMonitor <> 0;
    janAtual := getFocus;
    if monitorAtivo then
        begin
            showWindow (janMonitor, sw_maximize);
            playInit (300);
            playVirtKey (VK_F4, false, false, true, 1);
            playStart;
            while  playIsActive do;
        end;
    setFocus (janAtual);
end;

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

procedure inicializa;
var placement: TWindowPlacement;
    dirCodCivil: string;
begin
    janOriginal := getFocus;
    cancelaMonitor;

    dirCodCivil := sintAmbiente ('CODCIVIL', 'DIRCODCIVIL');
    sintInic (0, dirCodCivil);

    screenSize.y := 5;
    clrscr;
    setWindowText (crtWindow, msgTitulo);
    textColor (WHITE);

    textBackGround (BLUE);
    mensagem ('CCINIC', 1);    {'Acesso sonoro ao código civil'}
    textBackGround (BLACK);

    nomeArq := '';
end;

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

procedure trazCodigo;
var drive: array [0..144] of char;
    cancelou: boolean;
begin
    minhaJan := getFocus;
    mensagem ('CCINSCD', 0);     {'Insira o CD-ROM na unidade e aperte ENTER'}
    readln;

    mensagem ('', 0);            {'Digite a sigla da base dados desejada (F1 ajuda)'}

    mensagem ('CCAGUARD', 1);    {'Aguarde a carga do código na memória'}
    GetWindowsDirectory (@drive, 144);
    executaProg (drive[0] + ':\windows\menuin~1\progra~1\netjus\código~7.lnk', '.', '');

    cancelou := false;
    repeat
        delay (1000);
        getWindowText (getActiveWindow, titulo, 80);
        s := strpas (titulo);
        if keypressed then
            if readkey = #$1b then
                cancelou := true;
    until (pos ('Folio Bound VIEWS', s) <> 0) or cancelou;

    if cancelou then
        begin
            mensagem ('CCPROCAN', 1);    {'Programa cancelado'}
            sintfim;
            doneWinCrt;
        end;

    janCodigo := getActiveWindow;
    janFoco := getFocus;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
    mensagem ('CCCARGAD', 1);    {'Código carregado'}
end;

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

function pegaLinha: string;
var linha: array [0..255] of char;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    putClipBoard ('');
    playInit (300);
    playVirtKey (VK_END, false, false, false, 1);
    playVirtKey (VK_HOME, false, true, false, 1);
    playVirtKey (VK_INSERT, true, false, false, 1);
    playStart;
    while  playIsActive do;

    getClipBoard (linha, 254);
    pegaLinha := strPas(linha);

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
end;

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

procedure avancaLinha;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playVirtKey (VK_DOWN, false, false, false, 1);
    playStart;
    while  playIsActive do;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
end;

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

procedure recuaLinha;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playVirtKey (VK_UP, false, false, false, 1);
    playStart;
    while  playIsActive do;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
end;

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

procedure substitui (var s: string; original, troca: string);
var p: integer;
begin
    s := ' ' + s;
    repeat
        p := pos (original, s);
        if p <> 0 then
            begin
                delete (s, p, length (original));
                insert (troca, s, p);
            end;
    until p = 0;
    delete (s, 1, 1);
end;

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

procedure fala (s: string);
var i: integer;
begin
    if s = '' then
        begin
            sintClek;
            exit;
        end;

    s := s + ' ';

    substitui (s, 'nº', ' número');
    substitui (s, 'Nº', ' número ');
    substitui (s, 'Art.', ' artigo ');
    substitui (s, 'Arts.', '(artigos ');
    substitui (s, 'art.', ' artigo ');
    substitui (s, 'arts.', '(artigos ');
    substitui (s, 'ART.', ' artigo ');

    substitui (s, ' I ',   ' primeiro ');
    substitui (s, ' II ',  ' segundo ');
    substitui (s, ' III ', ' terceiro ');
    substitui (s, ' IV ',  ' quarto ');
    substitui (s, ' V ',   ' quinto ');
    substitui (s, ' VI ',  ' sexto ');
    substitui (s, ' VII ', ' sétimo ');
    substitui (s, ' VIII ',' oitavo ');
    substitui (s, ' IX ',  ' nono ');
    substitui (s, ' X ',   ' décimo ');

    substitui (s, ' 1ª', ' primeira');   substitui (s, ' 1º', ' primeiro');
    substitui (s, ' 2ª', ' segunda');    substitui (s, ' 2º', ' segundo');
    substitui (s, ' 3ª', ' terceira');   substitui (s, ' 3º', ' terceiro');
    substitui (s, ' 4ª', ' quarta');     substitui (s, ' 4º', ' quarto');
    substitui (s, ' 5ª', ' quinta');     substitui (s, ' 5º', ' quinto');
    substitui (s, ' 6ª', ' sexta');      substitui (s, ' 6º', ' sexto');
    substitui (s, ' 7ª', ' sétima');     substitui (s, ' 7º', ' sétimo');
    substitui (s, ' 8ª', ' oitava');     substitui (s, ' 8º', ' oitavo');
    substitui (s, ' 9ª', ' nona');       substitui (s, ' 9º', ' nono');
    substitui (s, ' 10ª', ' décima');    substitui (s, ' 10º', ' décimo');

    substitui (s, ' - ', ', ');
    substitui (s, 'ª', ' a ');
    substitui (s, 'º', ' o ');

    sintFalaPont := false;

    if length (s) < 70 then sintetiza (s)
    else
        begin
            i := 60;
            while (i < length (s)) and (s [i] <> ' ') do
                i := i + 1;
            sintetiza (copy (s, 1, i));
            if i < length (s) then
                sintetiza (copy (s, i+1, length (s) - i));
        end;

    sintFalaPont := true;
end;

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

procedure leTexto;
var s: string;
    c: char;
label leu;
begin
    textBackground (RED);
    mensagem ('CCLETXT', 0);    {'Lendo texto com as setas'}
    textBackground (BLACK);
    repeat
        s := pegaLinha;
        writeln;
        write (s);
        fala (s);

        c := readkey;
        if c = #$0 then
            begin
                c := readkey;
            leu:
                case c of
                    BAIX:  avancaLinha;
                    CIMA:  recuaLinha;
                else
                    begin
                        c := sintEdita (s, 1, wherey, 79, false);
                        goto leu;
                    end;
                end;
            end;
        until c = #$1b;
    writeln;
end;

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

procedure leContinuo;
var s: string;
    c: char;
begin
    repeat
        s := pegaLinha;
        writeln;
        write (s);
        fala (s);
        while sintFalando do;
        if not keypressed then avancaLinha;
    until keypressed;
    writeln;
end;

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

procedure gravar;
var s: string;
    linha: array [0..255] of char;
    i, nTransf: integer;
    arq: text;
    nomeNovo: string;

label erro, fim;
begin
    mensagem ('CCARQDST', 0);   {'Qual o nome do arquivo destino ? '}
    sintReadln (nomeNovo);
    if nomeNovo = '' then
        if nomeArq = '' then
            goto erro
        else
            nomeNovo := nomeArq;

    nomeArq := nomeNovo;

    assign (arq, nomeArq);
    {$I-}  reset (arq);  {$I+}
    if ioresult = 0 then
         begin
             close (arq);
             {$I-}  append (arq);   {$I+}
             if ioresult <> 0 then goto erro;
             mensagem ('CCADIARQ', 1);  {'Adicionando a arquivo existente'}
         end
    else
         begin
             {$I-}  rewrite (arq);   {$I+}
             if ioresult <> 0 then goto erro;
         end;

    mensagem ('CCQUANT', 0);    {'Quantas linhas transfiro ? '}
    sintReadInt (nTransf);
    if nTransf = 0 then exit;

    setActiveWindow (janCodigo);
    setFocus (janFoco);

    for i := 1 to nTransf do
        begin
            putClipBoard ('');

            playInit (300);
            playVirtKey (VK_END, false, false, false, 1);
            playVirtKey (VK_HOME, false, true, false, 1);
            playVirtKey (VK_INSERT, true, false, false, 1);
            playVirtKey (VK_DOWN, false, false, false, 1);
            playStart;
            while playIsActive do;

            getClipBoard (linha, 254);
            s := strPas(linha);
            {$I-}  writeln (arq, s);  {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('CCERRDSK', 1);   {'Erro de escrita no arquivo'}
                    goto fim;
                end;
        end;

fim:
    s := '--------- Extraído do código civil brasileiro, edição CICBRAS ---------';
    {$I-}  writeln (arq, s);  {$I+}
    if ioresult <> 0 then;

    {$I-}  close (arq); {$I-}
    if ioresult <> 0 then
         mensagem ('CCERRFEC', 1);   {'Erro ao fechar o arquivo'}

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
    exit;

erro:
    mensagem ('CCARQINV', 1);   {'Arquivo inválido'}
    setActiveWindow (minhaJan);
    setFocus (minhaJan);
end;

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

function buscaEncontrados: integer;
var j: hwnd;
    classe, nome: array [0..255] of char;
    n: integer;
label achou;
begin
    buscaEncontrados := 0;

    j := getParent (getFocus);
    j := getWindow (j, GW_CHILD);

    s := '';
    while j <> 0 do
        begin
            getWindowText (j, nome, 255);
            s := strPas (nome);
            if copy (s, 1, 21) = 'Registros Encontrados' then
                goto achou;
            j := getWindow (j, GW_HWNDNEXT);
        end;
achou:
    n := 0;
    while (s <> '') and (not (s[1] in ['0'..'9'])) do
         delete (s, 1, 1);
    while (s <> '') and (s[1] in ['0'..'9']) do
         begin
             n := (n * 10) + (ord (s[1]) - ord ('0'));
             delete (s, 1, 1);
         end;

    buscaEncontrados := n;
end;

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

function pesquisaChave (n1, n2: integer; busca: string): integer;
var
    i, achados: integer;
begin
    pesquisaChave := -1;
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playAltKey ('L', 100);
    playVirtKey (VK_UP, false, false, false, 1);
    playKey (ENTER, 1);
    for i := 1 to n1 do
        playKey (TAB, 1);
    for i := 1 to length (busca) do
        begin
            playKey (busca[i], 1);
            if busca[i] = '"' then playKey (' ', 1);
        end;
    for i := 1 to n2 do
        playKey (TAB, 1);
    playStart;
    while  playIsActive do;
    delay (5000);

    achados := buscaEncontrados;

    playInit (300);
    if achados = 0 then
        playVirtKey (VK_RIGHT, false, false, false, 1);
    playKey (ENTER, 1);
    playStart;
    while  playIsActive do;

    delay (1000);

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
    pesquisaChave := achados;
end;

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

function pesqLivre: integer;
begin
    pesqLivre := -1;
end;

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

procedure pesquisa;
var c, c2: char;
    n1, n2: integer;
    busca: string;
begin
    textBackground (RED);
    mensagem ('CCOPPESQ', 0);    {'A-por artigo  L-leis complementares  T-textos livres'}
    textBackground (BLACK);
    sintleTecla (c, c2);
    writeln;

    achados := -1;
    case upcase(c) of
        'A':  begin
                  mensagem ('CCPESQA', 1);    {'Informe o número do artigo'}
                  n1 := 4;  n2 := 2;   { tabulações para posicionar no campo e no botao OK }
              end;
        'L':  begin
                  mensagem ('CCPESQL', 1);    {'Informe o número da lei'}
                  n1 := 13;  n2 := 7;
              end;
        'T':  begin
                  mensagem ('CCPESQT', 1);    {'Informe o texto, inclua aspas para grupos de palavras'}
                  n1 := 5;  n2 := 1;
              end;
    end;

    if upcase(c) in ['A', 'L', 'T'] then
        begin
            sintReadln (busca);
            if busca <> '' then
                achados := pesquisaChave (n1, n2, busca);
            end;

    if achados < 0 then
           mensagem ('CCDESIS', 1)    {'Desistiu'}
    else
        begin
            mensagem ('CCENCONT', 0);    {'Encontrados '}
            sintWriteInt (achados);
            writeln;
        end;
end;

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

procedure proximaPesq;
var s: string;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playVirtKey (VK_F3, false, false, false, 1);
    playStart;
    while  playIsActive do;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);

    s := pegaLinha;
    fala (s);
end;

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

procedure pesqAnterior;
var s: string;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playVirtKey (VK_F4, false, false, false, 1);
    playStart;
    while  playIsActive do;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);

    s := pegaLinha;
    fala (s);
end;

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

procedure fechaCodigo;
begin
    setActiveWindow (janCodigo);
    setFocus (janFoco);

    playInit (300);
    playVirtKey (VK_F4, false, false, true, 1);
    playStart;
    while  playIsActive do;

    setActiveWindow (minhaJan);
    setFocus (minhaJan);
end;

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

procedure finaliza;
var nomeProg: string;
begin
    while keypressed do readkey;
    mensagem ('CCCODFEC', 1);    {'Código fechado'}
    while sintFalando do;
    sintFim;

    if monitorAtivo then
        begin
            nomeProg := sintAmbiente ('DOSVOX', 'MONITOR');
            executaProg (nomeProg, '', '');
            setFocus (janOriginal);
        end;
end;

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

var
    c, c2: char;

begin
    inicializa;
    TrazCodigo;

    processando := true;
    repeat
        while keypressed do readkey;
        textBackGround (BLUE);
        mensagem ('CCOPCAO', 0);    {'Sua opção: '}
        textBackGround (BLACK);
        sintLeTecla (c, c2);
        writeln;
        case upcase(c) of
            'C': leContinuo;
            'L': leTexto;
            'G': gravar;
            'P': pesquisa;
            '+':  proximaPesq;
            '-':  pesqAnterior;
            ESC:  ;
        else
            mensagem ('CCAJUDOP', 1);
               {'Opções:  L-ler C-contínuo G-gravar P-pesquisa +próximo -anterior ESC fim'}
        end;
    until c = ESC;

    fechaCodigo;
    finaliza;
    sintFim;
    doneWinCrt;
end.



Informações necessárias

código
        'A':  begin
                  mensagem ('CCPESQA', 1);    {'Informe o número do artigo'}
                  n1 := 4;  n2 := 2;   { tabulações para posicionar no campo e no botao OK }
              end;
        'L':  begin
                  mensagem ('CCPESQL', 1);    {'Informe o número da lei'}
                  n1 := 13;  n2 := 7;
              end;
        'T':  begin
                  mensagem ('CCPESQT', 1);    {'Informe o texto, inclua aspas para grupos de palavras'}


jurisprudência
    relator
    assunto
    ementa
    pesquisa livre em todo texto
    acórdão (em alguns)

medidas provisórias
    número
    texto livre

pareceres
    emissor
    resumo assunto  (em alguns casos só assunto)
    ementa
    pesquisa livre em todo texto

senado federal
    número da: lei ordinária, lei complementar, decreto lei, medida provisória
    texto livre

vocabulário jurídico
    por verbete
    pesquisa livre

súmulas
     tribunal
     número da súmula
     pesquisa livre em todo texto
