Conjuntos (v. 1.0.3)

{* paulogp *}
{* mac os 7 *}
program Ada26p; {** versão número 2b **}

uses
    MemTypes, QuickDraw, OSIntf;

type
    Conjunto = ^Termo;
    Termo = record
                valor: real;
                proxi, antri: CONJUNTO;
            end;

const
    N_MENUS = ['A'..'I'];
    S_MENUS = ['A','B','S'];
    M_MENU = 'S - Menu Principal';

var
    def, ref: Conjunto;
    opcao, menu: char;

{* Design do programa *}

{** colocação de um título no cabeçalho da página **}
procedure titulo(x: integer; nome: string);
var
    i: integer;

begin
    clrscr;
    gotoxy(x, 2);
    writeln(nome);
    gotoxy(x, 3);
    for i:= 1 to length(nome) do
        write('~');
end;

{** alinhamento do menu **}
procedure alinha(y: integer; funcao: String);
begin
    gotoxy(23, y);
    writeLn(Funcao);
end;

{** facilidade de escrita **}
procedure conj(nome: char);
begin
    writeln('Conjunto ',nome);
    writeln('~~~~~~~~~~');
    writeln;
end;

{** colocação de uma barra e informação no rodapé da página **}
procedure barra_Inferior(mensagem: string);
var
    i: integer;

begin
    gotoxy(2, 22);
    for i:= 1 to 70 do write('~');
    gotoxy(2, 23);
    write(mensagem);
end;

{** mantém a informação visível até ser premida uma tecla **}
procedure pausa;
begin
    barra_Inferior('          Prima uma tecla para voltar ao menu principal!');
    readkey;
end;

{* Fim do design do programa *}

{* Informações sobre o autor *}

procedure Autor;
begin
    Titulo(30, 'ACERCA DO AUTOR');
    writeln;
    writeln(' ':17, 'Analise e Desenvolvimento de Algoritmos');
    writeln(' ':18, 'professor ####');
    writeln;
    writeln;
    writeln(' ':23, 'Paulo G.P.');
    writeln;
    writeln(' ':23, 'Nuno Miguel Batista Brites');
    writeln;
    Pausa;
end;
{* Fim das informacoes sobre o autor *}

{* Operações com Conjuntos *}

{** inserção de um elemento no conjunto **}
procedure junta(a: real; ne: integer; var ref: Conjunto; var ns: integer);
begin
    if ref = nil then
    begin
        new(ref);
        With ref^ do
        begin
            valor:= a;
            antri:= nil;
            proxi:= nil;
            ns:= ne + 1;
        end;
    end else
    with ref^ do
    begin
        if a < valor then junta(a, ne, antri, ns) else
            if a > valor then junta(a, ne, proxi, ns) else
            begin
                write('ERRO! Duplicação de dados!');
                writeln;
            end;
    end;
end;

{** definicao dos elementos de um conjunto **}
procedure definir(var ref: Conjunto);
var
    n, ne, ns: integer;
    a: real;

begin
    Write(' Número de elementos: ');
    readLn(n);
    ref:= nil;
    if n > 0 then
    begin
        ne:= 1;
        repeat
            writeln;
            write('v[', ne:2, ']: ');
            readln(a);
            junta(a, ne, ref, ne);
        until ne = n + 1;
    end;
end;

{** visualização dos elementos de um conjunto **}
procedure mostrar(ref: Conjunto; linha: integer);
begin
    if ref <> nil then
    with ref^ do
    begin
        mostrar(antri, linha + 1);
        write(valor:2:2, ' ');

        if (linha mod 9) = 0 then
        begin
            writeln;
            write('   ');
        end;
        mostrar(proxi, linha + 1);
    end;
end;

{** contador de elementos de um conjunto **}
procedure contador(ref: Conjunto; var n: integer);
var
    aux: Conjunto;

begin
    n:= 0;
    aux:= ref;
    while aux <> nil do
    begin
        aux:= aux^.antri;
        n:= n + 1;
    end;

    while ref <> nil do
    begin
        ref:= ref^.proxi;
        n:= n + 1;
    end;
end;

{** eliminação dos elementos de um conjunto **}
procedure apagar(var ref: Conjunto);
var
    refaux, refapa : Conjunto;
    N: integer;

