program antrian

program antrian; 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('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],' '); READLN; 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 karakter ke dalam antrian : '); readln(d); Enqueue(q,d); TAMPIL(Q); end else writeln('Antrian sudah penuh silahkan ambil keluarkan'); writeln('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.