DUzun's Web
Programare, proiecte personale, divertisment

{De la tastatura se citesc  numere intregi diferite de zero.

 Se cere sa se creeze doua liste, una a numerelor negative,

 iar alta - a numerelor pozitive}

Program Tema_2_3_Probl_5;

​

type Lista = ^Celula;

     Celula = record  {O celula din lista}

       Info: Integer; {Continutul celulei}

       Urm:  Lista;   {Adresa urmatoarei celule}

     end;

​

var L1, L2: Lista;   {L - baza listei}

​

procedure Citeste;

var R, P, Q: Lista;

    i: Integer;

begin

  new(L1); new(L2);

  P := L1; Q := L2; {P si Q indica ultima celula din lista, corespunzator}

  writeln('Scrie o lista de nr intregi nenule (0 termina citirea):');

  writeln;

  repeat

    new(R);           {Alocarea memoriei pentru o noua celula}

    readln(R^.Info);  {Popularea celulei cu informatie citita de la tastiera}

    if R^.Info > 0 then begin

      P^.Urm := R;     {Atasam celula R la lista L1}

      P := R;          {R este ultima celula din L1}

    end else

    if R^.Info < 0 then begin

      Q^.Urm := R;     {Atasam celula R la lista L2}

      Q := R;          {Trecerea la urmatoarea celula}

    end else

    begin {P^.Info = 0}

       Dispose(R); {Eliminam R}

       P^.Urm := nil;       {Marcam sfarsitul listei L1}

       Q^.Urm := nil;       {Marcam sfarsitul listei L2}

       {Prima celula din fiecare lista nu contine nimic, de aceea se elimina}

       R := L1^.Urm; Dispose(L1); L1 := R;

       R := L2^.Urm; Dispose(L2); L2 := R;

       Break;     {Listele au fost create}

    end;

  until false;

end;

​

procedure Scrie(var L: Lista);  {Afisarea listei}

var P: Lista;

begin

  P := L;  {Inceputul listei}

  while P <> nil do  {Pana nu se ajunge la sfarsitul listei}

    with P^ do begin

      Writeln(Info); {Afisarea informatiei din celula}

      P := Urm;      {Trecerea la urmatorul element}

    end;

end;

​

procedure Distruge(var L: Lista);  {Distrugerea listei}

var P: Lista;

begin

  while L <> nil do

    with L^ do begin

      P := Urm;   {Salvarea adresei celulei urmatoare}

      Dispose(L); {Eliberarea memoriei ocupate de celula curenta}

      L := P;     {Trecerea la urmatoarea celula}

    end;

end;

​

begin

  writeln;  writeln;

  Citeste;

​

  writeln('----------------------------------');

  writeln('Numerele pozitive:');

  Scrie(L1);

​

  writeln('----------------------------------');

  writeln('Numerele negative:');

  Scrie(L2);

​

  Distruge(L1);

  Distruge(L2);

​

  readln;

end.

​

​