program antrian

Rabu, 09 Februari 2011 uses wincrt;

const max = 20;
type elemen = array[1..max] of char;
typequeue = record
isi : elemen;
depan,blk : integer;
end;

label ulang;
var
queue,q : typequeue;
d,jawab : char;
pil : integer;
selesai : boolean;

procedure buatQ(var q : typequeue);
begin
q.depan := max;
q.blk := max;
end;

function qkosong(q:typequeue):boolean;
begin
qkosong:= (q.depan = q.blk);
end;

function Qpenuh(q:typequeue):boolean;
var
next : integer;
begin
if q.blk = max then next:=1
else
next := q.blk + 1;
qpenuh := (next=q.depan);
end;

procedure Enqueue(var q:typequeue; e:char);
begin
if not(qpenuh(q)) then
begin
if q.blk = max then q.blk :=1
else q.blk := q.blk+1;
q.isi[q.blk]:= e;
end;
end;

procedure Dequeue(var q:typequeue; var ed:char);
begin
if not(qkosong(q)) then
begin
if q.depan = max then q.depan :=1
else q.depan := q.depan+1;
ed := q.isi[q.depan];
end;
end;

procedure tampil(q: typequeue);

var i,awal : integer;
begin
CLRSCR;
writeln('---------------');
writeln('Antrian Ke Data');
if q.depan = max then awal :=1
else awal := q.depan +1;
for i:=awal to q.blk do
writeln(i:3,' ':5,q.isi[i],' ');
writeln('---------------');
end;
procedure menu;
begin
clrscr;
writeln(' MENU');
writeln;
writeln;
writeln('(1) Tambah Data');
writeln('(2) Ambil Data');
writeln('(3) Tampil Data');
writeln('(0) Exit');
writeln;
end;
begin
ulang:
buatQ(q);
repeat
menu;
write('Masukkan pilihan (0-3) : '); readln(pil);
CLRSCR;
case pil of
1 : begin
if Qpenuh(q)= false then
begin
write('Masukkan Nomor ke dalam antrian : ');
readln(d);
Enqueue(q,d);
TAMPIL(Q);
end else
writeln('Antrian sudah penuh silahkan ambil keluarkan pada posisi paling depan');
end;
2 : begin
if qkosong(q)= false then
begin
Dequeue(q,d);
tampil(q);
end
else writeln('Antrian dalam kondisi kosong');
end;
3 : tampil(q);
0 : selesai := true;
end;

writeln;
write('Enter untuk kembali');
readln;
until selesai;
clrscr;
writeln;
write('Anda akan mencoba lagi [Y/T] : '); readln(jawab);
if upcase(jawab) = 'Y' then goto ulang;
clrscr;
writeln(' END');
end.