Sabtu, 23 Mei 2015

pascal program singel Linked List

program singellinkedlist;
uses crt;
type
 pointer=^typedata;
 typedata=record
  nama :string;
  berikutnya: pointer;
  end;
var list, akhir :pointer;

procedure masuk_depan(var L :pointer; X:string);
var baru: pointer;
begin
new (baru);
baru^.nama :=X;
baru^.berikutnya :=nil;
 if L = nil then
  begin
  L:= baru ;
  akhir:=baru;
  end
  else
 begin
 baru^.berikutnya :=L;
 L :=baru;
 end;
 end;

procedure sisip_tengah (var L :pointer; X, Y:string);
var baru,bantu :pointer;
begin
bantu :=L;
while bantu^.berikutnya <> nil do
 begin
 if bantu^.nama = y then
 begin
 new (baru);
 baru^.nama:=x;
 baru^.berikutnya := bantu^.berikutnya;
 bantu^.berikutnya := baru;
 end;
 bantu :=bantu^.berikutnya;
 end;
 end;

 procedure masuk_belakang (var L : pointer; X : string);
 var
 baru,bantu : pointer;
 begin
 new (baru);
 baru^.nama := X;
 baru^.berikutnya :=nil;
 bantu :=L;
 while bantu^.berikutnya <> nil do
    bantu := bantu^.berikutnya;
 bantu^.berikutnya :=baru;
 {akhir^.next:=baru;
 akhir:=baru;akhir^.next:=nil;}
 end;

 procedure hapus_depan(var L:pointer);
 var
 bantu : pointer;
 begin
 bantu :=L;
 if L = nil then writeln ('list kosong...')
 else
 begin
 L:= L^.berikutnya;
 dispose(bantu);
 end;
 end;

 procedure hapus_tengah (var L: pointer; X:string);
 var
 bantu,hapus :pointer;
 begin
 bantu :=L;
 if L = nil then writeln ('list kosong..')
 else
 begin
 bantu :=L;
 new(hapus);
 while bantu^.berikutnya <> nil do
 begin
 if bantu^.berikutnya^.nama =  X then
 begin
  hapus :=bantu^.berikutnya;
  bantu^.berikutnya :=hapus^.berikutnya;
  dispose (hapus);
  end
  else
  bantu:=bantu^.berikutnya;
  end;
  end;
  end;

  procedure hapus_belakang (var L: pointer);
  var
  baru,bantu : pointer;
  begin
  bantu:= L;
  if bantu = nil then writeln ('list kosong...')
  else
  begin
  while bantu^.berikutnya^.berikutnya <> nil do
   bantu :=bantu^.berikutnya;
   new(baru);
   baru := bantu^.berikutnya;
   bantu^.berikutnya :=nil;
   dispose (baru)
   end;
   end;

   procedure cetak (L : pointer);
   var
   bantu: pointer;
   begin
   bantu :=L;
   while bantu <> nil do
   begin
    write (bantu^.nama, ' ');
    bantu:= bantu^.berikutnya;
    end;
    end;

  var
  namabaru,namasisip, namahapus :string;
  pil,n : integer;
  lagi: boolean;
  begin
  lagi:=true;
  new (list) ; list:= nil;
  while lagi do
  begin
  clrscr;
  writeln('1.Tambahkan Nama Depan');
  writeln('2.Tambahkan Nama Belakang');
  writeln('3.Sisipkan nama dimana pun yang anda mau');
  writeln('4.Cetak Data List');
  writeln('5.Hapus Nama Nepan');
  writeln('6.Hapus Nama Tengah');
  writeln('7.Hapus Nama Belakang');
  writeln('8.Exit Kalau Selesai');
  writeln('pilih ++> (1-8) '); readln (pil);
  case pil of
  1:begin
    writeln('masuk nama depan');
    writeln('masukan nama baru : ');readln (namabaru);
    masuk_depan (list, namabaru);
    end;
  2:begin
     writeln('masuk nama belakang');
    writeln('masukan nama baru : ');readln (namabaru);
    masuk_belakang (list, namabaru);
    end;
  3:begin
    writeln('sisipkan nama');
    write('masukan nama baru yang akan disisip : ');
    readln (namabaru);
    write('disisip setelah nama  :  ') ;readln (namasisip);
    sisip_tengah (list,namabaru,namasisip);
    end;
  4:cetak(list);
  5:begin
    writeln('hapus nama depan');
    hapus_depan (list);
    cetak (list);
    writeln;
    end;
  6:begin
    writeln('hapus nama tengah');
    write('masukan nama yang akan dihapus :  ');
    readln (namahapus);
    hapus_tengah (list,namahapus);
    cetak(list);
    end;
  7: begin
    writeln('hapus nama belakang');
    hapus_belakang (list);
    cetak (list);
    writeln;
    end;
  8: begin
  writeln ('terimakasih');
  lagi :=false
  end;
  end;
  readln;
  end;
  end.

Tidak ada komentar:

Posting Komentar