Membuat program stack dengan Pascal

Listing program :

uses crt;

const lowbound = 0;

      upbound  = 5;

 type pstack = ^stack;

     stack  = record

       info  : byte;

       x,y   : byte;

       next  : pstack;

     end;

     tumpukan = object

       cur,head,tail : pstack;

       counter,len   : byte;

       posx,posy     : byte;

       ada,isempty   : boolean; {ada = terbentuk}

       procedure inisialisasi;

       procedure menu;

       procedure keterangan;

       procedure create;

       procedure push;

       procedure pop;

     end;

procedure tumpukan.inisialisasi;

begin

     counter := 0; len := 20; posx := 40; posy := 24;

     ada := false; isempty := true;

end;

procedure tumpukan.keterangan;

var noel,top,i : byte;

begin

     noel := counter; if noel = 0 then isempty := true else isempty := false;

     gotoxy(2,15); write('Isempty :      '); gotoxy(12,15); write(isempty);

     gotoxy(2,16); write('Noel    : ',noel);

     gotoxy(2,17); write('Top     : ');

     if isempty then

     begin

          gotoxy(12,17); clreol;

     end

        else

     begin

          gotoxy(12,17); clreol;

          gotoxy(12,17); for i := 1 to cur^.info do write('-')

     end;

end;

procedure tumpukan.create;

var tekan : char;

begin

     if ada then

     begin

          gotoxy(2,12); write('Stack sudah terbentuk');

     end

        else

     begin

          new(cur); head := cur; tail := cur; tail^.next := nil;

          gotoxy(2,12); write('Stack terbentuk');

          ada := true;

     end;

     keterangan;

     gotoxy(2,13); write('Press Return to continue');

     repeat tekan := readkey until tekan = #13;

end;

procedure tumpukan.push;

var i : byte;

    tekan : char;

begin

     if not ada then

     begin

          gotoxy(2,12); write('Stack belum terbentuk');

          gotoxy(2,13); write('Press Return to continue');

          repeat tekan := readkey until tekan = #13;

     end

        else

     begin

          if counter = upbound then

          begin

               gotoxy(2,12); write('Stack Overflow');

               gotoxy(2,13); write('Press Return to continue');

               repeat tekan := readkey until tekan = #13;

          end

             else

          begin

               new(cur); cur^.next := head; head := cur;

               cur^.x := posx; cur^.y := posy; cur^.info := len;

               gotoxy(cur^.x,cur^.y); for i := 1 to cur^.info do write('-');

               if counter <> upbound then

               begin

                    inc(posx,2); dec(posy,2); dec(len,4);

               end;

               inc(counter);

          end;

          keterangan;

     end;

end;

procedure tumpukan.pop;

var i : byte;

    tekan : char;

begin

     if not ada then

     begin

          gotoxy(2,12); write('Stack belum terbentuk');

          gotoxy(2,13); write('Press Return to continue');

          repeat tekan := readkey until tekan = #13;

     end

        else

     begin

          if counter = lowbound then

          begin

               gotoxy(2,12); write('Stack Underflow');

               gotoxy(2,13); write('Press return to continue');

               repeat tekan := readkey until tekan = #13;

          end

             else

          begin

               gotoxy(cur^.x,cur^.y); for i := 1 to cur^.info do write(' ');

               if counter <> lowbound then

               begin

                    dec(posx,2); inc(posy,2); inc(len,4);

               end;

               dec(counter);

               head := cur^.next; dispose(cur); cur := head;

          end;

          keterangan;

     end;

end;

procedure tumpukan.menu;

var pil : char;

begin

     clrscr;

     gotoxy(2,2); write('-- STACK --');

     gotoxy(3,4); write('1. Create');

     gotoxy(3,5); write('2. Push');

     gotoxy(3,6); write('3. Pop');

     gotoxy(3,7); write('4. Exit');

     gotoxy(2,9); write('Pilihan : ');

     repeat

           gotoxy(2,12); clreol;

           gotoxy(2,13); clreol;

           gotoxy(12,9); {posisi kursor}

           repeat pil := readkey until pil in['1'..'4'];

           gotoxy(12,9); write(pil);

           case pil of

                  '1' : create;

                  '2' : push;

                  '3' : pop;

           end;

     until pil = '4';

end;

var akses : tumpukan;

begin

     with akses do

     begin

          inisialisasi;

          menu;

     end;

end.

outputnye bakal jadi kya begini :

Tampilan awal ketika progrm dijalankan.

 

 Output yang tampil ketika user memilih nomor 1. Maka terdapat informasi bahwa stack terbentuk.

 

Jika user memilih nomor 1 lagi, maka program akan memberitahu bahwa stack sudah terbentuk.

 

 Pilihan nomor 2 digunakan untuk mempush atau menambahkan elemen ke dalam suatu stack.

 Jumlah elemen yang dapat dimasukkan dalam stack ini adalah 5, jadi jika user memasukkan lebih dari 5 akan terdapat kesalahan overflow yaitu menambahkan elemen ketika stack sudah penuh.

  
Pilihan nomor 3 merupakan kebalikan dari pilihan nomor 2. Pada program pilihan ini yang dilakukan adalah pengurangan/pengeluaran elemen.

Kemudian jika user terus melakukan pengeluaran elemen tetapi stack sudah kosong maka akan terjadi kesalahan underflow.