tpu/u_colapc.pas

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

  Colas de caracteres (simples) por punteros.
  keywords: cola, punteros

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

unit u_colapc;

interface

type
  tipo_elemento = char;
  ptipo_celda = ^tipo_celda;

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

  colapc = object
  private
    ant, post: ptipo_celda;
      procedure ERROR (s: string);
    public
      procedure ANULA;
      procedure PONE (x: tipo_elemento);
      procedure QUITA;
      function  VACIA: boolean;
      function  FRENTE: tipo_elemento;
      procedure IMPRIME (s : string) ;
  end;			      

  implementation

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

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure colapc.ANULA;
begin
  new (ant);
  ant^.sig := nil;
  post := ant;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure colapc.PONE (x: tipo_elemento);
begin
  new (post^.sig);
  post := post^.sig;
  post^.elemento := x;
  post^.sig := nil;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure colapc.QUITA;
begin
  if VACIA then
    error ('la cola esta vacia')
  else begin
    ant := ant^.sig
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function  colapc.VACIA : boolean;
begin
  VACIA := ant = post;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function  colapc.FRENTE : tipo_elemento;
begin
  if ( VACIA ) then
    ERROR (' la cola esta vacia')
  else begin
    FRENTE := ant^.sig^.elemento
  end ; {if}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure colapc.IMPRIME (s: string) ;
begin
  writeln ;
  if length (s) > 0 then writeln (s);
  writeln ('imprime cola : ');
  while ( not VACIA ) do begin
    write (FRENTE, ' ');
    QUITA ;
  end; {while}
  writeln ;
end; {IMPRIME}

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