program abr;
{Arbres binaires de recherche en 2 dimensions}
{Les cles sont ici des couples d'entiers}
	uses
		GetClick;  {Unite ou` sont definies les procedures GetClick, GetPoint et GetRect}

	const
		Taille = 16; {cote vertical d'une case dans le dessin}
		MargeX = 3; {coordonnˇes du point d'origine du texte relativement}
		MargeY = 11;{au coin supˇrieur gauche de la case qui le contient}
		Niveau_X = true;
		Niveau_Y = false; {constantes indiquant, pour un noeud de l'arbre, si les comparaisons}
						 {se font sur les corrdonnees x ou y}

	type
		Typecle = Point;
		Arbre = ^Noeud;
		Noeud = record
				cle: Typecle;
				fg, fd: Arbre;
			end;

	var
		a: Arbre;
		n: integer; {variable globale comptant le nombre d'elements dans l'arbre}
		r: Rect;   {rectangle de recherche}
{---------------------------------base abr-------------------------------------------------}
	function arbrevide (a: Arbre): boolean;
	begin
		if a = nil then
			arbrevide := true
		else
			arbrevide := false;
	end;

	procedure vider (var a: Arbre);
{vider l'arbre a}
	begin
		a := nil;
	end;

	function creerboite (p: Typecle): Arbre;
		var
			a: Arbre;
	begin
		new(a);
		a^.cle := p;
		a^.fg := nil;
		a^.fd := nil;
		creerboite := a;
	end;

{---------------------------------insertion------------------------------------------------}
	procedure insertion (p: Typecle; niveau: boolean; var a: Arbre);
	begin
		if arbrevide(a) then
			begin
				a := creerboite(p);
				n := n + 1;
			end
		else
			begin
				if niveau = Niveau_X then
					begin
						if p.h < a^.cle.h then
							insertion(p, Niveau_Y, a^.fg)
						else if p.h > a^.cle.h then
							insertion(p, Niveau_Y, a^.fd)
						else {p.h=a^.cle.h}
							if (p.v <> a^.cle.v) then
								insertion(p, Niveau_Y, a^.fd)
			{si p est deja une cle, on ne fait rien}
					end
				else    {niveau = Niveau_Y }
					begin
						if p.v < a^.cle.v then
							insertion(p, Niveau_X, a^.fg)
						else if p.v > a^.cle.v then
							insertion(p, Niveau_X, a^.fd)
						else {p.v=a^.cle.v}
							if (p.h <> a^.cle.h) then
								insertion(p, Niveau_X, a^.fd)
			{si p est deja une cle, on ne fait rien}
					end;
			end;
	end;


{---------------------------saisie et affichage des points de l'arbre--------------------------}
	procedure affiche_point1 (p: Point);
{affiche un point dans la fenetre grahique}
		var
			r: Rect;
	begin
		SetRect(r, p.h, p.v, p.h + 1, p.v + 1);
		PaintOval(r);
	end;

	procedure affiche_point2 (p: Point);
{affiche un peu plus gros un point dans la fenetre grahique}
		var
			r: Rect;
	begin
		SetRect(r, p.h - 1, p.v - 1, p.h + 1, p.v + 1);
		PaintOval(r);
	end;

	procedure surligner (p: Point);
{affiche surligne' d'un point dans la fenetre grahique}
		var
			r: Rect;
	begin
		SetRect(r, p.h - 5, p.v - 5, p.h + 5, p.v + 5);
		FrameOval(r);
	end;

	procedure initialisation_drawing;
{positionne la fenetre Drawing}
		var
			r: Rect;
	begin
		SetRect(r, 10, 50, 630, 600);
		SetDrawingRect(r);
		ShowDrawing;
	end;

	function est_dans (r: Rect; p: Point): boolean;
{teste si un point p est contenu dans un rectangle r}
		var
			b: boolean;
	begin
		b := false;
		if (r.left <= p.h) and (p.h <= r.right) and (r.top <= p.v) and (p.v <= r.bottom) then
			b := true;
		est_dans := b;
	end;


	procedure entre_points (var a: Arbre);
{Permet d'entrer un ensemble de points a la souris et les range dans l'arbre a}
		var
			stop: Rect;
			p: Point;
	begin
		Setrect(stop, 0, 0, 20, 20);
		PaintRect(stop); {dessin du bouton stop}

		repeat
			GetPoint(p);
			affiche_point1(p);  {les points sont affihes a la saisie}
			insertion(p, Niveau_X, a);
		until est_dans(stop, p);
	end;

	procedure trace_points (a: Arbre);
	begin
		if arbrevide(a) then
		else
			begin
				trace_points(a^.fg);
				affiche_point2(a^.cle); {les points sont reaffiches un peu plus gros}
				trace_points(a^.fd);
			end;
	end;

{----------------------------recherche des points d'un rectangle-----------------------------}
	procedure recherche_rect (r: Rect; niveau: boolean; a: Arbre);
{recherche les points du rectangle et les affichent surligne's.}
{on suppose que les dimensions du rectangle sont correctes.}
	begin
		if arbrevide(a) then
		else
			begin
				if niveau = Niveau_X then
					begin
						if (a^.cle.h < r.left) then
							recherche_rect(r, Niveau_Y, a^.fd)
						else if (a^.cle.h > r.right) then
							recherche_rect(r, Niveau_Y, a^.fg)
						else {r.left<=a^.cle.h<=r.right}
							begin
								recherche_rect(r, Niveau_Y, a^.fd);
								if (r.top <= a^.cle.v) and (a^.cle.v <= r.bottom) then
									surligner(a^.cle); {les points sont affiches surligne's}
								recherche_rect(r, Niveau_Y, a^.fg)
							end;
					end
				else {niveau = Niveau_Y}
					begin
						if (a^.cle.v < r.top) then
							recherche_rect(r, Niveau_X, a^.fd)
						else if (a^.cle.v > r.bottom) then
							recherche_rect(r, Niveau_X, a^.fg)
						else {r.top<=a^.cle.v<=r.bottom}
							begin
								recherche_rect(r, Niveau_X, a^.fd);
								if (r.left <= a^.cle.h) and (a^.cle.h <= r.right) then
									surligner(a^.cle);{les points sont affiches surligne's}
								recherche_rect(r, Niveau_X, a^.fg)
							end;
					end;
			end;
	end;



{----------------------------------partie dessin d'un arbre binaire--------------------------------}
	procedure dessinelem (x, y: integer; p: Typecle);
{dessin d'un rectangle pour representer un noeud comportant}
{des cles formees d'un couple d'entiers ayant au plus 3 chiffres}
		var
			r: rect;
	begin
		SetRect(r, x, y, x + 3 * Taille, y + Taille);
		EraseRect(r);
		FillRect(r, white);
		MoveTo(x + MargeX, y + MargeY);
		WriteDraw(p.h : 3, ',', p.v : 3);
         {Utiliser DrawString pour afficher une chaine dans la fenetre graphique}
         {si vous etes sous PC (voir specifications de MacLib)}
		FrameRect(r);
	end;


	procedure dessin (a: Arbre); {consulter l'enonce pour savoir comment est trace ce dessin}
		var
			r: rect;
			dx, dy, yrac, xmin, xrac, xmax: integer;

		procedure dessinrec (a: Arbre; yrac, xmin: integer; var xrac, xmax: integer);
			var
				xxmin, xxrac, xxmax: integer;
		begin
			if arbrevide(a) then
			else
				begin
					if not arbrevide(a^.fg) then
						begin
							xxmin := xmin;
							dessinrec(a^.fg, yrac + dy, xxmin, xxrac, xxmax);
							xrac := xxmax + dx;
							moveto(xxrac, yrac + dy);
							lineto(xrac, yrac);
							dessinelem(xxrac - 20 - MargeX, yrac + dy - MargeY, a^.fg^.cle);
						end
					else
						xrac := xmin;
					if not arbrevide(a^.fd) then
						begin
							xxmin := xrac + dx;
							dessinrec(a^.fd, yrac + dy, xxmin, xxrac, xxmax);
							xmax := xxmax;
							moveto(xxrac, yrac + dy);
							lineto(xrac, yrac);
							dessinelem(xxrac - 20 - MargeX, yrac + dy - MargeY, a^.fd^.cle);
						end
					else
						xmax := xrac;
				end;
		end;

	begin
		initialisation_drawing;  {ceci permet en particulier d'effacer le precedent dessin}
		dx := 50;
		dy := 50;
		yrac := 10;
		xmin := 25;
		dessinrec(a, yrac, xmin, xrac, xmax);
		if not arbrevide(a) then
			dessinelem(xrac - 20 - MargeX, yrac - MargeY, a^.cle);
	end;


{-----------------------------------------------------------------------------------------------}
begin{principal}
{ajouter InitQuickDraw; ici sous PC}
	initialisation_drawing;
	entre_points(a);
	trace_points(a);
	GetRect(r);
	FrameRect(r);
	recherche_rect(r, Niveau_X, a);
	GetClick; {on attend un click avant d'afficher l'arbre}
	dessin(a);
end. {principal}