tpu/u_listai.pas

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

  Listas de enteros por arreglos. keywords: lista, arreglos

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

unit u_listai;

interface

const
  maxlen = 10 ; {longitud del arreglo}
  nyl    =  0 ; {equivalente del nil en punteros}

type
  tipo_elemento = integer;
  posicion = 0..maxlen; {posicion en rango admisible}
  t_ultimo = 0..maxlen; {ultimo   en rango admisible}

  t_lista = record
    elemento : array [1..maxlen] of tipo_elemento;
    ult      : t_ultimo
  end;

  listai = object
  private
    L : t_lista ;
    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;
    procedure ANULA   ;
    function  PRIMERO : posicion;
    function  FIN     : posicion;
    procedure IMPRIME (s : string) ;
  end;			    

implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listai.INSERTA (     x: tipo_elemento; 
                               p: posicion);
var
  q, i : posicion;
begin
  if  ( L.ult >= maxlen ) then  
    ERROR ('la lista esta llena')
  else if ( p > L.ult + 1) or ( p < 1) then
    ERROR ('la posicion no existe')
  else begin {desplaza los p, p+1, ... un lugar h/abajo}
    for q := L.ult downto p do begin
      L.elemento [q+1] := L.elemento [q];
    end ; {for}
    L.ult          := L.ult + 1 ;
    L.elemento [p] := x ;
  end ; {if}
end; {INSERTA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.LOCALIZA (x: tipo_elemento): posicion;
var
  q, r : posicion;
  siga : boolean ;
begin
  r := L.ult + 1 ; 
  q := 1 ;
  siga := true ;
  while  ( q <= L.ult ) and (siga) do begin
    if ( L.elemento [q] = x )  then begin
      r    := q ;
      siga := false ;
    end ; {if}
    q := q + 1 ;
  end ; {while}
  LOCALIZA := r ;
  writeln ;
  writeln ('localiza elemento ; x = ', x);
  writeln ('en posicion       ; r = ', r);
end; {LOCALIZA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.RECUPERA (p: posicion): tipo_elemento;
begin
  RECUPERA := L.elemento [p];
end; {RECUPERA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listai.SUPRIME (p: posicion);
var
  q : posicion ;
begin
  if      ( p > L.ult ) or ( p < 1) then
    ERROR ('la posicion no existe')
  else begin {desplaza los p+1, p+2, ..., un lugar h/arriba}
    L.ult := L.ult - 1 ;  
    for q := p to (L.ult) do begin
      L.elemento [q] := L.elemento [q + 1];
    end ; {for}
  end ; {if}
end; {SUPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.SIGUIENTE (p: posicion): posicion;
begin
  SIGUIENTE := p + 1 ;
end; {SIGUIENTE}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.ANTERIOR (p: posicion): posicion;
begin
  if      ( p > L.ult ) or ( p < 1) then
    ERROR ('la posicion no existe')
  else begin
    ANTERIOR := p - 1 ;
  end ; {if}
end; {ANTERIOR}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure listai.ANULA ;
begin
  L.ult := 0 ;
end; {ANULA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.PRIMERO : posicion;
begin
  PRIMERO := 1 ;
end; {PRIMERO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function listai.FIN : posicion;
begin
  FIN := L.ult + 1 ;
end; {FIN}

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

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

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