informatyki i systemów mikroprocesorowych

program Lista_dwukierunkowa;

uses
  Crt;

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

var
  ListaLewy, ListaPrawy : TWskaznik;
  Liczba : Byte;
  Znak : Char;
  P : Pointer;

procedure UstawZLewej (Liczba: Byte);
{lewa strony listy}
var
  E : TWskaznik;
begin
  New (E);
  E^.Liczba := Liczba;
  E^.Pop := Nil;
  if (ListaLewy = nil) then
  begin
    E^.Nast := Nil; ListaLewy := E; ListaPrawy := E;
  end
  else
  begin
    ListaLewy^.Pop := E; E^.Nast := ListaLewy; ListaLewy := E;
  end;
end;

procedure UstawZPrawej (Liczba: Byte);
{prawa strony listy}
var
  E : TWskaznik;
begin
  New (E);
  E^.Liczba := Liczba;
  E^.Nast := Nil;
  if (ListaPrawy = nil) then
  begin
    E^.Pop := Nil; ListaPrawy := E; ListaLewy := E;
  end
  else
  begin
    ListaPrawy^.Nast := E; E^.Pop := ListaPrawy; ListaPrawy := E;
  end;
end;

procedure Usun (Liczba : Byte);
{usuwa klucz Liczba}                                          }
var
  E, Nast, Pop : TWskaznik;
begin
  if ListaLewy <> nil then
  begin
    E := ListaLewy;
    while E<>nil do
      if E^.Liczba = Liczba then
      begin
        if E^.Pop = Nil then { pierwszy z lewej }
          if E^.Nast = Nil then { takze pierwszy z prawej }
          begin
            ListaLewy := Nil; ListaPrawy := Nil
          end
          else { Pierwszy, ale nie jedyny }
          begin
            Nast := E^.Nast; Nast^.Pop := E^.Pop; ListaLewy := Nast;
          end
        else { nie jest pierwszy z lewej }
          if E^.Nast = Nil then { ale pierwszy z prawej }
          begin
            Pop := E^.Pop; Pop^.Nast := E^.Nast; ListaPrawy := Pop;
          end
          else
          begin
            Nast := E^.Nast; Pop := E^.Pop;
            Pop^.Nast := E^.Nast; Nast^.Pop := E^.Pop;
          end;
        Pop := E;
        E := E^.Nast;
        Dispose (Pop);
      end
      else
        E := E^.Nast
  end;
end;

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

procedure WypiszListeZPrawej;
var
  E : TWskaznik;
begin
  E := ListaPrawy;
  while E <> nil do
  begin
    write (E^.Liczba, ' ');
    E := E^.Pop;
  end;
end;

begin
  ListaLewy := nil;
  ListaPrawy := nil;

  repeat
    ClrScr;
    write ('Lista: ');
    WypiszListeZLewej; write (' - od tylu: '); WypiszListeZPrawej;
    writeln;
    writeln ('L - ustaw z lewej, P - ustaw z prawej, U - usun, K - koniec');
    Znak := UpCase(ReadKey);
    if znak in ['U', 'L', 'P'] then
    begin
      repeat
        write ('Podaj liczbe z zakresu (1..255): ');
        readln (Liczba);
      until Liczba>0;
      if Znak = 'L' then
        UstawZLewej (Liczba)
      else if Znak = 'P' then
        UstawZPrawej (Liczba)
      else
        Usun (Liczba);
    end;
    if ((Znak='L') or (Znak='P')) then
    begin
      write ('Nowa kolejka: ');
      WypiszListeZLewej; write (' - od tylu: '); WypiszListeZPrawej;
      writeln; writeln ('Wcisnij Enter');
      readln;
    end;
  until (Znak = 'K');
end.