{---------------------------------------------------------------------}
{    Projeto DOSVOX - NCE/UFRJ
{    Interface sonora para o Recognita
{    Autor: José Antonio Borges
{    Em 26/04/99
{---------------------------------------------------------------------}

{$M 16536,8192}
program ocrvox;

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

const
    versao = '1.0';
var
    s: string;
    titulo: array [0..80] of char;
    tx: array [0..100] of char;
    janOriginal, minhaJan, janOCR, janFoco: hWnd;
    processando: boolean;
    monitorAtivo: boolean;
    nomeArq: string;
    nscan: integer;
    versaoOcr: char;
    delayVersao: integer;

const
    msgTitulo = 'Interface sonora para OCR';

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

procedure mensagem (nomeArq: string; nlf: integer);
var i: integer;
    s: string;
begin
    if nomeArq = 'OCINIC' then
        s := 'Programa OCR VOX - v '
    else
    if nomeArq = 'OCQUALOC' then
        s := 'Qual a versão do recognita (1 ou 3) ? '
    else
    if nomeArq = 'OCCARGA' then
        s := 'Carregando programa na memória'
    else
    if nomeArq = 'OCNAOENC' then
        s := 'Programa não foi encontrado'
    else
    if nomeArq = 'OCPROCAN' then
        s := 'Programa cancelado'
    else
    if nomeArq = 'OCPRONTO' then
        s := 'Pronto para escanear'
    else
    if nomeArq = 'OCPAPVER' then
        s := 'Usa papel na posição normal ? '
    else
    if nomeArq = 'OCERRSCN' then
        s := 'Erro no scanner'
    else
    if nomeArq = 'OCMAISPG' then
        s := 'Mais paginas ? '
    else
    if nomeArq = 'OCNOMARQ' then
        s := 'Nome do arquivo a guardar'
    else
    if nomeArq = 'OCSAISEM' then
        s := 'Posso sair sem gravar ? '
    else
    if nomeArq = 'OCERRGRV' then
        s := 'Não consegui guardar o arquivo'
    else
    if nomeArq = 'OCOCRFEC' then
        s := 'Programa terminado'
    else
    if nomeArq = 'OCPAGSCN' then
        s := 'Páginas escaneadas: '

    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;
    dirOCR: string;
begin
    janOriginal := getFocus;
    screenSize.y := 5;
    clrscr;
    minhaJan := getFocus;
    cancelaMonitor;
    delay (1000);

    dirOCR := sintAmbiente ('OCRVOX', 'DIROCRVOX');
    sintInic (0, dirOCR);

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

    textBackGround (BLUE);
    mensagem ('OCINIC', 0);    {'Programa OCRVOX'}
    writeln (versao);
    textBackGround (BLACK);

    nomeArq := '';
end;

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

procedure selectDriver32;
var x, y, i: integer;
begin
    x := getSystemMetrics (SM_CXSCREEN);
    y := getSystemMetrics (SM_CYSCREEN);
    mouseClick (x div 2, y div 2);
    delay (100);

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

    delay (1000);
    keyboardClick (TAB);
    delay (100);
    keyboardClick (ENTER);

    for i := 1 to delayVersao do
        begin
            sintClek;
            delay (1000);
        end;
end;

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

procedure iniciaProgOCR;
var drive: array [0..144] of char;
    cancelou: boolean;
    nomeOCR, s: string;
    i: integer;

label ok;

begin
    mensagem ('OCQUALOC', 0);   {'Qual a versão do recognita (1 ou 3) ? '}
    versaoOcr := readKey;
    if not (versaoOcr in ['1','3']) then versaoOcr := '3';
    sintSoletra (versaoOcr);
    writeln (versaoOcr);

    mensagem ('OCCARGA', 1);    {'Carregando OCR na memória'}
    while sintFalando do;

    if versaoOcr = '1' then
         begin
             nomeOCR := sintAmbiente ('OCRVOX', 'OCR125');
             if nomeOCR = '' then nomeOCR := 'c:\recogn\wrecogn.exe';
             s := sintAmbiente ('OCRVOX', 'DELAY125');
             if s = '' then
                 delayVersao := 1
             else
                 val (s, delayVersao, i);
         end
    else
         begin
             nomeOCR := sintAmbiente ('OCRVOX', 'OCR30');
             if nomeOCR = '' then nomeOCR := 'c:\recogn30\recogn.exe';
             s := sintAmbiente ('OCRVOX', 'DELAY30');
             if s = '' then
                 delayVersao := 1
             else
                 val (s, delayVersao, i);
         end;

    cancelou := false;
    if executaProg (nomeOCR, '.', '') <= 32 then
        begin
            mensagem ('OCNAOENC', 1);  {'Programa não foi encontrado'}
            cancelou := true;
        end;

    repeat
        delay (1000);
        getWindowText (getActiveWindow, titulo, 80);
        s := strpas (titulo);
        if s = 'Select Source' then  selectDriver32;

        if keypressed then
            if readkey = #$1b then
                cancelou := true;
    until (pos ('Recognita', s) <> 0) or cancelou;

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

    janOCR := getActiveWindow;
    janFoco := getFocus;
    writeln (titulo);

    for i := 1 to delayVersao do
        begin
            sintClek;
            delay (1000);

            getWindowText (getActiveWindow, titulo, 80);
            s := strpas (titulo);
            if s = 'Select Source' then
                begin
                    selectDriver32;
                    goto ok;
                end;
        end;
ok:
    setActiveWindow (minhaJan);
    setFocus (minhaJan);
    mensagem ('OCPRONTO', 1);    {'Pronto para escanear'}
    while sintFalando do;
    delay (1000);
end;

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

procedure configura;
var vertical: boolean;
    c: char;
begin
    while keypressed do readkey;
    mensagem ('OCPAPVER', 0);   {'Usa papel na vertical ? '}
    c := sintReadkey;
    writeln (c);
    vertical := upcase(c) <> 'N';

    setActiveWindow (janOCR);
    setFocus (janFoco);

    if versaoOcr = '1' then
        begin
            playInit (300);
            playAltKey ('O', 1);    {defaults}
            playKey ('T', 1);
            playAltKey ('D', 1);    {defaults}

            playAltKey ('T', 1);    {vertical}
            if not vertical then
                playVirtKey (VK_DOWN, false, false, false, 1);

            playAltKey ('U', 1);    {múltiplas paginas}
            playVirtKey (VK_DOWN, false, false, false, 1);

            playKey (TAB, 1);
            playKey (ENTER, 1);
            playStart;
            while  playIsActive do;
        end
    else
        begin
            playInit (300);
            playAltKey ('O', 1);
            playKey ('O', 1);
            playAltKey ('P', 1);
            playAltKey ('U', 1);
            playAltKey ('A', 1);
            if vertical then
                playAltKey ('E', 1)
            else
                playAltKey ('M', 1);
            playKey (ENTER, 1);
            playStart;
            while  playIsActive do;
        end;

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

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

procedure escaneia;
var c: char;
    f: hWnd;
    timeOut: word;
    strFimScan: string;
begin
    nscan := 0;
    setActiveWindow (janOCR);

    playInit (300);
    if versaoOcr = '1'then
        playVirtKey (VK_F6, false, false, false, 1)
    else
        playVirtKey (VK_F9, false, false, false, 1);
    playStart;
    while  playIsActive do;

    delay (5000);
    f := getActiveWindow;
    getWindowText (f, tx, 100);
    if strPas (tx) = 'Select Source' then
        selectDriver32;

    repeat
        nscan := nscan + 1;
        timeOut := 0;
        repeat
            delay (500);
            timeOut := timeOut + 500;

            f := getFocus;
            getWindowText (f, tx, 100);
            if strPas (tx) = 'OK' then
                begin
                    mensagem ('OCERRSCN', 1);   {'Erro no scanner'}
                    playInit (300);
                    playKey (ENTER, 1);
                    playStart;
                    while  playIsActive do;
                    timeOut := 60001;
               end;

        until (strPas(tx) = '&Próxima Página') or
              (strPas(tx) = '&Yes') or
              (strPas(tx) = '&Sim') or
        (timeOut > 60000);

        delay (2000);
        f := getfocus;

        setActiveWindow (minhaJan);
        while keypressed do readkey;
        mensagem ('OCMAISPG', 0);   {'Mais paginas ? '}
        c := sintReadkey;
        writeln (c);

        setFocus (f);

        playInit (300);
        if c = ESC then c := 'N';
        if upcase (c) = 'N' then
            playKey (TAB, 1);
        playKey (ENTER, 1);
        playStart;
        while  playIsActive do;

    until upcase (c) = 'N';
    setFocus (minhaJan);
end;

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

procedure guardaArquivo;
var j, jcampo: hwnd;
    c: char;
    i: integer;
    gravou: boolean;
    timeOut: integer;
    strFimScan: string;
    arq: file;
begin
   repeat
       while keypressed do readkey;
       mensagem ('OCNOMARQ', 1);   {'Nome do arquivo a guardar'}
       sintReadln (nomeArq);
       if nomeArq = '' then
           begin
               mensagem ('OCSAISEM', 0); {Posso sair sem gravar ? '}
               c := sintReadkey;
               writeln (c);
               if upcase (c) = 'S' then exit;
               if upcase (c) = ESC then exit;
           end;

       setActiveWindow (janOCR);
       if versaoOcr = '1'then
           begin
               playInit (300);
               playAltKey ('F', 1);
               playKey ('C', 1);
               playString (nomeArq, 50);
               playKey (ENTER, 1000);
               playStart;
               while  playIsActive do;
           end
       else
           begin
               setActiveWindow (janOCR);
               playInit (300);
               playAltKey ('F', 1);
               playKey ('T', 1000);
               playString (nomeArq, 50);
               playKey (ENTER, 1);
               playStart;
               while  playIsActive do;

               delay (1000);
               playInit (300);
               playKey (ENTER, 1000);
               playStart;
               while  playIsActive do;
           end;

       if versaoOcr = '1'then
           strFimScan := 'Salva Ficheiro Como'
       else
           strFimScan := 'Salva Texto Como';

       timeOut := 0;
       jcampo := getFocus;
       repeat
           delay (500);
           j := getActiveWindow;    { testa se nao gravou }
           getWindowText (j, tx, 100);
           timeOut := timeOut + 500;
       until (strPas(tx) <> 'Salva Ficheiro Como') or (timeOut > 6000);

       setFocus (jcampo);
       if timeOut > 6000 then
           begin
               playInit (300);
               for i := 1 to 5 do
                    playKey (TAB, 1);
               playKey (ENTER, 1);
               playStart;
               while  playIsActive do;
               setFocus (minhaJan);
               mensagem ('OCERRGRV', 1);    {'Não consegui guardar o arquivo'}
           end
       else
           if (versaoOcr = '3') and (copy (nomearq, length(nomearq)-4, 4) <> '.') then
                   begin
                       assign (arq, nomearq);
                       {$I-} erase (arq); {$I+}    { Apaga arquivo de imagem }
                       if ioresult <> 0 then;
                   end;

    until not (timeOut > 6000);
end;

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

procedure finaliza;
var nomeProg: string;
begin
    while keypressed do readkey;

    setActiveWindow (janOCR);

    if versaoOcr = '1'then
        begin
            playInit (300);
            playAltKey ('F', 1);   {fecha página}
            playKey ('N', 1);
            playKey ('N', 1);
            playVirtKey (VK_F4, false, false, true, 1);
            playStart;
            while playIsActive do;
        end
    else
        begin
            playInit (300);
            playAltKey ('F', 1);   {fecha página}
            playKey ('S', 1);
            playKey ('N', 1);
            playStart;
            while  playIsActive do;
        end;

    setActiveWindow (minhaJan);
    repeat keypressed until getActiveWindow = minhaJan;

    delay (1000);
    sintBip;
    mensagem ('OCPAGSCN', 0);    {'Páginas escaneadas: '}
    sintWriteInt (nscan);
    writeln;

    mensagem ('OCOCRFEC', 1);    {'Programa terminado'}
    while sintFalando do;
    sintFim;

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

    setFocus (janOriginal);
    doneWinCrt;
end;

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

var c: char;
begin
    inicializa;
    iniciaProgOCR;
    configura;
    escaneia;
    guardaArquivo;
    finaliza;
end.
