Program Gabungan Push dan Pop

uses crt;

const garis ='---------------------------------------';

pesan ='Senarai Berantai Masih Kosong';

type simpul = ^data;

data   = record

nama : string;

alamat : string;

berikut : simpul;

end;

var

awal,akhir : simpul;

pilih : char;

cacah : integer;

function MENU : char;

var P : char;

begin

clrscr;

gotoxy(30,3); write('DAFTAR MENU PILIHAN');

gotoxy(20,5); write('1. MASUKKAN ANTRIAN');

gotoxy(20,7); write('2. ANTRIAN MASUK');

gotoxy(20,9); write('3. MENGHAPUS ANTRIAN DI TENGAH');

gotoxy(20,11); write('4. MENCETAK ISI ANTRIAN');

gotoxy(20,13); write('5. SELESAI');

repeat

gotoxy(48,20); write('':10);

gotoxy(30,20); write('Pilih salah satu: ');

P := upcase(readkey);

until P in ['1'..'5'];

MENU := P;

end;

function SIMPUL_BARU : simpul;

var

B : simpul;

begin

new(B);

with B^ do

begin

write('Nama  : '); readln(nama);

write('No. Antrian: '); readln(alamat);

berikut := nil;

end;

SIMPUL_BARU := B;

end;

 procedure TAMBAH_AWAL (N : integer);

var

baru : simpul;

begin

if N <> 0 then

begin

writeln('MENAMBAH SIMPUL BARU DI AWAL SENARAI BERANTAI');

writeln(copy(garis,1,45));

end;

writeln;

baru := SIMPUL_BARU;

if awal=nil then

awal:= baru

else

akhir^.berikut := baru;

akhir := baru;

end;

procedure HAPUS_PERTAMA;

begin

if awal <> nil then

begin

awal := awal^.berikut;

writeln('SIMPUL PERTAMA TELAH TERHAPUS');

end

else

writeln(pesan);

writeln; writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');

repeat until keypressed

end;

procedure HAPUS_TENGAH;

var posisi,i : integer;

bantu,bantu1 : simpul;

begin

if cacah=0 then

begin

writeln(pesan); writeln;

writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');

repeat until keypressed

end

else

begin

writeln('MENGHAPUS SIMPUL YANG ADA DI TENGAH');

writeln(copy(garis,1,35)); writeln;

writeln('SENARAI BERANTAI SEKARANG BERISI :',cacah:2,' SIMPUL');

repeat

gotoxy(37,5); write('':5);

gotoxy(1,5); write('Akan menghapus simpul nomor berapa: ');

readln(posisi);

until posisi in [1..cacah];

begin

bantu := awal;

for i:=1 to posisi-2 do

bantu:= bantu^.berikut;

bantu1 := bantu^.berikut;

bantu^.berikut := bantu1^.berikut;

bantu1^.berikut := nil;

dispose(bantu1);

end;

end;

end;

procedure BACA_SENARAI;

var bantu : simpul;

i     : integer;

begin

writeln('MEMBACA ISI SENARAI BERANTAI');

writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');

writeln(copy(garis,1,42)); writeln;

bantu := awal;

if bantu=nil then

writeln(pesan)

else

while bantu <> nil do

begin

writeln('Nama  : ',bantu^.nama);

writeln('No. Antrian: ',bantu^.alamat);

bantu := bantu^.berikut;

end;

repeat until keypressed

end;

{PROGRAM UTAMA}

begin

cacah := 0;

awal := nil;

repeat

pilih := MENU;

clrscr;

case pilih of

'1' : TAMBAH_AWAL(1);

'2' : HAPUS_PERTAMA;

'3' : HAPUS_TENGAH;

'4' : BACA_SENARAI;

end;

if pilih in ['1'] then inc(cacah)

else if (pilih in ['2','3']) and (cacah <> 0) then

dec(cacah)

until pilih='5'

end.