program Antrian_tiker;
uses wincrt;
const max = 5;
type data = array[1..max]
of string;
antri = record
isi : data;
depan,blk : integer;
end;
type simpul=^data2;
data2=record
berkas : string;
nilai : real;
berikutnya : simpul;
jumlah : real;
end;
label ngka;
var queue,q : antri;
nama,berkas_hapus, berkas_cari : string;
pil,pil2: char;
i,n : integer;
tumpuk,awal,akhir:simpul;
nama_ambil:string;
procedure kepala;
begin
clrscr;
writeln(' PROGRAM PENJUALAN TIKET');
writeln(' BIOSKOP CINEMA 21');
writeln(' YOGYAKARTA');
WRITELN('========================================================');
writeln;
end;
procedure kaki;
begin
WRITELN('========================================================');
end;
{PERANGKAT ANTRIAN MULAI
DISINI}
procedure tambah_antri(var
q:antri; baru:string);
begin
if q.blk=5 then writeln('antrian penuh')
else
begin
q.blk := q.blk+1;
q.isi[q.blk]:= baru;
end;
end;
procedure namaambil(var
q:antri);
begin
if q.blk=0 then writeln('antrian kosong')
else
begin
nama_ambil:=q.isi[q.depan];
for i := 1 to q.blk-1 do
q.isi[i]:=q.isi[i+1];
q.blk:=q.blk-1;
end;
end;
procedure cetak(q: antri);
var awal : real;
begin
clrscr;
if q.blk=0 then
writeln('Antrian Kosong....!!!')
else
begin
writeln('Daftar antrian
Pendaftaran');
writeln;
for i:= 1 to q.blk do
writeln('Antrian ke ',i,' adalah :
':5,q.isi[i],' ');
end;
readln;
end;
{AKHIR QUEUE}
{STACK MULAI DARI SINI}
procedure tambah_stack(var
tumpuk:simpul);
begin
if awal = nil then
begin
tumpuk^.berikutnya:=nil;
awal:=tumpuk;
akhir:=tumpuk;
end
else
begin
akhir^.berikutnya:=tumpuk;
tumpuk^.berikutnya:=nil;
akhir:=tumpuk;
end;
end;
{CETAK STACK}
procedure
cetak_tumpukan(var tumpuk:simpul);
begin
clrscr;
kepala;
tumpuk^.jumlah :=(tumpuk^.nilai*15000);
writeln('Nama-nama yang telah melakukan
pendaftaran :');
writeln('=====================================================');
writeln('| NO | NAMA
| JUMLAH TIKET | HARGA TIKET |');
writeln('======================================================');
begin
n:=1;
tumpuk:=awal;
writeln('| ',n,' | ',tumpuk^.berkas:10,'|
',tumpuk^.nilai:0:0,' |',tumpuk^.jumlah:0:0,' |');
while tumpuk^.berikutnya<>nil do
begin
tumpuk:=tumpuk^.berikutnya;
n:=n+1;
writeln('| ',n,' |
',tumpuk^.berkas:10,'| ',tumpuk^.nilai:0:0,' |',tumpuk^.jumlah:0:0,' |');
end;
writeln('======================================================');
writeln('Tekan ENTER untuk meberikutnyakan....');
readln;
end;
end;
{PROSEDUR HAPUS STACK}
procedure
hapus_tumpukan(var awal,akhir : simpul; x: string);
var
antri,hapus : simpul;
begin
clrscr;
if awal^.berkas = x then
begin
hapus:=awal;
awal:=hapus^.berikutnya;
dispose(hapus); {untuk menghapus}
writeln('Pendaftar telah di hapus..!!');
end
else
begin
antri:=awal;
while (x <> antri^.berikutnya^.berkas) and
(antri^.berikutnya<>nil) do
antri:=antri^.berikutnya;
hapus:=antri^.berikutnya;
if hapus<>nil then
begin
if hapus <> akhir then
antri^.berikutnya:=hapus^.berikutnya
else
begin
akhir:=antri;
akhir^.berikutnya:=nil;
end;
dispose(hapus); {perintah untuk menghapus}
writeln('Pendaftar telah di
hapus..!!');
end
else
begin
writeln('Data Tidak ada');
readln;
end;
end;
end;
{PROSEDUR CARI STACK}
procedure
cari_tumpukan(var awal,akhir : simpul; x: string);
var antri,cari : simpul;
begin
clrscr;
if awal^.berkas = x then
begin
cari:=awal;
awal:=cari^.berikutnya;
writeln('Data ',x,' ditemukan..!!');
end
else
begin
antri:=awal;
while (x <> antri^.berikutnya^.berkas) and
(antri^.berikutnya<>nil) do
antri:=antri^.berikutnya;
cari:=antri^.berikutnya;
if cari<>nil then
begin
if cari <> akhir then
antri^.berikutnya:=cari^.berikutnya
else
begin
akhir:=antri;
akhir^.berikutnya:=nil;
end;
writeln('Pendaftar ',x,' di
temukan..!!');
end
else
begin
writeln('Data Tidak ada...!');
readln;
end;
end;
end;
{prosedur mengurutkan atau
sorting}
procedure
sorting(awal,akhir,tumpuk:simpul);
var depan,belakang:simpul;
bantu:real;
bantu2:string;
begin
depan:=awal;
while not (depan=nil) do
begin
belakang:=depan^.berikutnya;
while not (belakang=nil) do
begin
if belakang^.nilai > depan^.nilai then
begin
bantu:=belakang^.nilai;
bantu2:=belakang^.berkas;
belakang^.nilai:=depan^.nilai;
belakang^.berkas:=depan^.berkas;
depan^.nilai:=bantu;
depan^.berkas:=bantu2;
end;
belakang:=belakang^.berikutnya;
end;
depan:=depan^.berikutnya;
end;
writeln('Tiket terbanyak : ',awal^.nilai:0:0,' dengan nama :
',awal^.berkas);
writeln('Tiket
terendah : ',tumpuk^.nilai:0:0,' dengan nama : ',tumpuk^.berkas);
writeln;
writeln('Tekan Enter untuk melanjutkan....');
end;
procedure tumpukan;
begin
repeat
clrscr;
kepala;
writeln('MENU DATA PENDAFTARAN');
writeln('----------------------');
writeln('1. Tambah Pendaftar');
writeln('2. Lihat data');
writeln('3. Cari pendaftar');
writeln('4. Hapus data sesuai nama');
writeln('5.
Sorting berdasarkan nilai');
writeln('6. Keluar');
kaki;
write('Pilihan anda : ');pil2:=readkey;
case pil2 of
'1' : begin
new(tumpuk);
writeln;
writeln('Tambah Data');
namaambil(q);
writeln('nama yang dilayani adalah :
',nama_ambil);tumpuk^.berkas:=nama_ambil;
write('Masukkan Jumlah Tiket:
');readln(tumpuk^.nilai);
tumpuk^.jumlah := (tumpuk^.nilai*15000);
tambah_stack(tumpuk);
readln;
end;
'2' : begin
if awal=nil then
begin
writeln('Belum ada
pendaftar...!!!');
readln;
end
else
begin
cetak_tumpukan(tumpuk);
readln;
end;
end;
'3' : begin
if awal=nil then
begin
writeln('Belum ada
pendaftar...!!!');
readln;
end
else
begin
write('Berkas yang akan di cari :
');readln(berkas_cari);
cari_tumpukan(awal,akhir,berkas_cari);
readln;
end;
end;
'4' : begin
if awal=nil then
begin
writeln('Belum ada
pendaftar...!!!');
readln;
end
else
begin
write('Berkas yang akan di hapus :
');readln(berkas_hapus);
hapus_tumpukan(awal,akhir,berkas_hapus);
readln;
end;
end;
'5' : begin
if awal=nil then
begin
writeln('Belum ada
pendaftar...!!!');
readln;
end
else
begin
sorting(awal,akhir,tumpuk);
readln;
end;
end;
end;
until (pil2='6');
writeln('Tekan Enter untuk keluar.... ');
end;
{PROCEDURE TUMPUKAN
BERAKHIR DI SINI}
{MENU UTAMA}
begin
ngka:
q.depan:=1;
q.blk:=0;
repeat
clrscr;
kepala;
writeln('1. Tambah Antrian');
writeln('2. Tampilkan Semua Antrian');
writeln('3. Layani Pendaftar');
writeln('4. Selesai');
kaki;
writeln;
write('Pilihan Anda [1/2/3/4] : ');
pil:=readkey;
clrscr;
case pil of
'1' : begin
if q.blk=max then
writeln('Antrian
Penuh......!!!!!')
else
begin
write('Nama Calon Pendaftar :
');read(nama);
tambah_antri(q,nama);
end;
readln;
end;
'2' : cetak(q);
'3' : begin
if q.blk=0 then
writeln('Tidak Ada Calon
Pendaftar....!!!')
else
tumpukan;
readln;
end;
end;
until pil='4';
writeln;
writeln;
writeln('-------------------------------------');
writeln(' TERIMA KASIH ');
writeln('======================================');
end.
No comments :
Post a Comment