Saturday, March 8, 2014

program pointer di pemrograman pascal

program pointer_antrian_pointer;
uses crt;
type antrian=^node;
node=record
isi:string[10];
next:antrian;
end;

var dpn,blk:antrian;
x :string;
pil :char;


{procedure untuk inisialisasi awal list}
procedure baru(x:string; var tunjuk:antrian);
begin
new(tunjuk);
tunjuk^.isi:=x;
tunjuk^.next:=nil;
end;

{procedure untuk membuat antrian baru}
procedure buatantrian (var depan,belakang:antrian);
var ask: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 depan=nil then
begin
depan :=tunjuk;
belakang:=tunjuk;
end
else begin
belakang^.next:=tunjuk;
belakang:=tunjuk;
end;
write('tambah data yang antri [Y/T]= ');readln(ask);
until upcase(ask)<>'Y';
end;

{procedure tambah 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);
if dpn=nil then
begin
dpn:=tunjuk;
belakang:=tunjuk;
end
else begin
belakang^.next:=tunjuk;
belakang:=tunjuk;
end;
end;

{procedure hapus depan/ambil antrian terdepan}
procedure hapusdpn (var depan,belakang:antrian);
var bantu:antrian;
begin
if depan=nil then writeln ('antrian kosong')
else if depan=belakang then
begin
depan:=nil;belakang:=nil
end
else
begin
bantu:=depan^.next;
depan:=bantu;
end;
end;

{procedure untuk mencetak isi antrian}
procedure cetak (depan:antrian);
var bantu:antrian;

begin
clrscr;
bantu:=depan;
if dpn=nil then writeln('antrian kosong')
else begin
repeat
writeln('  ',bantu^.isi,'  ');
bantu:=bantu^.next;
until bantu=nil;
writeln;
writeln;
end;
end;

begin
clrscr;

repeat
{menu utama}
 writeln;
writeln(' |    SIMULASI      |  ');
writeln(' |------------------|  ');
writeln('1. buat antrian baru   ');
writeln('2. cetak antrian       ');
writeln('3. tambah antrian      ');
writeln('4. layani antrian terdepan');
writeln('5. bengkel tutup       ');
write('pilihan anda : ');pil:=readkey;writeln(pil);
writeln;

case pil of
'1' : begin
buatantrian(dpn,blk);
writeln;
end;
'2':begin
cetak(dpn);
writeln;
end;
'3':begin
tambahantri(blk);
writeln;
writeln('setelah di tambah antrian menjadi : ');
cetak(dpn);
writeln;
end;
'4':begin
hapusdpn(dpn,blk);
writeln;
cetak(dpn);
writeln;
writeln;
end;
'5':begin
writeln('              SELESAI               ');
writeln('antrian dilayani hari berikutnya');
writeln;
end;
end;
until (pil='5');
end.