program dicionario;
type
    TponteiroDic = ^dic;

dic = record
    verbete: string;
    prox: Tponteirodic;
end;

Tponteiro = ^no;
no = record
    palavra: string;
    dic: TponteiroDic;
    prox: Tponteiro;
    ant: Tponteiro;
end;

Tlista = record
    inicio: Tponteiro;
    fim: Tponteiro;
end;

var lista: Tlista;
	op: integer;
	palavra, verbete: string;

function verificaVazio(l: tlista): boolean;
begin
    verificaVazio:= l.inicio = nil;
end;

procedure inicializarLista(var l: tlista);
begin
	l.inicio:= nil;
	l.fim:= nil;
end;

function verificaPalavra(l: tlista; p: string): boolean;
var aux: Tponteiro;
begin
	aux:= l.inicio;
	while (aux <> nil) and (aux^.palavra <> p) do
		aux:= aux^.prox;
	if aux = nil then
		verificaPalavra:= false
	else
		verificaPalavra:= true;
end;

function verificaVerbete(l: tlista; p, v: string): boolean;
var aux: Tponteiro;
	aux2: TponteiroDic;
begin
	aux:= l.inicio;
	while (aux <> nil) and (aux^.palavra <> p) do
		aux:= aux^.prox;
	if aux <> nil then
	begin
		aux2:= aux^.dic;
		while (aux2 <> nil) and (aux2^.verbete <> v) do
			aux2:= aux2^.prox;
		if aux2 = nil then
			verificaVerbete:= false
		else
			verificaVerbete:= true;
	end
	else
		verificaVerbete:= false;
end;
	


procedure inserirPalavra(var l: Tlista; p: string);
var novo, temp, aux: Tponteiro;
begin
    new(novo);
    if novo <> nil then
    begin
        if not verificaPalavra(l, p) then
        begin
            novo^.prox:= nil;
            novo^.ant:= nil;
			novo^.dic:= nil;
            novo^.palavra:= p;
            if verificaVazio(l) then
            begin
                l.inicio:= novo;
                l.fim:= novo;
            end
            else if p < l.inicio^.palavra then
            begin
                temp:= l.inicio;
                l.inicio:= novo;
                novo^.prox:= temp;
                temp^.ant:= novo;
            end
            else
            begin
                aux:= l.inicio;
                while (aux^.prox <> nil) and (aux^.prox^.palavra < p) do
                    aux:= aux^.prox;
                if aux^.prox = nil then
                begin
                    aux^.prox:= novo;
                    novo^.ant:= aux;
                    l.fim:= novo;
                end
                else
                begin
                    temp:= aux^.prox;
                    aux^.prox:= novo;
                    novo^.prox:= temp;
                    novo^.ant:= aux;
                    temp^.ant:= novo;
                end;
            end;
        end
        else
            writeln('essa palavra já existe');
    end
    else
        writeln('Memória cheia hahaha');
end;

procedure inserirVerbete(var l: tLista; p, v: string);
var novo, temp, temp2: TponteiroDIc;
	aux: Tponteiro;
begin
	new(novo);
	if novo <> nil then
	begin
		if not verificaVerbete(l, p, v) then
		begin
			aux:= l.inicio;
			novo^.verbete:= v;
			novo^.prox:= nil;
			while (aux <> nil) and (aux^.palavra <> p) do
				aux:= aux^.prox;
			if aux^.palavra = p then
			begin
				if aux^.dic = nil then
					aux^.dic:= novo
				else if v < aux^.dic^.verbete then
				begin
					temp:= aux^.dic;
					aux^.dic:= novo;
					aux^.dic^.prox:= temp;
				end
				else
				begin
					temp:= aux^.dic;
					while (temp^.prox <> nil) and (temp^.prox^.verbete < v) do
						temp:= temp^.prox;
					temp2:= temp^.prox;
					temp^.prox:= novo;
					novo^.prox:= temp2;
				end;
			end
			else
				writeln('Palavra não encontrada');
		end
		else
			writeln('O verbete ja está na lista')
	end
	else
		writeln('Memória cheia');
end;

procedure removerVerbete(var l: Tlista; p: string; v: string);
var aux: Tponteiro;
	temp, temp2: TponteiroDIc;
