Conjuntos (v. 1.0.2)

{* paulogp *}
{* mac os 7 *}
program Ada25p; { programa incompleto }

uses
    MemTypes, QuickDraw, OSIntf;

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

var
    def, ref: Conjunto;
    opcao, menu: char;
    i, n: integer;

{* Design do programa *}

{** colocação de um título no cabeçalho da página **}
procedure titulo(x: integer; nome: string);
begin
    clearscreen;
    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);
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!');
    readln;
end;

{* Fim do design do programa *}

{* Informações sobre o autor *}

procedure Autor;
begin
    titulo(30, 'ACERCA DO AUTOR');
    writeln;
    writeln(' ':23, 'Paulo G.P.');
    writeln;
    writeln(' ':23, 'Nuno Miguel Batista Brites');
    writeln;
    Pausa;
end;
{* Fim das informações sobre o autor *}

{* Operações com Conjuntos *}

{** verificação da existÍncia de um elemento no conjunto **}
function pertence(a: real; ref: Conjunto): boolean;
begin
    if ref <> nil then
    begin
        if a = ref^.valor then pertence:= false else
        begin
            ref:= ref^.proxi;
            pertence:= pertence(a, ref)
        end;
    end
    else pertence:= true;
end;

{** colocação de elementos dentro de um conjunto **}
function loca(a: real; ref: Conjunto): boolean;
begin
    if ref <> nil then
    begin
        if a > ref^.valor then loca:= false else
        begin
            ref:= ref^.proxi;
            loca:= loca(a, ref)
        end;
    end;
end;

procedure junta222(a: real; ne: integer; var ref: Conjunto; var ns: integer);
var
    aux, ref2: Conjunto;

begin
    if pertence(a, ref) then
    begin
        if loca(a, ref) then
        begin
            new(aux);
            aux^.valor:= a;
            aux^.proxi:= ref;
            ref:= aux;
        end;
        ns:= ne + 1;
    end;
end;

procedure junta(a: real; ne: integer; var ref: Conjunto; var ns: integer);
var
    aux: Conjunto;

begin
    if pertence(a, ref) then
    begin
        new(aux);
        aux^.valor:= a;
        aux^.proxi:= ref;
        ref:= aux;
        ns:= ne + 1;
    end;
end;

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

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

{** visualização dos elementos de um conjunto **}
procedure mostrar(ref: Conjunto);
var
    linha: integer;

begin
    linha:= 0;
    write(' { ');
    while ref <> nil do
    begin
        linha:= linha + 1;

        write(ref^.valor:2:2);
        ref:= ref^.proxi;

        if (linha > 0) and (ref <> nil) then write(', ');

        if (linha mod 9) = 0 then
        begin
            writeln;
            write('   ');
        end;
    end;
    write(' }');
end;

{** contador de elementos de um conjunto **}
procedure contador(ref: Conjunto; var n: integer);
begin
    n:= 0;
    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 *}

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

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 *}
var
    escolha: string;

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 - Uni„o de conjuntos');
        alinha(13, 'G - Intersecção de conjuntos');
        alinha(14, 'H - Diferença de conjuntos');
        alinha(16, 'I - Acerca do autor');
        Barra_Inferior('S - Saír');
        gotoxy(23, 19);
        write('Opção: ');

        repeat
            readln(escolha);
            uprstring(escolha, true);
            opcao:= escolha[1];
        until (opcao >= 'A') and (opcao <= 'I') or (opcao = 'S');

        case opcao of
            'A': repeat
                    titulo(25, 'DEFINICÅ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
                        readln(escolha);
                        uprstring(escolha, true);
                        menu:= escolha[1];
                    until (menu = 'A') or (menu = 'B') or (menu = 'S');

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

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

            'B': begin
                    titulo(23, 'VISUALIZACÅO DE CONJUNTOS');
                    writeln;

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

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

            'C': repeat
                    titulo(25, 'ELIMINACÅ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
                        readln(escolha);
                        uprstring(escolha, true);
                        menu:= escolha[1];
                    until (menu = 'A') or (menu = 'B') or (menu = 'S');

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

            'I': autor;
        end;
    until opcao = 'S';
End.