{--------------------------------------------------------}
{
{   Sistema genérico de telemarketing
{
{   Autor:  Jose' Antonio Borges
{
{   Em Outubro de 1999
{
{--------------------------------------------------------}

{$M 32767,8192}
Program Telemark;

Uses
    dvcrt, dvwin, tmVars, tmMsg,
    tmArquiv, tmEdita, tmFolhe, tmProcura, tmSelec,
    tmImprim, tmTransf, tmConta, tmExport;

{--------------------------------------------------------}
{                    ajuda principal
{--------------------------------------------------------}

Procedure ajuda;
Var i: byte;
    s: string [2];
begin
    textColor (YELLOW);
    For i := 1 to 11 do
       begin
           str (i, s);
           mensagem ('TMAJU' + s, 1);
       end;
    textColor (LIGHTGRAY);

    while keypressed do readkey;
end;

{--------------------------------------------------------}
{                       inicializacao
{--------------------------------------------------------}

function Inicializa: boolean;
var c, c2: char;
    dir: string;
label erro;
begin
    inicializa := false;

    dirProg := sintAmbiente ('TELEMARK', 'DIRPROG');
    if dirProg = '' then
        getDir (0, dirProg);
    if dirProg [length(dirProg)] <> '\' then
        dirProg := dirProg + '\';

    dir := sintAmbiente('TELEMARK', 'DIRTELEMARK');
    SintInic (0, dir);

    telaInicial;
    if existeArqSom ('TMINIC') then
        sintSom ('TMINIC')    {'mensagem inicial do programa'}
    else
        sintetiza ('Sistema de telemarketing');

    nomeArqModelo := sintAmbiente('TELEMARK', 'ARQMODELO');
    if nomeArqModelo = '' then
        nomeArqModelo := dirProg + 'cadastro.mdl';

    nomeArqCombo := sintAmbiente('TELEMARK', 'ARQOPCOES');
    if nomeArqCombo = '' then
        nomeArqCombo := dirProg + 'opcoes.mdl';

    if paramCount <> 0 then
        begin
            dirCadastro := paramStr(1);
            writeln (dirCadastro);
        end
    else
        begin
            textBackGround (BLUE);
            mensagem ('TMQUEDIR', 1);   {Informe o diretório de telemarketing'}
            textBackGround (BLACK);
            sintReadln (dirCadastro);
        end;

    if dirCadastro = '' then
        begin
            getDir (0, dirCadastro);
            mensagem ('TMASSUME', 0);   {'Assumido '}
            sintWriteln (dirCadastro);
        end;

    {$I-}  chdir (dirCadastro);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('TMCNFCRI', 0);   {'Confirma criação do diretorio ? '}
            sintLeTecla (c, c2);
            writeln;
            if upcase(c) <> 'S' then goto erro;

            {$I-}  mkdir (dirCadastro);  {$I+}
            if ioresult <> 0 then
                begin
erro:
                    mensagem ('TMNAOCRI', 1);  {'Não consegui criar o diretório'}
                    exit;
                end;

            chdir (dirCadastro);
        end;

    new (pessoas);

    if not leCategorias then exit;

    criaFicha (fichaAtual);

    cadastrados := 0;
    posAtual := 1;
    posFolheia := 1;
    nomeBusc := '';
    serial := 0;

    inicializa := true;
end;

{--------------------------------------------------------}
{                 finaliza programa
{--------------------------------------------------------}

function finaliza: boolean;
var c, c2: char;
begin
   textBackground (RED);
   mensagem ('TMCNFFIM', 0);    {'Confirma fim ? '}
   textBackground (BLACK);

   sintLeTecla (c, c2);
   writeln;
   if upcase(c) = 'S' then
       begin
           telaInicial;
           mensagem ('TMFIM', -1);   {'É bom trabalhar com você'}
       end;

   finaliza := upcase(c) = 'S';
end;

{--------------------------------------------------------}
{                 programa principal
{--------------------------------------------------------}

var c, c2: char;
    pheap: pointer;
    i: integer;
    processando: boolean;

begin
    clrscr;
    if not inicializa then
        begin
            sintFim;
            readkey;
            doneWinCrt;
        end;

    leCadastro;

    processando := true;

    Repeat
        writeln;
        textBackGround (BLUE);
        mensagem ('TMQUALOP', 0);    {'Qual opção ? '}
        textBackGround (BLACK);
        clreol;

        sintLeTecla (c, c2);
        writeln;

        if (c = #0) then
           case c2 of
               F1: ajuda;
           end
        else
            case upcase(c) of
                'N': inclui;
                'F': folheia;
                'P': procura;
                'S': seleciona;
                'I': imprime;
                'T': transfere;
                'C': contadores;
                'E': exporta;
                'R': importa;
                ' ': telaInicial;
                #27: processando := not finaliza;
            else
                mensagem ('TVERROP', 2); {'Opcao errada: aperte F1 para ajuda'}
        end;

    until not processando;
    delay (2000);
    doneWinCRT;
end.