begin
    n:= 0;
    refaux:= ref;
    while refaux <> nil do
    begin
        refapa:= refaux;
        refaux:= refaux^.proxi;
        n:= n + 1;
        dispose(refapa);
    end;
    ref:= refaux;
end;

{* Fim das operações com conjuntos *}

procedure teste(ref: Conjunto);
var
    c1: Conjunto;

begin
    mostrar(ref, 1);
    writeln;
    writeln;
    c1:= ref;
    while ref <> nil do
    begin
        ref^.antri:= ref;
        write(ref^.valor:2:2, 'ª ');
        ref:= ref^.proxi;
    end;
    writeln;
    ref:= c1;
    while ref <> nil do
    begin
        write(ref^.valor:2:2, 'ª ');
        ref:= ref^.antri;
    end;
end;

{** facilidade de escrita -> estrutura de um sub-menu **}
procedure submenu(ref: Conjunto; nome: char; y: integer);
var
    straux: string;
    n: integer;

begin
    contador(ref, n);
    gotoxy(23, y);
    if n = 0 then writeln(nome,' - Conjunto ',nome,':  ', nome,' = { }.') else
        if n = 1 then writeln(nome,' - Conjunto ',nome,': 1  elemento.') else
            writeln(nome,' - Conjunto ',nome,':', n:3,' elementos.');
end;

{* Corpo principal do programa *}

begin
    repeat
    Titulo(23, 'PROGRAMA DE LISTAS VARIAVEIS');
    Alinha(05, 'A - Definir conjuntos');
    Alinha(06, 'B - Visualizar conjuntos');
    Alinha(07, 'C - Eliminar conjunto');
    Alinha(09, 'D - Adicionar elemento');
    Alinha(10, 'E - Retirar elemento');
    Alinha(12, 'F - Uniao de conjuntos');
    Alinha(13, 'G - Interseccao de conjuntos');
    Alinha(14, 'H - Diferenca de conjuntos');
    Alinha(16, 'I - Acerca do autor');
    Barra_Inferior('S - Sair');
    gotoxy(23, 19);
    write('Opcao: ');

    repeat
        opcao:= readKey;
        opcao:= upcase(opcao);
    until (opcao in N_MENUS) or (opcao = 'S');

    case opcao of
        'A': repeat
                titulo(25, 'DEFINIÇÃO DE CONJUNTOS');
                alinha(6, '  Conjunto a ser definido');

                submenu(ref, 'A', 9);
                submenu(def, 'B', 11);

                Barra_Inferior(M_MENU);

                gotoxy(25, 14);
                write('Opção: ');

                repeat
                    menu:= readkey;
                    menu:= upcase(menu);
                until menu in S_MENUS;

                case menu of
                    'A': begin
                            titulo(24, 'DEFINIÇÃO DO CONJUNTO A');
                            writeln;
                            writeln;
                            definir(ref);
                        end;

                    'B': begin
                            titulo(24, 'DEFINIÇÃO DO CONJUNTO B');
                            writeln;
                            writeln;
                            definir(def);
                        end;
                end;
            until menu = 'S';

        'B': begin
                titulo(23, 'VISUALIZAÇÃO DE CONJUNTOS');
                writeln;

                writeln;
                conj('A');
                mostrar(ref, 2);
                writeln;
                writeln;

                writeln;
                conj('B');
                mostrar(def, 2);
                pausa;
            end;

        'C': repeat
                titulo(25, 'ELIMINAÇÃO DE CONJUNTOS');
                alinha(6, '  Conjunto a ser eliminado');

                submenu(ref, 'A', 9);
                submenu(def, 'B', 11);

                Barra_Inferior(M_MENU);

                gotoxy(25, 14);
                write('Opção: ');
                repeat
                    menu:= readkey;
                    menu:= upcase(menu);
                until menu in S_MENUS;

                case menu of
                    'A': apagar(ref);
                    'B': apagar(def);
                end;
            until menu = 'S';

        'I': autor;

        'H': begin
                titulo(25,'ZONA DE TESTES');
                writeln;
                writeln;
                teste(ref);
                pausa;
            end;
        end;
    until opcao = 'S';
    apagar(ref);
    apagar(def);
    donewincrt;
End.