Program TLQueue

Program Queue;
Uses Wincrt;
Type antrian = ^node; {Program QUEUE menggunakan Record}
node = Record
isi : String[10];
next : antrian; End;
Var dpn, blk, baru : antrian;
x,y : String[10];
i : integer;

Function IsEmpty: boolean; {Fungsi digunakan untuk menge-cek apakah antrian kosong ato tidak}
Begin {Meng-cek apakah node Depan dan Belakang Kosong atau tidak??}
IsEmpty := (dpn=nil) and (blk=nil);
End;

Procedure Cetak; {Cetak Antrian secara FIFO(First In First Out)}
Var bantu : antrian;
Begin
writeln; write(' Hasil Cetak Data = ');
If not(IsEmpty) then {Cek dulu apakah kosong atau tidak}
Begin
bantu := dpn; {Variabel bantu untuk tambahan, apabila bantu tidak kosong, maka diCETAK}
While bantu <> nil do {antrian maju dan diulangi sampai variabel bantu kosong isinya}
Begin
write(bantu^.isi:5);
bantu := bantu^.next;
End;
End
Else write('Antrian KOSONG, Tidak Ada Yang Bisa Dicetak !!');
writeln;
write(' ===================================================================== ');
End;

Procedure Buat; {Prosedur untuk membuat antrian/menambah antrian di belakang}
Var baru : antrian;
Begin
new(baru);
baru^.isi := x;
baru^.next := nil;
If IsEmpty then {Apabila Antrian kosong maka buat baru di antrian tersebut}
Begin {Jika tidak, maka buat baru setelah antrian tersebut}
dpn := baru;
blk := baru;
End
Else Begin
blk^.next := baru;
blk := baru;
End;
End;

Function Cari(x : String): boolean; {Fungsi pencarian data "X" di antrian}
Var ada : boolean; bantu : antrian;
Begin
ada := false;
bantu := dpn;
Repeat {Pengulangan cek pada tiap node apakah "x" ada di dalamnya?? Jika tidak maka lanjut ke node selanjutnya}
If (bantu^.isi = x) then ada := true {sampai ada=TRUE atau tidak ada sama sekali}
Else bantu := bantu^.next;
Until ada or (bantu = nil);
cari := ada;
End;

Procedure TambahBlk; {Tambah Belakang sebenarnya hanya menggunakan prosedur Buat}
Begin
writeln;
write('Masukkan Data Yang Akan Ditambahkan Dibelakang Data = '); readln(x);
Buat;
End;

Procedure AmbilDpn; {Prosedur mengambil depan untuk menjadi data "x"}
Var bantu : antrian;{Akan tetapi, tidak dilakukan apapun terhadap data ini??}
Begin
writeln;
write(' Elemen Terdepan Data Adalah = '); write(dpn^.isi);
write('Tekan ENTER utk Ambil Data Tersebut = '); readln;
baru := dpn;
If not(isEmpty) then
Begin
dpn := dpn^.next;
baru := nil;
End
Else write('antrian kosong');
End;

Procedure HapusDpn; {Prosedur untuk menhapus data terdepan}
Var bantu : antrian;
Begin
If not (isEmpty) then
Begin
dpn := dpn^.next;
If dpn=nil then blk := nil;
End
Else write('antrian kosong');
End;

Procedure HapusBlk; {Prosedur untuk menghapus data belakang}
Var bantu, baru : antrian;
Begin
bantu := dpn;
If not (isEmpty) then
Begin
While bantu^.next^.next <> nil do bantu := bantu^.next;
new(baru);
baru := bantu^.next;
bantu^.next := nil;
baru := nil;
End
Else write('antrian kosong');
End;

Procedure HapusX; {Prosedur untuk menghapus data "X"}
Var bantu, hapus : antrian;
Begin
bantu := dpn;
new(hapus);
If cari(x)=true then
Begin
hapus := bantu^.next;
bantu^.next := hapus^.next;
hapus := nil;
End
Else bantu := bantu^.next;
End;

Procedure SisipDpn; {Prosedur untuk Sisip Depan, tetapi belum berhasil sampai saat ini}
Var baru, bantu : antrian;
Begin
bantu := dpn;
While bantu^.next <> nil do
Begin
If bantu^.next^.isi = x then
Begin
new(baru);
baru^.isi := y;
baru^.next := bantu^.next;
bantu^.next := baru;
End;
bantu := bantu^.next;
End;
End;

