Strukdat Program Double_Linked_list(PASCAL)

Program Data_Buku_Perpstakaan;
uses crt;
type
buku = record
             kode : string;
             judul : string;
             penulis : string;
             penerbit : string;
             end;
point = ^Data;
Data = record
            info : buku;
            next, prev : point;
       end;

var
  N, menu : integer;
  awal, akhir : point;

{--------------------------------------------------------------------------}
Procedure MenuPilihan (var menu : integer);
begin
  writeln('Menu Utama Perpustakaan');
  writeln('============');
  writeln('1. Isi Data Buku');
  writeln('2. Tambah Data Buku');
  writeln('3. Hapus Data');
  writeln('4. Cari Data');
  writeln('5. Tampil Data Buku');
  writeln('6. Keluar');
  write('Pilihan Anda [1-6] : ');readln(menu);
  {validasi menu pilihan}
  while (menu < 1) or (menu>6) do
  begin
  gotoxy(25,8);textcolor(GREEN);
  write('Salah Memilih Menu, Ulangi! (Tekan Enter)');
  readln;gotoxy(22,8);clreol;textcolor(15);
  readln(menu);
  end;
end;
{---------------------------------------------------------------}
procedure createlist(var awal, akhir : point);
begin
awal  := nil;
akhir := nil;
end;
{---------------------------------------------------------------}

function CountElement (var awal : point): integer;
var
   hasil : integer;
   info : point;
begin
     hasil := 0;
     if awal <> nil then
     begin
          {list tidak kosong}
          {inisialisasi}
          info := awal;
          while info <> nil do
          begin
               hasil := hasil + 1;
               {iterasi}
               info := info^.next;
          end;
     end;
     CountElement := hasil;
end;
{---------------------------------------------------------------}
Procedure Isidata(kode : string ;  judul : string ; penulis : string ; penerbit : string ; var awal : point ; var N : integer);
var
  i : integer;
  baru : Point;
begin;
  i := 0;
    clrscr;
    textcolor(15);
     new(baru);

     i := i+1;
    writeln('Memasukkan Data Buku ke-',i);
    writeln('============================');
    write('Kode Buku : ');readln(kode);
     baru^.info.kode := kode;
    write('Judul Buku : ');readln(judul);
     baru^.info.judul := judul;
    write('Penulis :');readln(penulis);
     baru^.info.penulis := penulis;
    write('penerbit:');readln(penerbit);
     baru^.info.penerbit := penerbit;
     baru^.prev := nil;
     baru^.next := nil;
    akhir := baru;
    awal := baru;
     writeln;
  N := i;
end;
{------------------------------------------------------------------------}
Procedure Menutambah (var menu : integer);
begin
  writeln('Menu Tambah data');
  writeln('============');
  writeln('1. Tambah Data Buku sebagai data Awal');
  writeln('2. Tambah Data Buku ditengah setelah data ke-n');
  writeln('3. Tambah Data Buku sebagai data Akhir');
  writeln('4. Keluar');
  write('Pilihan Anda [1-3] : ');readln(menu);
  {validasi menu pilihan}
  while (menu < 1) or (menu>4) do
  begin
  gotoxy(25,8);textcolor(GREEN);
  write('Salah Memilih Menu, Ulangi! (Tekan Enter)');
  readln;gotoxy(22,8);clreol;textcolor(15);
  readln(menu);
  end;
end;
{--------------------------------------------------------------------------}
 procedure addfirst( kode : string ; judul : string ; penulis : string ; penerbit : string ; var awal : point);
var
   baru : point;
begin
     new(baru);

     writeln('Masukkan kode buku tambahan:');readln(kode);
     baru^.info.kode := kode;
     writeln ('Masukkan judul buku tambahan :');readln(judul);
     baru^.info.judul := judul;
     writeln ('Masukkan nama penulis buku:'); readln(penulis);
     baru^.info.penulis := penulis;
writeln('masukkan nama penerbit buku :');readln(penerbit);
     baru^.info.penerbit := penerbit;
     awal^.prev := baru;
     baru^.next := awal;
     awal:= baru;
     awal^.prev := nil
end;
{------------------------------------------------------------------------}
 Procedure addlast( kode : string; judul : string;
             penulis : string;
             penerbit : string; var akhir : point);
var
   baru : point;
begin
     new(baru);
     write('masukkan kode buku tambahan:');readln(kode);
     baru^.info.kode := kode;
     write('masukkan judul buku tambahan:');readln(judul);
     baru^.info.judul := judul;
     write('masukkan nama penulis:');readln(penulis);
     baru^.info.penulis := penulis;
     write('masukkan penerbit buku:');readln(penerbit);
     baru^.info.penerbit := penerbit;
     baru^.next := nil;
     baru^.prev := akhir;
     akhir^.next := baru;
     akhir := baru;
