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.
