informatyki i systemów mikroprocesorowych

program kolejka;

uses
  Crt;

type
  TWskaznik = ^TElement;
  TElement  = record
                Liczba : Byte;
                Nast  : TWskaznik;
              end;

var
  Kolejka : TWskaznik;
  Liczba : Byte;
  Znak : Char;
  P : Pointer;

procedure Ustaw (Liczba: Byte);
{ustawia w element w kolejce}
var
  E, Pop, Nast : TWskaznik;
begin
  New (E);
  E^.Liczba := Liczba;
  E^.Nast := Nil;
  if (Kolejka = nil) then
  begin
    E^.Nast := Kolejka; Kolejka := E;
  end
  else
  begin
    Pop := Kolejka; Nast := Kolejka^.Nast;
    while (Nast <> nil) do
    begin
      Pop := Nast;
      Nast := Nast^.Nast;
    end;
    E^.Nast := Nast;
    Pop^.Nast := E;
  end;
end;

function Obsluz: Byte;
var
  E : TWskaznik;
begin
  if (Kolejka = nil) then
    Obsluz := 0
  else
  begin
    E := Kolejka;
    Obsluz := E^.Liczba;
    Kolejka := E^.Nast;
  end;
end;

procedure WypiszKolejke;
var
  E : TWskaznik;
begin
  E := Kolejka;
  while E <> nil do
  begin
    write (E^.Liczba, ' ');
    E := E^.Nast;
  end;
end;

begin
  Mark (P);
  Kolejka := nil;
  repeat
    ClrScr;
    write ('Kolejka: ');
    WypiszKolejke;
    writeln;
    writeln ('U - ustaw w kolejce, O - obsluz, K - koniec');
    Znak := UpCase(ReadKey);
    case Znak of
      'U' : begin
              repeat
                write ('Podaj liczbe z zakresu (1..255): ');
                readln (Liczba);
              until Liczba>0;
              Ustaw (Liczba);
            end;
      'O' : begin
              Liczba := Obsluz;
              if Liczba = 0 then
                writeln ('Nie ma czego obslugiwac, kolejka pusta.')
              else
                writeln ('Element do obsluzenia: ', Liczba);
            end;
    end;
    if ((Znak='U') or (Znak='O')) then
    begin
      write ('Nowa kolejka: ');
      WypiszKolejke;
      writeln; writeln ('Wcisnij Enter');
      readln;
    end;
  until (Znak = 'K');
  Release (P);
end.