17/11/11

Program pascal linked list - stack

program stack;
uses crt;
const 
nmax = 4;
nmin = 0;
type
tipedata  = string;
stack     = record
L: array [nmin..nmax] of integer;
top : nmin..nmax;
end;
var
s              : stack;
data,a,x,y,z,r : byte;
pilihan        : byte;
jawaban,p      : char;

procedure inisialisasi(var s:stack);
begin
s.top :=nmin;
end;

procedure push (var s:stack; data:integer);
begin
if s.top = nmax then writeln ('stack sudah penuh')
else
begin
s.top     := s.top+1;
s.L[s.top]:= data;
end;
end;

procedure pop (var s:stack; data:integer);
begin
if s.top = nmin then writeln ('stack kosong')
else
begin
s.top := s.top-1;
end;
end;

procedure tampil (var s:stack; data:integer);
begin
for r :=s.top downto 1 do
begin
writeln ('data ke ',r,' didalam stack adalah : ',s.L[r]);
end;
end;

procedure hapus (var s:stack; data:integer);
begin
writeln;
writeln ('total isi dalam stack = ',s.L[s.top]);
if s.top = nmin then writeln('stack masih kosong')
else
begin
s.top:= 0;
end;
end;

BEGIN
clrscr;
repeat
writeln('############ MENU UTAMA ############');
writeln('## 1. PUSH                        ##');
writeln('## 2. POP                         ##');
writeln('## 3. HAPUS SEMUA DATA            ##');
writeln('####################################');
writeln('pilih salah satu [1/2/3]');read(pilihan);
clrscr;

case pilihan of
1:begin
writeln('Masukan Banyak data PUSH:');read(y);
for x:= 1 to y do
begin
writeln('Masukan Data PUSH ke',x,':');readln(data);
push(s,data);
writeln;
end;
writeln('data tersimpan berjumlah :',x,'data');
end;
2:begin
writeln('Masukan Banyak data di POP:');read(x);
for a:=1 to x do
begin
writeln('proses menghapus data di stack ke ',a);
pop(s,data);readln;
end;
writeln('data sekarang');
end;
3:begin
writeln('Anda akan menghapus seluruh stack [Y/N]:');read(p);
if p = 'N' then writeln ('Stack tidak jadi di hapus')
else
begin
writeln('data stack terhapus');
hapus(s,data);readln;
end;
end;
end;
tampil(s,data);
writeln;
writeln('Kembali ke MENU UTAMA [Y/N]:');read(jawaban);
clrscr;
until jawaban='N';
readkey;
end.

7 komentar: