Conjuntos (v. 1.0.4)

{ paulogp }
{ mac os 7 }
program Ada29p; { com erros na remoção de valores }

uses
    MemTypes, QuickDraw, OSIntf;

type
    TipoApontElementoLista = ^TipoElementoLista;
    TipoElementoLista = record
                    valor: real;
                    proximo: TipoApontElementoLista;
                end;

var
    i: integer;

procedure ListaNula(var Lista: TipoApontElementoLista);
begin
    Lista:= nil;
end;

procedure SubstituiValorLista3(var Lista: TipoApontElementoLista; substituido, substituto: real);
begin
    if Lista <> nil then
    begin
        if Lista^.valor = substituido then Lista^.valor:= substituto else
            SubstituiValorLista3(Lista^.proximo, substituido, substituto);
    end;
end;

function ExisteValorLista(Lista: TipoApontElementoLista; valor: real): boolean;
begin
    if Lista <> nil then
    begin
        if valor = Lista^.valor then ExisteValorLista:= true else
            ExisteValorLista:= ExisteValorLista(Lista^.proximo, valor);
    end
    else ExisteValorLista:= false;
end;

procedure InsereValorInicioLista(var Lista: TipoApontElementoLista; valornovo: real);
var
    ListaAux: TipoApontElementoLista;

begin
    new(ListaAux);
    ListaAux^.valor:= valornovo;
    ListaAux^.proximo:= Lista;
    Lista:= ListaAux;
end;

procedure InsereValorFimLista(var Lista: TipoApontElementoLista; valornovo: real);
begin
    if Lista = nil then
    begin
        new(Lista);
        Lista^.valor:= valornovo;
        Lista^.proximo:= nil;
    end else
        InsereValorFimLista(Lista^.proximo, valornovo);
end;

procedure InsereValorOrdenadoLista(var Lista: TipoApontElementoLista; valornovo: real);
var
    ListaAux: TipoApontElementoLista;
    aux: real;

begin
    if Lista = nil then
    begin
        new(Lista);
        Lista^.valor:= valornovo;
        ListaAux:= Lista;
        ListaAux:= ListaAux^.proximo;
        Lista^.proximo:= nil;
    end else
    begin
        ListaAux:= Lista;
        if valornovo < Lista^.valor then
        begin
            aux:= Lista^.valor;
            Lista^.valor:= valornovo;
            valornovo:= aux;
        end;
        InserevalorOrdenadoLista(Lista^.proximo, valornovo);
    end;
end;

procedure InsereValorOrdenadoLista2(var Lista: TipoApontElementoLista; valornovo: real);
var
    ListaAux: TipoApontElementoLista;

begin
    if Lista = nil then
    begin
        new(Lista);
        Lista^.valor:= valornovo;
        Lista^.proximo:= nil;
    end else
    begin
        if valornovo < Lista^.valor then
        begin
            new(ListaAux);
            ListaAux^.valor:= valornovo;
            ListaAux^.proximo:= Lista;
            Lista:= ListaAux;
        end else
            InsereValorOrdenadoLista2(Lista^.proximo, valornovo);
    end;
end;

procedure InsereValorOrdenadoLista3(var Lista: TipoApontElementoLista; valornovo: real);
var
    ListaAux, ListaAnt, ListaInd: TipoApontElementoLista;
    localizado: boolean;

begin
    ListaAnt:= nil;
    ListaAux:= Lista;
    localizado:= false;
    while not localizado and (ListaAux <> nil) do
        if ListaAux^.valor > valornovo then localizado:= true else
        begin
            ListaAnt:= ListaAux;
            ListaAux:= ListaAux^.proximo;
        end;
    new(ListaInd);
    ListaInd^.valor:= valornovo;
    ListaInd^.proximo:= ListaAux;
    if ListaAnt = nil then Lista:= ListaInd else ListaAnt^.proximo:= ListaInd;
end;

procedure ContaValorLista(Lista: TipoApontElementoLista; var contador: integer);
begin
    contador:= 0;
    while Lista <> nil do
    begin
        contador:= contador + 1;
        Lista:= Lista^.proximo;
    end;