Procedure SisipBlk; {Prosedur untuk Sisip BElakang, tetapi belum berhasil sampai saat ini}
Var bantu, baru : antrian;
Begin
bantu := dpn;
While bantu^.next <> nil do
Begin
If bantu^.isi=x then
Begin
new(baru);
baru^.isi := y;
baru^.next := bantu^.next;
bantu^.next := baru;
End;
bantu := bantu^.next;
End;
End;

Procedure Identitas; {Prosedur Identitas akan muncul pada program}
Begin
gotoXY(10, 1); write('Program "Q U E U E"');
gotoXY(10, 2); write('Muchamad Dachlan Zaim (M0507028)');
gotoXY(10, 3); write('Ilmu Komputer 2007');
gotoXY(10, 4); write('Tanggal 20 Mei 2008, 18.00 WIB');
gotoXY(6, 5); write('=====================================================================');
End;

Procedure Menu; {Prosedur untuk menampilkan semuanya, termasuk menu utama juga !!!}
Var pil,lagi : char;
Begin
clrscr;
Identitas;
Cetak;
gotoXY(30,10); write('"==== Modifikasi Data QUEUE ===="');
gotoXY(10,12); write('a. Input Awal');
gotoXY(10,13); write('b. Cari Data X');
gotoXY(10,14); write('c. Tambah Data di Belakang/ Enqueue');
gotoXY(10,15); write('d. Ambil Data Teratas dan Simpan di X');
gotoXY(10,16); write('e. Hapus Data Terdepan');
gotoXY(10,17); write('f. Hapus Data Belakang');
gotoXY(10,18); write('g. Hapus Data X');
gotoXY(10,19); write('h. Sisip Data di Depan');
gotoXY(10,20); write('i. Sisip Data di Belakang');
gotoXY(10,21); write('j. Keluar');

Repeat
gotoXY(40,23); Clreol; write('Pilihan anda (a-j) = '); readln(pil);

CASE upcase(pil) OF
'A' : Begin
lagi := 'Y';
clrscr;
gotoXY(10,5); write('=== Daftar Makanan "RestoRUN" ===');writeln;
While upcase(lagi)='Y' do
Begin
write(' Nama Makanan = '); readln(x);writeln;
buat;
repeat
write(' Ada lagi (Y/T) ? '); readln(lagi);writeln;
until upcase(lagi) in['Y','T']
End;
cetak; readln; menu;
End;
'B' : Begin
clrscr;
gotoXY(25,6); write('Makanan Apa Yang anda Cari = '); readln(x);
If not(isEmpty) then
Begin
cari(x);
If (cari(x)=true) then
Begin
gotoXY(25,10); write('Makanan "',x,'" Tersedia Dalam Daftar Makanan ');
End
Else Begin
gotoXY(25,10); write('Makanan "',x,'" Tidak Tersedia Di Daftar Makanan');
End;
End
Else write('antrian kosong');
cetak; readln; menu;
End;
'C' : Begin tambahblk; cetak; readln; menu; end;
'D' : Begin ambildpn; cetak; readln; menu; end;
'E' : Begin writeln; write('Tekan ENTER Untuk Hapus Depan... '); readln; hapusdpn; cetak; readln; menu;End;
'F' : Begin writeln; write('Tekan ENTER Untuk Hapus Belakang...'); readln; hapusblk; cetak; readln; menu;End;
'G' : Begin
write(' Data Yang Akan Dihapus = '); readln(x);
hapusX; cetak; readln; menu;
End;
'H' : Begin
write(' Data Yang Akan Disisipkan = '); readln(y); writeln;
write(' Disisip Didepan Data = '); readln(x);
If cari(x)=true then sisipdpn;
cetak; readln; menu;
End;
'I' : Begin
write(' Data Yang Akan Disisipkan = '); readln(y); writeln;
write(' Disisip Dibelakang Data = '); readln(x);
If cari(x)=true then sisipblk;
cetak; readln; menu;
End;
'J' : donewincrt;
End;
Until upcase(pil) in['A'..'J'];
End;


{----MAIN PROGRAM----}
Begin
screensize.x := 95;
screensize.y := 400;
menu;
End.{AKHIR PROGRAM UTAMA}