Senin, 05 Mei 2014

Membuat List dengan Pascal

Program JUmlah_Dua_Integer;

Uses Crt;
Const Max = 80;

Type Str80 = string[Max];
     Simpul = ^Data;
     Data   = rECORD
                 Info  : Char;
                 Kiri,Kanan  : Simpul
              End;

Var Bilangan1,
    Bilangan2,
    Bilangan3 : Simpul;
    Angka1,
    Angka2    : Str80;
    I         : Integer;
    Lagi      : char;

Function CEK_BILANGAN(Bil : Str80): boolean;
Var  I        : Integer;
     Angka    : set of char;
     Valid    : boolean;

begin
     Angka    := ['0'..'9'];
     valid    := true;
     for I :=1 to length(Bil) do
         if not(BIL[I] in Angka) then
            begin
              Valid := False;
              I := length(Bil)
            end;
      Cek_Bilangan := valid;
end;

Procedure Awalan(Var Baru : Simpul);

Begin
  New(Baru);
  With Baru^ do
     begin
       Info := char(32);
       Kiri := Baru;
       Kanan := kiri
     end;
end;

Procedure BUAT_LIST(Var List  : Simpul;
                        Bil   : Str80);
var I,Cch_Kar,J,Kode : Integer;
    Baru : Simpul;

Begin
    for I := 1 to length(Bil) do
        begin
          AWALAN(BARU);
          Val(Bil[I],J,Kode);
          Baru^.Info :=chr(J);
          Baru^.Kiri :=List^.Kiri;
          Baru^.Kanan :=List;
          List^.Kiri^.Kanan := Baru;
          List^.Kiri := Baru;
        end;
        List^.Info := chr(length(Bil))
end;

Procedure BACA (Kepala : Simpul);
Var Bantu  : Simpul; Kode  : Integer;

Begin
Bantu := Kepala^.Kanan;

Repeat
  Kode := ord(Bantu^.Info);
  If Kode = 32 then
     Write(' ')
  else
     Write(Kode);
  Bantu := Bantu^.Kanan
Until Bantu = Kepala;
Writeln
End;

Procedure CEK_OPERAND(Var Bil1, Bil2 : Simpul);
Var Jml1,Jml2 : Integer;

Procedure TAMBAH_NOL(Var T : Simpul; C : Integer);
Var Baru : Simpul;
      I  : Integer;

Begin
   For I := 1 to C do
     Begin
       AWALAN(Baru);
       Baru^.Kiri :=T;
       Baru^.Kanan := T^.Kanan;
       T^.Kanan^.Kiri := Baru;
       T^.Kanan := Baru;
       T^.Info := chr(ord(T^.Info)+1)
     end
end;


begin
   jml1  := ord(Bil1^.Info);
   jml2  := ord(Bil2^.Info);
   if jml1 <> jml2 then

   Tambah_Nol(Bil1,Jml1-Jml2)
   Else
   Tambah_Nol(Bil1,Jml1-Jml1)
End;

Procedure HASIL(Var Bil1, Bil2, Bil3 : Simpul);
Var Sisa, Jumlah, Dgt,Dgt1  : Integer;
    Bantu1, Bantu2, Baru    : Simpul;

Procedure OPER;

    Begin
      Baru^.Kanan  := Bil3^.Kanan;
      Baru^.Kiri   := Bil3;
      Bil3^.Kanan^.Kiri := Baru;
      Bil3^.Kanan  := Baru;
    End;

    Begin
      Bantu1   := Bil1^.Kiri;
      Bantu2   := Bil2^.Kiri;
      Sisa := 0;

    {Program proses 2 Bilanagn}
    Repeat

        Dgt := Ord(Bantu1^.Info);
        Dgt1 := Ord(Bantu2^.Info);
        if Dgt1 = 32 then Dgt1 :=0;
        if Dgt = 32 then Dgt :=0;

        Jumlah := Dgt + Dgt1 + Sisa;

        If Jumlah >= 10 then
           begin
              Jumlah := jumlah - 10;
              Sisa := 1
           end

        Else
        Sisa := 0;
        New(Baru);
        Baru^.Info := chr(Jumlah);
        Oper;
        Bantu1 := Bantu1^.Kiri;
         Bantu2 := Bantu2^.Kiri;
  Until Bantu1 = Bil1;

  If Sisa = 1 then
     Begin
       AWALAN(Baru);
       Baru^.INFO := chr(sisa);
       OPER;
       AWALAN(Baru); AWALAN(Bantu1);
       BARU^.Kanan := Bil1^.Kanan;
       BARU^.Kiri := Bil1;
       BARU^.Kanan := Baru;
       Bantu1^.Kanan := Bil2^.Kanan;
       Bantu1^.Kiri := Bil2;
       Bil2^.Kanan^.Kiri := Bantu1;
       Bil2^.Kanan := Bantu1;
       Bil1^.Info := Chr(ord(Bil1^.Info)+1);
     end;
 end;

{ Program Utama }

Begin
   Repeat
     clrscr;

     Writeln('CONTOH PENGGUNAAN SENARAI BERANTAI PENJUMAHAN 2 BIL');
     wRITEln('---------------------------------------------------');
     write('Bilangan pertama : ');Readln(Angka1);
     write('Bilangan kedua   : ');Readln(Angka2);
     Writeln;

      if  CEK_BILANGAN(Angka1) and
        CEK_BILANGAN(Angka2) then

     begin
         Awalan(Bilangan1); Awalan(Bilangan2);
         Awalan(Bilangan3);
         BUAT_LIST(Bilangan1,Angka1);
         BUAT_LIST(Bilangan2,Angka2);

         Cek_Operand(Bilangan1,Bilangan2);

         HASIL(Bilangan1,Bilangan2,Bilangan3);

         Writeln; Writeln('Hasil perhitungan ');
         Writeln;
         BACA(Bilangan1);BACA(bilangan2);

              For I := 1 to ord(Bilangan1^.Info) do
                Write('-');
              Write(' + ');Writeln;BACA(Bilangan3)
           end
       Else
          Writeln('Ada Karakter tdk sah');
          Writeln; Writeln('Akan coba Lagi ? (Y/T) : ');
          Readln(Lagi);
       Until Not (Lagi in ['Y','y']);
       Readln
End.
Selamat Mencoba....
Semoga Berhasil....

0 komentar: