tpu/u_listpr.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

  Lista de reales por punteros. keywords: lista, punteros

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_listpr.pas,v 1.1 2002/04/25 15:57:09 mstorti Exp mstorti $}

unit u_listpr;

interface

type

  tipo_elemento = real ;

  ptipo_celda = ^tipo_celda;
  tipo_celda = record
    elemento: tipo_elemento;
    sig     : ptipo_celda
  end;

  posicion = ptipo_celda;

  listpr = object
  private
    cab : posicion;
    procedure ERROR (s: string);
  public
    procedure INSERTA   (x: tipo_elemento; p: posicion);
    function  LOCALIZA  (x: tipo_elemento): posicion;
    function  RECUPERA  (p: posicion) : tipo_elemento;
    procedure SUPRIME   (p: posicion) ;
    function  SIGUIENTE (p: posicion) : posicion;
    function  ANTERIOR  (p: posicion) : posicion;
    function  ANULA   : posicion;
    function  PRIMERO : posicion;
    function  FIN     : posicion;
    procedure IMPRIME (s : string) ;
  end ;			    

  implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listpr.ERROR (s: string);
begin
  write ('error: ');
  writeln (s);
  halt;
end; {ERROR}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listpr.INSERTA (x: tipo_elemento; p: posicion);
var
  temp : posicion;
begin
  temp := p^.sig;
  new (p^.sig);
  p^.sig^.elemento := x;
  p^.sig^.sig := temp;
end; {INSERTA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.LOCALIZA (x: tipo_elemento): posicion;
var
  q: posicion;
begin
  q := PRIMERO;
  while (q^.sig <> nil) 
    and (q^.sig^.elemento <> x) do q := q^.sig;
  LOCALIZA := q;
end; {LOCALIZA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.RECUPERA (p: posicion): tipo_elemento;
begin
  RECUPERA := p^.sig^.elemento;
end; {RECUPERA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listpr.SUPRIME (p: posicion);
begin
  p^.sig := p^.sig^.sig;
end; {SUPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.SIGUIENTE (p: posicion): posicion;
begin
  SIGUIENTE := p^.sig;
end; {SIGUIENTE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.ANTERIOR (p: posicion): posicion;
var
  q,r : posicion;
begin
  r := PRIMERO ;
  q := PRIMERO ;
  while (q <> p) and (q^.sig <> nil) do begin
    r := q;
    q := q^.sig;
  end;
  ANTERIOR := r;
end; {ANTERIOR}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.ANULA : posicion;
begin
  new (cab);
  cab^.sig := nil;
  ANULA := cab;
end; {ANULA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.PRIMERO : posicion;
begin
  PRIMERO := cab;
end; {PRIMERO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listpr.FIN : posicion;
var
  q: posicion;
begin
  q := PRIMERO;
  while (q^.sig <> nil)  do q := q^.sig;
  FIN := q;
end; {FIN}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listpr.IMPRIME (s: string);
var
  q, z : ptipo_celda;
begin
  if length (s) > 0 then writeln (s);
  writeln ('lista: ');

  q := PRIMERO ;
  z := FIN ;
  while ( q <> z ) do begin
    writeln ( RECUPERA (q) );
    q := SIGUIENTE (q);
  end ; {while}
  writeln ;
end; {IMPRIME}

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}