sumber: :http://pascalsourcecode.co.cc/
=======================================================================
program antrian_SPMB;
uses wincrt;
type antrian = ^node;
node = record
isi : string[10];
next : antrian;
end;
var dpn, blk : antrian;
pointer : string;
x : string;
cr : string;
pil :char;
{============================================================}
{Procedure identitas: untuk menampilkan identitas kita}
procedure identitas;
begin
writeln('+-----------------------------------+');
writeln('+ Nama : FARHAN +');
writeln('+ NIM : 41090812 +');
writeln('+ Program Antrian Pendaftaran SPMB +');
writeln('+-----------------------------------+');
end;
{============================================================}
{procedure baru digunakan untuk inisialisasi awal list}
Procedure baru(x: string; var tunjuk: antrian) ;
begin
new(tunjuk);
tunjuk^.isi := x;
tunjuk^.next := nil;
end;
{============================================================}
{function isempty digunakan untu mengecek apakah suatu list kosong atau tidak}
function isempty(depan,belakang:antrian):boolean;
begin
isempty:= (depan=nil) and (belakang=nil)=true
end;
{============================================================}
{Fucntion cari digunakan untuk mencari mengecek apakah seseorang ada pada antrian atau tidak}
Function cari(x: string; depan:antrian) : boolean;
var tunjuk : antrian;
ada,kosong: boolean;
begin
ada := false; tunjuk := depan;
kosong:= isempty(dpn,blk);
if kosong=false then begin
while (tunjuk <> nil) and (ada=false) do
if tunjuk^.isi = x then
ada := true
else
tunjuk := tunjuk^.next;
end;
cari:=ada;
end;
{============================================================}
{procedure tambahantri digunakan untuk menambakan jumlah orang dalam antrian}
procedure tambahantri(var belakang:antrian);
var x:string;
tunjuk:antrian;
begin
write('Masukan nama orang yang mau masuk antrian : ');
readln(x);
baru(x,tunjuk);
belakang^.next:=tunjuk;
belakang:=tunjuk;
end;
{============================================================}
{prosedure hapusdpn diguakan untuk menghapus list dalam antrian}
procedure hapusdpn(var depan,belakang:antrian);
var bantu:antrian;
begin
if isempty(depan,belakang) then
writeln('Antrian Kosong')
else if depan=belakang then
begin
depan:=nil;belakang:=nil
end
else
begin
bantu:=depan^.next;
depan:=bantu;
end;
end;
{============================================================}
{prosedure slesaiantri digunakan untuk mengambil orang yang telah selesai antri}
procedure slesaiantri(var depan,belakang:antrian;var
x:string);
begin
if dpn=nil then
x:='Antrian Kosong'
else
begin
x:=dpn^.isi;
hapusdpn(depan,belakang);
end;
end;
{============================================================}
{procedure hapusx digunakan utk mengambil seseorang dari antrian}
{sebagai contoh ketika seseorang ingin ketoilet atau capek setelah lama mengantri
maka iya meninggalkan antrian}
procedure hapusx(var depan,belakang:antrian);
var bantu,hapus:antrian;
ada:boolean;
y:string;
begin
write('Masukan nama orang yang mau meninggalkan antrian : ');
readln(y);
if isempty(depan,belakang) then
writeln('Antrian Kosong')
else if depan=belakang then
begin
depan:=nil;belakang:=nil
end
else
begin
bantu:=depan;
hapus:=depan;
ada:=false;
while (bantu<>nil) do begin
if bantu^.isi=y then
if bantu=depan then
depan:=bantu^.next
else
hapus^.next:=bantu^.next;
hapus:=bantu;
bantu:=bantu^.next;
end;
end;
end;
{============================================================}
{ Procedure BuatAntrian untuk membangun antrian dengan input data secara interaktif}
procedure buatantrian (var depan,belakang: antrian);
Var c : char; tunjuk : antrian;i:integer;
begin
i:=0;
depan := nil; belakang := nil;
repeat
i:=i+1;
write('masukan nama ke-',i,' =');readln(x);
baru(x,tunjuk);
if isempty(depan,belakang) then
begin
depan := tunjuk ;
belakang := tunjuk;
end
else begin
belakang^.next := tunjuk;
belakang :=tunjuk;
end;
repeat
write('tambah data yang antri [Y/T] = ');
readln(c);
until c in ['T','t','y','Y'];
until c in ['T','t'];
end;
{============================================================}
{procedure sisiptengah digunakan untuk memasukkan seseorang yang menyerobot antrian}
procedure sisiptengah(var depan,belakang: antrian);
var baru,bantu : antrian;
x,y : string;
begin
write('Masukan nama orang yang menyerobot : ');readln(y);
write('menyerobot dibelakang ( masukan salah satu nama yang telah antri) : ');readln(x);
bantu:=depan;
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 Cetak untuk mencetak isi Antrian,pintu keluar antrian disebelah kanan dan
pintu masu antrian disebelah kiri}
procedure cetak(depan:antrian;var output:string);
var bantu:antrian;y:string;
begin
bantu:=depan;
output:=' Loket Pendaftaran';
if isempty(dpn,blk) then output:='Antrian Kosong'
else begin
while bantu<>nil do
begin
y:=bantu^.isi;
output:=y+'->>'+output;
bantu:=bantu^.next;
end;
output:='pintu masuk antrian ->>'+output;
end;
end;
{============================================================}
begin
screensize.y:=300;
identitas;
writeln;
writeln('=====================================');
writeln(' Antrian Awal Pendaftar SPMB ');
writeln('Masukan data orang yang telah antri: ');
writeln('=====================================');
writeln;
buatantrian(dpn,blk);
repeat
repeat
{menu utama}
writeln;
writeln;
writeln(' Simulasi: ');
writeln(' ANTRIAN PENDAFTARAN SPMB ');
writeln('-----------------------------------');
writeln('[1] Buat Antrian Baru ');
writeln('[2] Cetak Antrian ');
writeln('[3] Tambah Antrian Pendaftar ');
writeln('[4] Ambil Orang yang selesai daftar');
writeln('[5] Cari Seseorang dalam Antrian ');
writeln('[6] Seseorang meninggalkan antrian ');
writeln('[7] Seseorang menyerobot antrian ');
writeln('[8] Loket Pendaftaran ditutup ');
writeln('-----------------------------------');
write('Pilihan anda : ');pil:=readkey;writeln(pil);
writeln;
until (pil>='1') and (pil<='8');
{case pil of mengacu pada menu pilihan yang akan mengaktifkan salah satu procedure
yang dipilih}
case pil of
'1' :begin
buatantrian(dpn,blk);
writeln;
writeln;
writeln;
end;
'2' :begin
cetak(dpn,pointer);
writeln(pointer);
writeln;
writeln;
writeln;
end;
'3' :begin
tambahantri(blk);
writeln;
writeln('setelah ditambah antrian menjadi : ');
cetak(dpn,pointer);
writeln(pointer);
writeln;
writeln;
writeln;
end;
'4' :begin
slesaiantri(dpn,blk,x);
writeln('',x,' Telah selesai mendaftar,maka ia keluar dari antrian');
writeln;
writeln('Antrian menjadi :');
cetak(dpn,pointer);
writeln(pointer);
writeln;
writeln;
writeln;
end;
'5' :begin
write('Masukan nama orang yang di cari : ');readln(cr);
if cari(cr,dpn)=true then
writeln('',cr,' ada dalam antrian')
else
writeln('',cr,' tidak ada dalam antrian');
writeln;
writeln;
writeln;
end;
'6' :begin
if not isempty(dpn,blk) then
begin
writeln('antrian awal');
cetak(dpn,pointer);
writeln(pointer);
hapusx(dpn,blk);
writeln('Antrian Menjadi : ');
cetak(dpn,pointer);
writeln(pointer);
writeln;
writeln;
writeln;
end
else
writeln('Antrian Kosong');
end;
'7' :begin
writeln('Angtrian sebelum ada yang menyerobot');
cetak(dpn,pointer);
writeln(pointer);
writeln;
sisiptengah(dpn,blk);
writeln;
writeln('Setelah ada yang menyerobot antrian menjadi :');
cetak(dpn,pointer);
writeln(pointer);
writeln;
writeln;
writeln;
end;
'8' :begin
writeln(' Loket telah ditutup ');
writeln('Antrian dilanjutkan hari berikutnya');
exit;
end;
end;
until (pil='8');
end.
end.
Gan, pas mau milih dia ga jalan...var dari char utk pilihnya msalah bukan gan?
ReplyDelete