tpu/u_listcr.pas

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

  Listas de reales por cursores y sin celdas de
  encabezamiento. keywords: lista, cursores

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

unit u_listcr ;

interface

const
  maxlen = 100 ; {longitud del arreglo de cursores}
  nyl    =   0 ; {equivalente del nil en punteros}
type
  tipo_elemento = real ;
  posicion = 0..maxlen; {cursor en rango admisible}
  L        = 1..maxlen; {lista  en rango admisible}

  t_espacio = array [1..maxlen] of record 
    elemento : tipo_elemento;
    sig      : posicion
  end;

var
  espacio : t_espacio ;
  disp    : posicion ;

procedure INICIALIZA_NODOS (var espacio : t_espacio) ;

type

  listcr = object
  private
    a : posicion ;
    procedure ERROR (s: string);
    function  MUEVE (var p, q : posicion): boolean ;
  public
    procedure INSERTA   (x: tipo_elemento; p: posicion);
    function  LOCALIZA  (x: tipo_elemento): posicion;
    function  RECUPERA  (p: posicion) : tipo_elemento;
    procedure SUPRIME   (var p: posicion);
    function  SIGUIENTE (p: posicion): posicion;
    function  ANTERIOR  (p: posicion): posicion;
    function  PRIMERO : posicion;
    procedure ANULA ;
    function  FIN     : posicion;
    procedure IMPRIME (s : string) ;
  end;			    

implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure INICIALIZA_NODOS (var espacio : t_espacio) ;
var
  i : posicion ;
begin
  for i := (maxlen - 1) downto 1 do begin
    espacio [i].sig := i + 1 ;
  end ; {for}
  disp := 1 ;
  espacio [maxlen].sig := 0 ;
end ; {INICIALIZA_NODOS}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.MUEVE (var p, q : posicion) : boolean ;
var { coloca la celda apuntada por p adelante de q}
  t : posicion;
begin
  MUEVE := false ;
  if ( p = nyl ) then
    writeln ('celda inexistente')
  else begin
    MUEVE := true ;
    t := q ;
    q := p ;
    p := espacio [q].sig ; 
    espacio [q].sig := t ;
  end ; {if}
end; {MUEVE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listcr.INSERTA (x : tipo_elemento; 
			  p : posicion);
var
  q : posicion;
begin
  { hace q := cursor a la celda donde esta el dato }
  if (p = nyl) then
    q := a
  else begin
    q := espacio [p].sig;
  end ; {if}
  if MUEVE (disp, q) then begin
    espacio [q].elemento := x;
    if (p <> nyl) then
      espacio [p].sig := q
    else begin
      a := q;
    end ; {if}
  end; {if}
end; {INSERTA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.LOCALIZA (x: tipo_elemento): posicion;
var
  p : posicion;
begin { Esta version es independiente de la implementacion }
  p := PRIMERO ;
  while ( p <> FIN ) do begin
    if ( RECUPERA (p) = x) then break;
    p := SIGUIENTE (p);
  end ; {while}
  LOCALIZA := p;
end; {LOCALIZA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.RECUPERA (p: posicion): tipo_elemento;
var
  q : posicion;
begin
  if (p <> nyl) then 
    begin
    q := espacio [p].sig;
    RECUPERA := espacio[q].elemento;
    end
  else begin
    RECUPERA := espacio [a].elemento ;
  end ; {if}
end; {RECUPERA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listcr.SUPRIME (var p: posicion);
var
  b : boolean ;
  q : posicion ;
begin
  if ( p = nyl ) then {borra posicion n}
    b := MUEVE (a, disp)
  else begin
    q := espacio [p].sig ;
    b := MUEVE (q, disp) ;
    espacio [p].sig := q ;
  end ; {if}
end; {SUPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.SIGUIENTE (p: posicion): posicion;
begin
  if (p <> nyl) then
    SIGUIENTE := espacio [p].sig
  else begin
    SIGUIENTE := a;
  end ; {if}
end; {SIGUIENTE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.ANTERIOR (p: posicion): posicion;
var
  q : posicion;
begin { Esta version es independiente de la implementacion }
  if (p = primero) then begin
    ERROR ('No se puede dar la posicion anterior a primero');
  end ; {if}
  q := PRIMERO ;
  while (q <> FIN) do begin
    if siguiente(q)=p then break;
  end ; {while}
  ANTERIOR := p;
end; {ANTERIOR}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listcr.ANULA ;
begin
  a := nyl ;
end; {ANULA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.PRIMERO : posicion;
begin
  PRIMERO := 0;
end; {PRIMERO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listcr.FIN : posicion;
var
  p, q : posicion;
begin
  if (a = nyl) then { La lista esta vacia, retornal nyl }
    FIN := nyl
  else begin { FIN es la posicion de la ultima celda }
    p := a;
    while (true) do begin
      q := espacio [p].sig;
      if (q = nyl) then
        break
      else begin
        p := q;
      end ; {if}
    end ; {while}
    FIN := p;
  end ; {if}
end;

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

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

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