unit TabP2d;
{+doc
+NOMBRE: TabP2d
+CREACION:  27.1.1992
+AUTOR: Ruben Chaer.
+REVISION:
+AUTOR:
+REGISTRO:
+TIPO: Unidad Pascal.
+PROPOSITO: Definici¢n de tablas de puntos en el espacio de dos
	dimenciones.
+PROYECTO: ARTEF1. (RCh)
+DESCRIPCION:
-doc}

interface
uses
//		archivos,
		FDefs,
		xMatDefs;

type
	p2D = record
		x,y:NReal;
	end;

	p_p2d = ^p2d;
	f_p2d = function(var x:p2d):NReal;

	LAP2D = array[0..2000] of p2d;
	p_LAP2D = ^LAP2d;


	TTablaP2d = class
		n,					{N£mero de elementos actuales}
		nmax:integer;	{M ximo n£mero de elementos}
		p_Val:p_LAP2D;
		kult:integer; 	{K de la £ltima operaci¢n de busqueda }

		constructor Create(xnmax:integer);
		constructor Load(var a:archivo);
		procedure Save(var a:archivo);

		procedure Free; virtual;

		constructor LoadFromTextFile(var tf:text);
		procedure SaveToTextFile(var tf:text);

		procedure Agregar(var X:p2d);
		procedure AgregXY( x, y: NReal);
		procedure Poner(k:integer;var X:p2d);
		procedure Dar(var X:p2d;k:integer);
		function DarPtr(K:integer):p_p2d;
		function MaxX:NReal;
		function MaxY:NReal;

		procedure Inc(var px:p_P2D);
		procedure Dec(var px:p_P2D);
		function pte(k:integer):p_P2D;

		function MayorQueFreal(var fr:TFReal):integer;
      { resulatado:
			+1 , indica que y > fr(x)  para todos los puntos de la tabla.
			0 	, indica que y > fr(x) , y < fr(x) para puntos distintos.
			-1	, indica que y < fr(x) , para todos los puntos de la tabla.
		}


		{ Resultado de la interpolación lineal entre puntos de la tabla }
		function yfval(x:NReal):NReal;


		{Esta funcion sirve para buscar el cambio de signo de una superficie
		cuando se camina por la curva descripta por la tabla. Sirve para
		calcular la inteseccion entre la curva descripta por la tabla y la curva
    iso nivel ( 0 ) de un superficie }
		function BuscarCambioSigno(
			gp: f_P2D;    		{ Funci¢n a evaluar }
			k0,k1:integer;		{ Rango de busqueda }
			var kres:integer	{ El cambio se da entre kres-1 y kres }
			):boolean;			{ Resultado en rango }


	end;

	poligonal = TTablap2d;


implementation



constructor TTablaP2D.Create(xnmax:integer);
begin
	inherited Create;
	nmax:=xnmax;
	GetMem(p_Val,nmax*SizeOf(p2d));
	n:=0;
end;

procedure TTablaP2D.Free;
begin
	FreeMem(p_Val,nmax*SizeOf(p2d));
	inherited Free;
end;

constructor TTablaP2d.Load(var a:archivo);
begin
	BlockRead(a, nmax,sizeOf(nmax));
	GetMem(p_Val,nmax*SizeOf(p2d));
	BlockRead(a, n,sizeOf(n));
	BlockRead(a, p_val^,n*SizeOf(p2d));
end;

constructor TTablaP2d.LoadFromTextFile(var tf:text);
var
	k:integer;
	p:p2d;
begin
	readln(tf);
	readln(tf);
	readln(tf);
	readln(tf,nmax);
	GetMem(p_Val,nmax*SizeOf(p2d));
	readln(tf,n);
	for k:= 0 to n-1 do
	begin
		readln(tf,p.x,p.y);
		p_val^[k]:=p;
	end;
	readln(tf);
end;


procedure TTablaP2d.Save(var a:archivo);
begin
	BlockWrite(a, nmax,sizeOf(nmax));
	BlockWrite(a, n,sizeOf(n));
	BlockWrite(a, p_val^,n*SizeOf(p2d));
end;

procedure TTablaP2d.SaveToTextFile(var tf:text);
var
	k:integer;
begin
	writeln(tf,'--------------------------------------');
	writeln(tf,'  Tabla de puntos 2d');
	writeln(tf,'......................................');
	writeln(tf,nmax:6,'  Máximo número de puntos');
	writeln(tf,n:6,'  Número actual de puntos');
	for k:= 0 to n-1 do
		writeln(tf,p_val^[k].x:12:4,p_val^[k].y:12:4);
	writeln(tf,'.......................................');
end;

procedure TTablaP2d.Agregar(var X:p2d);
begin
	p_val^[n]:=X;
	n:=n+1;
end;

procedure TTablaP2D.AgregXY( x, y: NReal);
var
	P: P2D;
begin
	P.x:= x; P.y:= y;
	Agregar(P);
end;

procedure TTablaP2d.Poner(k:integer;var X:p2d);
begin
	p_val^[k]:=X;
end;

procedure TTablaP2d.Dar(var X:p2d;k:integer);
begin
	X:=p_val^[k]
end;

procedure TTablaP2d.Inc(var px:p_P2D);
var
	temp:^word;
begin
	Temp:=@px;
	Temp^:=Temp^+SizeOf(p2D);
end;

procedure TTablaP2d.Dec(var px:p_P2D);
var
	temp:^word;
begin
	Temp:=@px;
	Temp^:=Temp^-SizeOf(p2D);
end;

function TTablaP2d.pte(k:integer):p_P2D;
begin
	pte:=@p_Val^[k]
end;

function TTablaP2d.DarPtr(k:integer):p_p2d;
begin
	DarPtr:=addr(p_val^[k])
end;

function TTablaP2d.MaxX:NReal;
var
	k:integer;
	m:NReal;
begin
	m:= DarPtr(0)^.x;
	for k:= 1 to n-1 do if DarPtr(k)^.x>m then m:= DarPtr(k)^.x;
	MaxX:=m
end;


function TTablaP2d.MaxY:NReal;
var
	k:integer;
	m:NReal;
begin
	m:= DarPtr(0)^.y;
	for k:= 1 to n-1 do if DarPtr(k)^.y>m then m:= DarPtr(k)^.y;
	MaxY:=m
end;

function TTablaP2d.MayorQueFreal(var fr:TFReal):integer;
{ resulatado:
		+1 , indica que y > fr(x)  para todos los puntos de la tabla.
		0 	, indica que y > fr(x) , y < fr(x) para puntos distintos.
		-1	, indica que y < fr(x) , para todos los puntos de la tabla.
}
var
	p:p2d;
	k:integer;

begin
	Dar(p,0);

	if p.y > fr.fval(p.x) then
	begin
		for k:= 1 to n-1 do
		begin
			Dar(p,k);
			if p.y<=fr.fval(p.x) then
			begin
				MayorQueFReal:=0;
				kult:=k;
				Exit
			end;
		end;
		MayorQueFReal:=1;
		exit
	end;

	if p.y < fr.fval(p.x) then
	begin
		for k:= 1 to n-1 do
		begin
			Dar(p,k);
			if p.y>=fr.fval(p.x) then
			begin
				MayorQueFReal:=0;
				kult:=k;
				Exit
			end;
		end;
		MayorQueFReal:=-1;
		exit
	end;

	MayorQueFReal:=0;
	kult:=0;
end;

function TTablaP2d.yfval(x:NReal):NReal;
type
	tr = record
		x,y,inc:NReal
	end;

var
	k:integer;
	q,p:pointer;
	s,ss:integer;
begin
	p:=DarPtr(0);
	if NReal(p^) = x then
	begin
		kult:=0;
		yfval:=tr(p^).y;
	end
	else
	begin
		if NReal(p^)>x then s:=1
		else s:=-1;
		for k:= 1 to n-1 do
		begin
			q:=p;
			p:=@tr(p^).inc;
			if NReal(p^)>=x then ss:=1
			else ss:=-1;
			if s <> ss then
			begin
				kult:=k;
				yfval:=(tr(p^).y-tr(q^).y)/(tr(p^).x-tr(q^).x)
						*(x-tr(q^).x)+tr(q^).y;
				exit;
			end
		end;
	yfval:=0; { valor fuera de tabla }
	kult:=n-1;
	end;
end;

function TTablaP2D.BuscarCambioSigno(
			gp: f_P2D;    		{ Funci¢n a evaluar }
			k0,k1:integer;		{ Rango de busqueda }
			var kres:integer	{ El cambio se da entre kres-1 y kres }
			):boolean;			{ Resultado en rango }
var
	sk0,k:integer;
begin
	sk0:=signo(gp(DarPtr(k0)^));
	for k:= k0+1 to k1 do
		if abs(signo(gp(DarPtr(k)^)) +sk0)<2 then
		begin
			kres:=k;
			BuscarCambioSigno:=true;
			exit
		end;
	BuscarCambioSigno:=false;
	kres:=-1
end;

end.