begin
	if verificaVazio(l) then
		writeln('Lista de palavras vazia')
	else
	begin
		aux:= l.inicio;
		while (aux <> nil) and (aux^.palavra <> p) do
			aux:= aux^.prox;
		if aux = nil then
			writeln('Palavra não encontrada')
		else if aux^.dic = nil then
			writeln('A palavra não possui verbetes')
		else if aux^.dic^.verbete = v then
		begin
			temp:= aux^.dic;
			aux^.dic:= aux^.dic^.prox;
			dispose(temp);
		end
		else
		begin
			temp:= aux^.dic;
			while (temp^.prox <> nil) and (temp^.prox^.verbete <> v) do
				temp:= temp^.prox;
			if temp^.prox = nil then
				writeln('O verbete não está na lista')
			else
			begin
				temp2:= temp^.prox;
				temp^.prox:= temp^.prox^.prox;
				dispose(temp2);
			end;
		end;
	end;
end;

procedure consultar(l: Tlista; p: string);
var aux: Tponteiro;
	temp: TponteiroDic;
begin
	if verificaVazio(l) then
		writeln('Lista vazia')
	else
	begin
		aux:= l.inicio;
		while (aux <> nil) and (aux^.palavra <> p) do
			aux:= aux^.prox;
		if aux = nil then
			writeln('Palavra não encontrada')
		else
		begin
			temp:= aux^.dic;
			if temp = nil then
				writeln('A palavra não possui verbetes')
			else
			begin
				write('Verbetes: ');
				while (temp <> nil) do
				begin
					write(temp^.verbete, ' ');
					temp:= temp^.prox;
				end;
			end;	
		end;
	end;
end;
		
		
procedure escreverTudo(l: tlista);
var aux: Tponteiro;
	temp: TponteiroDic;
begin
	if verificaVazio(l) then
		writeln('Lista vazia')
	else
	begin
		aux:= l.inicio;
		while (aux <> nil) do
		begin
			write(aux^.palavra, ': ');
			temp:= aux^.dic;
			while (temp <> nil) do
			begin
				write(temp^.verbete);
				if temp^.prox <> nil then
					write(', ');
				temp:= temp^.prox;
			end;
			writeln;
			aux:= aux^.prox;
		end;
	end;
end;

function formatarString(s: string): string;
var i: integer;
	resultado: string;
begin
	resultado:= '';
	if length(s) > 0 then
	begin
		resultado:= upcase(s[1]);
		for i:= 2 to length(s) do
		begin
			if (s[i] >= 'A') and (s[i] <= 'Z') then
				resultado:= resultado + char(ord(s[i]) + 32)
			else
				resultado:= resultado + s[i];
		end;
	end;
	formatarString:= resultado;
end;

begin
	inicializarLista(lista);
	op:= 0;
	while op <> 6 do
	begin
		writeln;
		writeln('1 - Inserir palavra');
		writeln('2 - Inserir verbete');
		writeln('3 - Remover verbete');
		writeln('4 - Consultar');
		writeln('5 - Escrever tudo');
		writeln('6 - Sair');
		write('Opcao: ');
		readln(op);
		case op of
			1: begin
				writeln;
				write('Palavra: ');
				readln(palavra);
				palavra:= formatarString(palavra);
				inserirPalavra(lista, palavra);
			end;
			2: begin
				writeln;
				write('Palavra: ');
				readln(palavra);
				write('Verbete: ');
				readln(verbete);
				palavra:= formatarString(palavra);
				verbete:= formatarString(verbete);
				inserirVerbete(lista, palavra, verbete);
			end;
			3: begin
				writeln;
				write('Palavra: ');
				readln(palavra);
				write('Verbete: ');
				readln(verbete);
				palavra:= formatarString(palavra);
				verbete:= formatarString(verbete);
				removerVerbete(lista, palavra, verbete);
			end;
			4: begin
				writeln;
				write('Digite a palavra a ser consultada: ');
				readln(palavra);
				palavra:= formatarString(palavra);
				writeln;
				consultar(lista, palavra);
				writeln;
			end;
			5: begin
				writeln;	
				escreverTudo(lista);
				writeln;
			end;
		else
			writeln('Opcao invalida');
		end;
	end;
end .