tpu/u_listci.pas

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

  Listas de enteros por cursores y sin celdas de
  encabezamiento.

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{$Id: u_listci.pas v2 2002/04/04 17:40 mstorti Exp jdelia$}

unit u_listci ;

interface

const
  maxlen = 100 ; {longitud del arreglo de cursores}
  nyl    =   0 ; {equivalente del nil en punteros}
type
  tipo_elemento = integer;
  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

  listci = 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 listci.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 listci.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 listci.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 listci.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 listci.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 listci.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 listci.SIGUIENTE (p: posicion): posicion;
begin
  if (p <> nyl) then
    SIGUIENTE := espacio [p].sig
  else begin
    SIGUIENTE := a;
  end ; {if}
end; {SIGUIENTE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listci.ANTERIOR (p: posicion): posicion;
var
  q, z : 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 ;
  z := FIN ;
  while (q <> z) do begin
    if ( SIGUIENTE (q) = p) then break;
    q := SIGUIENTE (q) ;
  end ; {while}
  ANTERIOR := q;
end; {ANTERIOR}

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

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listci.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 listci.IMPRIME (s : string) ;
var
  q : posicion;
begin
  if length (s) > 0 then writeln (s);
  writeln ('lista: ');
  q := PRIMERO ;
  while (q <> FIN) do begin
    write ( RECUPERA (q),' ');
    q := SIGUIENTE (q);
  end; {while}
  writeln ;
end; {IMPRIME}

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

Generated by GNU enscript 1.6.1.