November 17, 2013
Berikut adalah contoh program stack dengan menggunakan free pascal :
program stack;
uses crt;
const max = 100;
var
L : array [1..max] of char;
sisa, i, j, top : integer;
jawab : char;
kondisi : string;
procedure inisiasi;
begin
top :=0;
end;
procedure CEK;
begin
sisa := max - top;
if top = max then
kondisi := 'penuh'
else
if ((top < max) and (top > 0)) then
kondisi := 'belum penuh'
else
kondisi := 'kosong'
end;
procedure PUSH;
begin
write('Masukan data : ');
readln(L[top+1]);
top := top + 1;
end;
procedure TAMPIL;
begin
writeln('Stack Yang Dihasilkan : ');
for i := top downto 1 do
begin
writeln(L[i]);
end;
end;
procedure POP;
begin
top := top - 1
end;
BEGIN
clrscr;
inisiasi;
jawab := 'Y';
while ((jawab = 'Y') or (jawab = 'y')) do
begin
writeln('PROGRAM STACK');
writeln('1. PUSH');
writeln('2. POP');
write('PILIH 1 ATAu 2 ? ');
readln(j);
case j of
1 : begin
CEK;
if kondisi = 'penuh' then
writeln('STACK PENUH, ANDA TIDAK BISA MENAMBAH TUMPUKAN')
else
begin
if kondisi <> 'penuh' then
begin
CEK;
writeln ('Stack ', kondisi, ', Masih Bisa Menampung : ', sisa, ' data');
write ('Apakah Anda mau Menambah Data ? (Y/T) ');
readln (jawab);
while (((jawab = 'Y') or (jawab = 'y')) and (kondisi <> 'penuh')) do
begin
PUSH;
writeln;
writeln;
CEK;
writeln;
writeln;
TAMPIL;
writeln;
writeln;
writeln ('Stack ', kondisi, 'Masih Bisa Menampung : ', sisa, ' data');
write ('Apakah Anda mau Menambah Data ? (Y/T) ');
readln (jawab);
end;
end
else
writeln ('STACK PENUH');
end;
end;
2 : begin
write ('Apakah Anda Yakin Mau Menghapus Data ? (Y/T) ');
readln (jawab);
while (((jawab = 'Y') or (jawab = 'y')) and (kondisi <> 'kosong')) do
begin
POP;
writeln;
writeln;
CEK;
writeln;
writeln;
TAMPIL;
writeln;
writeln;
writeln ('Stack Masih Bisa Dihapus : ', top, ' data');
write ('Apakah Anda Mau Menghapus Data ? (Y/T) ');
readln (jawab);
end;
if kondisi = 'kosong' then
writeln ('STACK KOSONG')
end;
end;
write ('Apakah Mau Kembali Ke Menu Utama ? (Y/T) ');
readln (jawab);
end;
END.
program stack;
uses crt;
const max = 100;
var
L : array [1..max] of char;
sisa, i, j, top : integer;
jawab : char;
kondisi : string;
procedure inisiasi;
begin
top :=0;
end;
procedure CEK;
begin
sisa := max - top;
if top = max then
kondisi := 'penuh'
else
if ((top < max) and (top > 0)) then
kondisi := 'belum penuh'
else
kondisi := 'kosong'
end;
procedure PUSH;
begin
write('Masukan data : ');
readln(L[top+1]);
top := top + 1;
end;
procedure TAMPIL;
begin
writeln('Stack Yang Dihasilkan : ');
for i := top downto 1 do
begin
writeln(L[i]);
end;
end;
procedure POP;
begin
top := top - 1
end;
BEGIN
clrscr;
inisiasi;
jawab := 'Y';
while ((jawab = 'Y') or (jawab = 'y')) do
begin
writeln('PROGRAM STACK');
writeln('1. PUSH');
writeln('2. POP');
write('PILIH 1 ATAu 2 ? ');
readln(j);
case j of
1 : begin
CEK;
if kondisi = 'penuh' then
writeln('STACK PENUH, ANDA TIDAK BISA MENAMBAH TUMPUKAN')
else
begin
if kondisi <> 'penuh' then
begin
CEK;
writeln ('Stack ', kondisi, ', Masih Bisa Menampung : ', sisa, ' data');
write ('Apakah Anda mau Menambah Data ? (Y/T) ');
readln (jawab);
while (((jawab = 'Y') or (jawab = 'y')) and (kondisi <> 'penuh')) do
begin
PUSH;
writeln;
writeln;
CEK;
writeln;
writeln;
TAMPIL;
writeln;
writeln;
writeln ('Stack ', kondisi, 'Masih Bisa Menampung : ', sisa, ' data');
write ('Apakah Anda mau Menambah Data ? (Y/T) ');
readln (jawab);
end;
end
else
writeln ('STACK PENUH');
end;
end;
2 : begin
write ('Apakah Anda Yakin Mau Menghapus Data ? (Y/T) ');
readln (jawab);
while (((jawab = 'Y') or (jawab = 'y')) and (kondisi <> 'kosong')) do
begin
POP;
writeln;
writeln;
CEK;
writeln;
writeln;
TAMPIL;
writeln;
writeln;
writeln ('Stack Masih Bisa Dihapus : ', top, ' data');
write ('Apakah Anda Mau Menghapus Data ? (Y/T) ');
readln (jawab);
end;
if kondisi = 'kosong' then
writeln ('STACK KOSONG')
end;
end;
write ('Apakah Mau Kembali Ke Menu Utama ? (Y/T) ');
readln (jawab);
end;
END.
Posting Komentar