Jumat, 22 November 2013
uses wincrt;
const max=10;
type
stack=record
judul:array[1..max] of string;
harga:array[1..max] of longint;
atas:0..max;
end;
type
jualbuku=record
juduljual:string;
hargajual:word;
end;
larik_jual=array[1..20] of jualbuku;
var
buku,sp:stack;
jual:larik_jual;
judulmasuk,judulkeluar:string;
hargamasuk,hargakeluar:longint;
pil:1..8;
lagi,ketemu:boolean;
terjual,i,n,cacah:byte;hasil:real;
function
kosong(s:stack):boolean;
begin
if s.atas=0 then
kosong:=true else kosong:=false;
end;
function
penuh(s:stack):boolean;
begin
if s.atas=max
then penuh:=true else penuh:=false;
end;
procedure
push(var s:stack;j:string;h:longint);
begin
if penuh(s) then
writeln('Maaf stack sudah penuh')
else
begin
inc(s.atas);
s.judul[s.atas]:=j;s.harga[s.atas]:=h;
end;
end;
procedure
pop(var s:stack);
begin
if kosong(s)
then writeln('Buku sudah habis')
else
begin
judulkeluar:=s.judul[s.atas];hargakeluar:=s.harga[s.atas];
writeln('Terjual
buku ',judulkeluar,' seharga Rp ',hargakeluar);
inc(terjual);hasil:=hasil+hargakeluar;
dec(s.atas);
end;
end;
procedure
cetak(var s:stack);
var i:byte;
begin
if kosong(s)
then writeln('tumpukan kosong') else
begin
writeln('DAFTAR
BUKU DITUMPUKAN');
writeln('------------------------------------------');
for i:=s.atas
downto 1 do
writeln('posisi
',i,' dengan judul ',s.judul[i]:10);
writeln('------------------------------------------');
end;end;
procedure
cetakjual(var x:larik_jual);
var hasil:real;
begin
writeln('-----------------------------------------');
writeln('No Judul Harga');
writeln('-----------------------------------------');
for i:=1 to n do
begin
writeln(i:2,' ',x[i].juduljual:15,' Rp ',x[i].hargajual:8);
hasil:=hasil+x[i].hargajual;
end;
writeln('-----------------------------------------');
writeln('-----------------------total--Rp
',hasil:10:2);
end;
procedure
caribuku(var s:stack);
var
ketemu:boolean;
i,posisi:byte;
ulang:char;
cari:string;
begin
if kosong(s)
then writeln('Buku sedang kosong') else
begin
ulang:='y';
while ulang='y'
do
begin
ketemu:=false;
write('Masukkan judul buku yang dicari
==> ');readln(cari);
for i:=1 to s.atas do
begin
if s.judul[i]=cari then
begin ketemu:=true;posisi:=i;end;
end;
if ketemu then
writeln('Judul ',cari,' ada di posisi ke ',posisi) else
writeln('Maaf
judul ',cari,' tidak ditemukan');
writeln;
write('Mau cari
judul lain? <y/t> ');readln(ulang);
end;
end;
end;
procedure
ambilbuku(var s:stack);
var posisi,k:byte;
cari:string;
begin
ketemu:=false;sp.atas:=0;
write('Apa judul
yang ingin diambil ');readln(cari);
for i:=s.atas
downto 1 do
begin
if(s.judul[i]=cari) then
begin ketemu:=true;posisi:=i;end;
end;
if ketemu then
begin
for k:=s.atas downto posisi+1 do
begin
inc(sp.atas);
sp.judul[sp.atas]:=s.judul[k];
sp.harga[sp.atas]:=s.harga[k];
end;
s.atas:=posisi;
judulkeluar:=s.judul[s.atas];
hargakeluar:=s.harga[s.atas];
dec(s.atas);
for k:=sp.atas downto 1 do
begin
inc(s.atas);
s.judul[s.atas]:=sp.judul[k];
s.harga[s.atas]:=sp.harga[k];
end;
end
else
writeln('Buku tidak ditemukan');
end;
{program utama}
begin
lagi:=true;
while lagi do
begin
clrscr;
writeln('1.
Menambah buku ke tumpukan');
writeln('2.
Mengambil buku dari tumpukan dan layani penjualan');
writeln('3.
Mencari buku');
writeln('4.
Mencetak daftar buku di tumpukan');
writeln('5. Cek
buku terjual');
writeln('6.
Mengambil buku tertentu');
writeln('7.
Mencetak buku terjual');
writeln('8.
Tutup toko dan cetak hasil penjualan');
writeln;write('pilihan
anda <1-6> ==> ');readln(pil);
case pil of
1:begin
write('Judul buku baru ==>
');readln(judulmasuk);
write('Harganya ==> ');readln(hargamasuk);
push(buku,judulmasuk,hargamasuk);
end;
2:begin
if not kosong(buku) then
begin
pop(buku);
inc(cacah);
hasil:=hasil+hargakeluar;
inc(n);
jual[n].juduljual:=judulkeluar;
jual[n].hargajual:=hargakeluar;
end
else writeln('Buku dalam tumpukan habis');
end;
3:caribuku(buku);
4:cetak(buku);
5:begin
inc(terjual);
writeln('Sudah terjual sebanyak
',terjual,' buku');
writeln('Pendapatan sekarang Rp
',hasil:8:2);
writeln('Sisa buku ditumpukan
',buku.atas,' buku');
end;
6:begin
if not kosong(buku) then ambilbuku(buku)
else writeln('Buku habis');
if ketemu and not kosong(buku) then
begin
writeln('Buku yang diambil adalah
',judulkeluar);
writeln('Harganya Rp ',hargakeluar);
inc(cacah);
hasil:=hasil+hargakeluar;
inc(n);
jual[n].juduljual:=judulkeluar;
jual[n].hargajual:=hargakeluar;
end;
end;
7:cetakjual(jual);
8:begin
inc(terjual);
writeln('total terjual sebanyak
',terjual,' buku');
writeln('pendapatan total Rp
',hasil:8:2);
writeln('Sisa buku di tumpukan
',buku.atas,' buku');
lagi:=false;
writeln;
writeln('Terimakasih');
end;
end;
readln;
end;
end.