end;

procedure ImprimeValorLista(Lista: TipoApontElementoLista);
begin
    while Lista <> nil do
    begin
        write(Lista^.valor: 2, ' ');
        Lista:= Lista^.proximo;
    end;
end;

procedure InverteListaValor(var Lista: TipoApontElementoLista);
var
    Q, R, S: TipoApontElementoLista;

begin
    Q:= nil;
    R:= Lista;
    while R <> nil do
    begin
        S:= R^.proximo;
        R^.proximo:= Q;
        Q:= R;
        R:= S;
    end;
    Lista:= Q;
end;

function RemovePrimeiroValorLista(var Lista: TipoApontElementoLista; var valorremovido: real): boolean;
begin
    if Lista = nil then RemovePrimeiroValorLista:= false else
    begin
        Lista:= Lista^.proximo;
        valorremovido:= Lista^.valor;
        dispose(Lista);
    end;
end;

function RemoveUltimoValorLista(var Lista: TipoApontElementoLista; var valorremovido: real): boolean;
begin
    Lista:= Lista^.proximo;
    if Lista = nil then RemoveUltimoValorLista:= false else
    begin
        Lista:= Lista^.proximo;
        valorremovido:= Lista^.valor;
        dispose(Lista);
    end;
end;

procedure RemoveValorLista(var Lista: TipoApontElementoLista; valorremovido: real);
var
    ListaAux: TipoApontElementoLista;

begin
    if Lista <> nil then
    begin
        if Lista^.valor = valorremovido then
        begin
            ListaAux:= Lista;
            Lista:= Lista^.proximo;
            if Lista <> nil then dispose(Lista) else
            begin
                Lista:= ListaAux;
                Lista:= nil;
            end;
        end;
        if Lista <> nil then RemoveValorLista(Lista^.proximo, valorremovido);
    end;
end;

function RemoveLista(var Lista: TipoApontElementoLista): boolean;
Var
    ListaAux: TipoApontElementoLista;

begin
    if Lista = nil then RemoveLista:= false else
    while Lista <> nil do
    begin
        ListaAux:= Lista;
        dispose(ListaAux);
        Lista:= Lista^.proximo;
    end;
end;

procedure ReuniaoListas(ListaA, ListaB: TipoApontElementoLista; var ListaC: TipoApontElementoLista);
begin
    while ListaA <> nil do
    begin
        InsereValorOrdenadoLista3(ListaC, ListaA^.valor);
        ListaA:= ListaA^.proximo;
    end;
    while ListaB <> nil do
    begin
        if not ExisteValorLista(ListaC, ListaB^.valor) then
            InsereValorOrdenadoLista3(ListaC, ListaB^.valor);
        ListaB:= ListaB^.proximo;
    end;
end;

procedure InterseccaoListas(ListaA, ListaB: TipoApontElementoLista; var ListaC: TipoApontElementoLista);
begin
    while (ListaA <> nil) and (ListaB <> nil) do
    begin
        if ExisteValorLista(ListaA, ListaB^.valor) then
            InsereValorOrdenadoLista3(ListaC, ListaB^.valor);
        ListaA:= ListaA^.proximo;
        ListaB:= ListaB^.proximo;
    end;
end;

procedure DiferencaListas(ListaA, ListaB: TipoApontElementoLista; var ListaC: TipoApontElementoLista);
begin
    while (ListaA <> nil) and (ListaB <> nil) do
    begin
        if not ExisteValorLista(ListaA, ListaB^.valor) then
            InsereValorOrdenadoLista3(ListaC, ListaB^.valor);
        ListaA:= ListaA^.proximo;
        ListaB:= ListaB^.proximo;
    end;
end;

{* design da página *}
{** coloca o título na janela **}
procedure Titulo(x: integer; nome: string);
begin
    clearscreen;
    i:= 0;
    gotoxy(x, 2);
    writeln(nome);
    gotoxy(x, 3);
    for i:= 1 to Length(nome) do write('~');
end;

{** desenha uma barra informativa **}
procedure Barra(nome: string);
begin
    gotoxy(2, 23);
    for i:= 1 to 78 do write('-');
    gotoxy(2, 24);
    writeln(nome);
end;

{** alinha os menus **}
procedure alinha(y: integer; nome: string);
begin
    gotoxy(30, y);
    write(nome);
end;

{** obtem a opção válida do utilizador **}
procedure opcao(x, y: integer; var tecla: string);
begin
    gotoxy(x, y);
    write('Opção: ');
    readln(tecla);
    uprstring(tecla, true);
end;

{** pausa **}
procedure Pausa;
begin
    Barra('Prima uma tecla para continuar');
    gotoxy(32, 24);
    readln;
end;

{* indicacao dos erros *}
procedure Erro(texto: string);
begin
    writeln;
    writeln('erro: ', texto);
    writeln;
end;

{* Lista com parenteses *}
procedure VerConjunto(Lista: TipoApontElementoLista);
begin
    writeln;
    write('{ ');
    ImprimeValorLista(Lista);
    write(' }');
    writeln;
end;

{* janela de Criar Conjunto *}
procedure CriarConjunto(var CriaLista: TipoApontElementoLista);
var
    n: integer;
    valor: real;

begin
    Titulo(34, 'Criar Conjunto');
    i:= 0;
    if RemoveLista(CriaLista) then writeln;
    writeln;
    writeln;
    repeat
        write('Número de valores a serem inseridos: ');
        readln(n);
    until n >= 0;
    if n > 0 then
    begin
        writeln;
        repeat
            write('v[', i + 1, ']: ');
            readln(valor);
            if not ExisteValorLista(CriaLista, valor) then
            begin
                InsereValorOrdenadoLista3(CriaLista, valor);
                i:= i + 1;
            end else
            Erro('valor repetido!');
        until i = n;
    end;
end;

{* janela ApagaConjunto *}
procedure ApagaConjunto(var ApagaLista: TipoApontElementoLista);
begin
    Titulo(33, 'Apagar Conjunto');
    writeln;
    writeln;
    writeln('Antes');
    VerConjunto(ApagaLista);
    writeln;
    if RemoveLista(ApagaLista) then writeln('Lista apagada');
    writeln;
    writeln('Depois');
    VerConjunto(ApagaLista);
    pausa;
end;

{* janela InsereValor *}
procedure InsereValor(var InsereLista: TipoApontElementoLista);
var
    verdade: boolean;
    valor: real;

begin
    Titulo(34, 'Inserir Valor');
    writeln;
    writeln('Antes');
    VerConjunto(InsereLista);
    Barra('');
    gotoxy(1, 8);
    verdade:= false;
    repeat
        write('Valor a inserir: ');
        readln(valor);
        if not ExisteValorLista(InsereLista, valor) then
        begin
            InsereValorOrdenadoLista3(InsereLista, valor);
            verdade:= true;
        end else
        Erro('valor repetido!');
    until verdade;
    writeln;
    writeln('Depois');
    VerConjunto(InsereLista);
    Pausa;
end;

{* janela RemoveValor *}
procedure RemoveValor(var RemoveLista: TipoApontElementoLista);
var
    contador: integer;
    valor: real;

begin
    Titulo(34, 'Remover Valor');
    Barra('');
    gotoxy(1, 4);
    writeln('Antes');
    VerConjunto(RemoveLista);
    writeln;
    ContaValorLista(RemoveLista, contador);
    if contador = 0 then Erro('lista vazia!') else
    begin
        writeln;
        write('Valor a remover: ');
        readln(valor);
        if ExisteValorLista(RemoveLista, valor) then
        RemoveValorLista(RemoveLista, valor) else
        Erro('não existe valor!');
    end;
    writeln;
    writeln('Depois');
    VerConjunto(RemoveLista);
    Pausa;
end;

{* janela VerConjunto *}
Procedure VisualizarConjunto(VerLista: TipoApontElementoLista);
begin
    Titulo(30, 'Visualizar Conjunto');
    writeln;
    VerConjunto(VerLista);
    pausa;
end;

{* facilidade no trabalho de listas *}
procedure TrabalharLista(Nome: Char; var Lista: TipoApontElementoLista);
var
    tecla: string;
    escolha: char;
    valor: real;
    n, contador: integer;
    verdade: boolean;
    LAux: TipoApontElementoLista;

begin
    repeat
        Titulo(36, 'CONJUNTO ' + Nome);
        Barra('S - Menu Principal');
        Alinha(6, 'A - Criar Lista');
        Alinha(7, 'B - Apagar Lista');
        Alinha(9, 'C - Inserir Valor');
        Alinha(10, 'D - Remover Valor');
        Alinha(12, 'E - Visualizar');
        gotoxy(52, 24);
        ContaValorLista(Lista, contador);
        write('conjunto ',Nome,': ',contador,' elemento(s)');
        Opcao(30, 20, tecla);
        escolha:= tecla[1];
        case escolha of
            'A': CriarConjunto(Lista);
            'B': ApagaConjunto(Lista);
            'C': InsereValor(Lista);
            'D': RemoveValor(Lista);
            'E': VisualizarConjunto(Lista);
        end;
    until escolha = 'S';
end;

{* conjuntos *}
procedure ConjuntoReuniao(ListaA, ListaB: TipoApontElementoLista);
var
    Reuniao: TipoApontElementoLista;

begin
    ListaNula(Reuniao);
    Titulo(33, 'Conjunto Reunião');
    writeln;
    writeln;
    ReuniaoListas(ListaA, ListaB, Reuniao);
    VerConjunto(Reuniao);
    if RemoveLista(Reuniao) then writeln;
    Pausa;
end;

procedure ConjuntoInterseccao(ListaA, ListaB: TipoApontElementoLista);
var
    Interseccao: TipoApontElementoLista;

begin
    ListaNula(Interseccao);
    Titulo(31, 'Conjunto Intersecção');
    writeln;
    writeln;
    InterseccaoListas(ListaA, ListaB, Interseccao);
    VerConjunto(Interseccao);
    if RemoveLista(Interseccao) then writeln;
    Pausa;
end;

procedure ConjuntoDiferenca(ListaA, ListaB: TipoApontElementoLista);
var
    Diferenca: TipoApontElementoLista;

begin
    ListaNula(Diferenca);
    Titulo(31, 'Conjunto Diferença');
    writeln;
    writeln;
    DiferencaListas(ListaA, ListaB, Diferenca);
    VerConjunto(Diferenca);
    if RemoveLista(Diferenca) then writeln;
    Pausa;
end;

{* corpo principal *}
var
    ListaA, ListaB: TipoApontElementoLista;
    tecla: string;
    escolha: char;

begin
    ListaNula(ListaA);
    ListaNula(ListaB);

    repeat
        Titulo(34, 'Menu Principal');
        Alinha(6, 'Editor de conjuntos');
        Alinha(8, ' A - Conjunto A');
        Alinha(9, ' B - Conjunto B');
        Alinha(12, 'Operações com conjuntos');
        Alinha(14, ' C - Conjunto reunião');
        Alinha(15, ' D - Conjunto intercecção');
        Alinha(16, ' E - Conjunto diferença');
        Barra('"S" - Saír');
        repeat
            Opcao(30, 20, tecla);
            escolha:= tecla[1];
        until (escolha >= 'A') and (escolha <= 'E') or (escolha = 'S');
        case escolha of
            'A': TrabalharLista('A', ListaA);
            'B': TrabalharLista('B', ListaB);
            'C': ConjuntoReuniao(ListaA, ListaB);
            'D': ConjuntoInterseccao(ListaA, ListaB);
            'E': ConjuntoDiferenca(ListaA, ListaB);
        end;
    until tecla = 'S';
    if RemoveLista(ListaA) then writeln('Ok');
    if RemoveLista(ListaB) then writeln('Ok');
end.