program antrian (Queue)

{Judul Program}
program Antrian;
uses wincrt;
{Deklarasi}

const max=5; {konstanta}
type queue=record
elemen:array[1..max]of string;
head,tail,count:integer;
end;

var
Q:queue;
i:integer;
data:string;
temp:string;
jawab:char;

procedure Inisialisasi(var A:queue);
begin
A.head:=0;
A.tail:=0;
end;

function Empty:boolean;
begin
if Q.tail=0 then
Empty:=true
else
Empty:=false;
end;

function Full:boolean;
begin
if Q.tail=max then
Full:=true
else
Full:=false;
end;

procedure Enqueue(var A:queue; x:string);{prosedur untuk penambahan data}
begin
if Empty then
begin
A.head:=1;
A.tail:=1;
A.elemen[A.tail]:=x;
end
else if not Full then
begin
A.tail:=A.tail+1;
A.elemen[A.tail]:=x;
end
else
writeln('ANTRIAN SUDAH PENUH');
end;

function Dequeue(var A:queue):string; {prosedur untuk mengambil/menghapus data}
var
j:integer;
begin
if not Empty then
begin
Dequeue:=A.elemen[A.head];
for j:=A.head to (A.tail-1) do
begin
A.elemen[j]:=A.elemen[j+1];
end;
A.tail:=A.tail-1;
end;
end;

procedure Tampil(A:queue);
var
k:integer;
begin
if A.tail<>0 then
for k:=1 to A.tail do
writeln('Pasien ke-',k,' : ',A.elemen[k])
else
writeln('ANTRIAN KOSONG');
end;

{Program Utama}
begin
writeln('PROGRAM ANTRIAN PASIEN');
writeln('----------------------');
writeln;
Inisialisasi(Q);
for i:=1 to max do
begin
write('Entry Nama Pasien ke-',i,' : ');
readln(data);
Enqueue(Q,data);
end;
writeln;
writeln('PROSES...');
writeln;
Tampil(Q);
writeln;
jawab:='Y';
while ((jawab='Y') or (jawab='y')) AND (NOT Empty) do
begin
jawab:='T';
write('Ambil data Antrian Pasien [Y/T] : ');
readln(jawab);
if (jawab='Y') or (jawab='y') then
begin
temp:=Dequeue(Q);
Tampil(Q);
end;
writeln;
end;
end.