end;
{------------------------------------------------------------------------}
Procedure addaftersingle(kode : string ; judul : string;
             penulis : string;
             penerbit : string; var awal : point);
var
baru : point;
begin

     new (baru);
     writeln('Masukkan kode buku tambahan:');readln(kode);
     baru^.info.kode := kode;
      writeln ('Masukkan judul buku tambahan :');readln(judul);
     baru^.info.judul := judul;
     writeln ('Masukkan nama penulis buku:'); readln(penulis);
     baru^.info.penulis := penulis;
      writeln('masukkan nama penerbit buku :');readln(penerbit);
     baru^.info.penerbit := penerbit;
     baru^.next := nil;
     baru^.prev := nil;
     awal := baru;
     akhir := baru;
     end ;

{------------------------------------------------------------------------}

procedure addAfter (kode : string ; judul : string;
             penulis : string;
             penerbit : string; var awal : point);
var
   baru, bantu : point;
   ketemu : boolean;
   datasisip : string;
begin

  if awal = nil then
     begin
     addaftersingle(kode,judul,penulis,penerbit,awal);
     end
 else
begin
     writeln ('data akan disisipkan setelah kode buku ke- :'); readln(datasisip);
     bantu := awal;
     ketemu := False;

     while (not ketemu ) do
      begin
      if ( datasisip = bantu^.info.kode)  then
         ketemu := true
      else
          bantu := Bantu^.next;
      end;
     end;

      if (ketemu) then
      begin
        new (baru);
        writeln('Masukkan kode buku tambahan:');readln(kode);
     baru^.info.kode := kode;
      writeln ('Masukkan judul buku tambahan :');readln(judul);
     baru^.info.judul := judul;
     writeln ('Masukkan nama penulis buku:'); readln(penulis);
     baru^.info.penulis := penulis;
      writeln('masukkan nama penerbit buku :');readln(penerbit);
     baru^.info.penerbit := penerbit;

     baru^.next := bantu^.next;
     bantu^.next^.prev := baru;
     baru^.prev := bantu;
     bantu^.next := baru;

     end


       else
       begin
       writeln('data yg disisipkan tidak ada');
       readln;
       end;
end;

{--------------------------------------------------------------------------}


{------------------------------------------------------------------------}
 Procedure MenuHapus (var menu : integer);
begin
  writeln('Menu Hapus data Buku');
  writeln('============');
  writeln('1. Hapus Data Buku Pertama');
  writeln('2. Hapus Data Buku Tengah');
  writeln('3. hapus Data Buku AKhir');
  writeln('4. Keluar');
  write('Pilihan Anda [1-3] : ');readln(menu);
  {validasi menu pilihan}
  while (menu < 1) or (menu>4) do
  begin
  gotoxy(25,8);textcolor(GREEN);
  write('Salah Memilih Menu, Ulangi! (Tekan Enter)');
  readln;gotoxy(22,8);clreol;textcolor(15);
  readln(menu);
  end;
end;
{---------------------------------------------------------------------------}
    procedure delFirst(var awal : point);
var
   phapus: point;
begin
     if awal <> nil then
     begin
          {jika list bukan list kosong}
          phapus := awal;
          awal := awal^.next;
          awal^.prev := nil ;

          phapus^.next := nil;
          dispose(phapus);
     end;
end;
{------------------------------------------------------------------------}
  procedure DelLast(var awal : point);
var
   akhir : point;
   bantu : point;

begin
     if awal <> nil then
     begin
          {jika list tidak kosong}
          if countelement(awal) = 1 then
          begin
               {list terdiri dari satu elemen}
               delFirst(awal);
          end
          else
          begin
               {mencari elemen terakhir list}
               akhir := awal;
               while Akhir^.next <> nil do
               begin
               {iterasi}
               bantu := akhir;
               akhir := akhir^.next;
               end;
               bantu^.next := nil;
               akhir^.prev := nil;
               dispose(akhir);
             end;
          end;
end;
 {---------------------------------------------------------------------------}
 procedure delAfter( var awal,akhir: point);
var
   bantu : point;
  phapus : point;
  kodehapus : string;
  ketemu : boolean;
begin

  writeln('masukkan kode buku yang akan dihapus:');readln(kodehapus);
  bantu := awal;
  phapus := awal;
  ketemu := false;

     while (not ketemu ) do
      begin
      if ( kodehapus = phapus^.info.kode)  then
         ketemu := true
      else
          phapus := phapus^.next;
      end;


  if (ketemu) then
      begin

      if (phapus = akhir)
     then   DelLast(awal)
     else

     bantu := phapus^.prev;
     bantu^.next := phapus^.next;

     phapus^.next^.prev := bantu;

     dispose (phapus)

     end
   else
       begin
       writeln('kode yang akan dihapus tidak ditemukan');
       end;
end;
{----------------------------------------------------------------------------}
procedure delAll( var awal : point);
var
   i : integer;
begin
     if countelement(awal) <> 0 then
     begin
          for i := countelement (awal) downto 1 do
          begin
               {proses menghapus elemen list}
               delLast(awal)
          end;
     end;
end;
{----------------------------------------------------------------------------}
 Procedure Cari_Data(var  awal : point);
var
    Bantu     : point ;
    DataCari  : string ;
    Ketemu    : Boolean;
begin
    write ('masukkan judul, buku yg anda cari:'); readln(DataCari);
    Ketemu := False;
    Bantu := awal;

    While (Not Ketemu) and (Bantu <> Nil) do
          begin
         If (Bantu^.info.judul = DataCari)
    Then
        Ketemu := True
    Else
        Bantu := Bantu^.Next;
         End ;
    If (Ketemu)
      Then
         Writeln(DataCari,'Ditemukan')
      Else
         writeln(DataCari,'Tidak Ditemukan');
    End;

{----------------------------------------------------------------------------}
 procedure printElement( var awal : pointer);
var
   bantu : point;
   i : integer;
begin
     if awal <> nil then
     begin
     {jika list tidak kosong}
     {inisialisasi}
       bantu := awal;
       i := 1;
       while bantu <> nil do
       begin

       {proses}
       writeln('Buku ke : ', i);
       writeln('kode:', bantu^.info.kode);
       writeln('judul:', bantu^.info.judul);
       writeln('penulis:', bantu^.info.penulis);
       writeln('penerbit:', bantu^.info.penerbit);
       writeln('----------------------------------------');
       {iterasi}
       bantu := bantu^.next;
       i := i + 1;
       end;
 end
 else
 begin
      {proses jika list kosong}
      writeln('list kosong');
 end;
end;

{---------------------------------------------------------------------------}
begin

repeat
     clrscr; textcolor(15);
     MenuPilihan(menu);
     case (menu) of
       1 : begin
             clrscr;
             createlist(awal, akhir);
             countelement( awal);
             Isidata('123', 'judul', 'penulis', 'penerbit',awal,n);
           end;
       2 : begin
             clrscr;
             if(N=0)
             then
               writeln('Data Masih Kosong (Tekan Enter Untuk Melanjutkan!)')
             else
             begin
             repeat
              clrscr; textcolor(15);
               Menutambah(menu);
                  case (menu) of
                 1 : begin
                             clrscr;
                            addfirst('123' ,'judul' ,'penulis', 'penerbit' , awal );
                              end;
                 2 : begin
                      clrscr;

                      addAfter('123', 'judul', 'penulis','penerbit', awal);
                      end;
                 3 : begin
                      clrscr;
                      addlast( '123' , 'judul' ,'penulis' ,'penerbit' ,  akhir);
                      end;
                     end;
                   until(menu=4);
                   end;

               end;
       3 : begin
             clrscr;
                 if(N=0)
                then
                   writeln('Data Masih Kosong (Tekan Enter Untuk Melanjutkan!)')
                 else
                 begin
                 repeat
                  clrscr; textcolor(15);
                 MenuHapus(menu);
               case (menu) of
                  1 : begin
                     clrscr;
                     writeln('data Pertama telah Dihapus');
                     readln;
                     delFirst(awal);
                      end;
                  2 : begin
                      clrscr;

                      delAfter(awal,akhir);
                      end;
                  3 : begin
                      clrscr;
                      writeln('data Akhir telah Dihapus');
                      readln;
                      DelLast(awal);
                      end;
                 end;
            until(menu=4);
             end;
             readln;
               end;
        4 : begin
             clrscr;
             if(N=0)
             then
               writeln('Data Masih Kosong (Tekan Enter Untuk Melanjutkan!)')
             else
             begin
             cari_data(awal);
             end;
              readln;
           end;
        5 : begin
             clrscr;
             if(N=0)
             then
               writeln('Data Masih Kosong (Tekan Enter Untuk Melanjutkan!)')
             else
             begin

             printElement(awal);
             end;
              readln;
           end;
     end;
   until(menu=6);
delAll(awal);
end.