PASCAL - CONTOH PROGRAM MENGGUNAKAN STACK

Listing Program :

program tigastack;
uses crt;
type tumpukan = record
        isi : array[1..25] of byte;
        top : 0..25;
     end;
var t1,t2,t3 : tumpukan;
    x,n,angka,bantu : byte;
procedure tumpuk(var t : tumpukan;angka : byte);
begin
     inc(t.top);
     t.isi[t.top] := angka;
end;
procedure keluarkan(var t : tumpukan;var angka : byte);
begin
     angka := t.isi[t.top];
     dec(t.top);
end;
{procedure atur(var t : tumpukan; angka : byte);
begin
     repeat
          keluarkan(t,bantu);
          tumpuk(t3,bantu);
     until (t.isi[t.top] > angka) or (t.top = 0);
     tumpuk(t,angka);
     repeat
           keluarkan(t3,bantu);
           tumpuk(t,bantu);
     until t3.top = 0;
end;          }
procedure cetak(t : tumpukan);
begin
     repeat
          keluarkan(t,angka);
          write(angka:3);
     until t.top = 0;
end;
begin
     t1.top := 0; t2.top := 0; t3.top := 0;
     repeat
           clrscr;
           writeln('PROGRAM APLIKASI STACK(tumpukan data)':50);
           write('Banyaknya angka acak ?? [5 sampai 25] : ');readln(n);
     until n in[5..25];
     for x := 1 to n do
     begin
          write('Angka ke ',x,' : ');readln(angka);
          if angka mod 2 = 0 then
             tumpuk(t1,angka)
          else
              tumpuk(t2,angka);
     end;
     repeat
           keluarkan(t1,angka);
           if t3.top = 0 then
              tumpuk(t3,angka)
           else
           begin
                if angka > t3.isi[t3.top] then
                   tumpuk(t3,angka)
                else
                begin
                     repeat
                           keluarkan(t3,bantu);
                           tumpuk(t2,bantu);
                     until (t3.isi[t3.top] < angka) or (t3.top = 0);
                     tumpuk(t3,angka);
                     repeat
                           keluarkan(t2,bantu);
                           tumpuk(t3,bantu);
                     until t2.isi[t2.top] mod 2 = 1;
                end;
           end;
     until t1.top=0;
     repeat
           keluarkan(t3,angka);
           tumpuk(t1,angka);
     until t3.top = 0;
     writeln;
     write('Angka genap  = ');
     if t1.top = 0 then
        write('Tidak ada angka genap !')
     else
         cetak(t1);
     writeln;
     write('Angka ganjil = ');
     if t2.top = 0 then
        write('Tidak ada angka ganjil !')
     else
         cetak(t2);
     readkey;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.