PROGRAM TURBO PASCAL

SALAH

uses crt;
var i:integer;
    a:integer;

procedure satu;
  Procedure dua;
  begin
       writeln('Prosedure ulang 1-10 dan 10-1');
       for i := 1 to 10 do
       write(i:4);
       writeln;
       for a := 10 downto 1 do
       write(a:4);
  end;

  Procedure tiga;
  begin
       writeln('Procedure tiga ada di dalam procedure satu');
  end;
begin
     writeln('Procedure Ulang 1-10 dan 10-1');
     for i := 1 to 10 do
     write (i:4);
     writeln;
     for a := 10 downto 1 do
     write (a:4);
     dua;
     tiga;
end;

{ modul Utama }
begin
     clrscr;
     writeln('PROCEDURE UTAMA');
     writeln;
     satu;
     writeln;
     readln;
end.



KONVERSI PANJANG KE METER

uses crt;
var
   u:string;
   j:integer;
   h:real;
begin
     clrscr;
     writeln('KONVERSI PANJANG KE METER');
     writeln;
     write ('Pilih Unit (mm/cm) : '); readln(u);
     write ('Masukkan Jumlah ',u,' : '); readln(j);
     if u='mm' then
        h:= j/1000;
     begin
     if u='cm' then
        h:= j/100;
     end;
     writeln;
     writeln('hasil ',j,' ',u,' = ',h:8:2,' m');
     readln;
end.


STACK

Program Infix_Ke_Postfix;
Uses Crt;
Const MaxElemen = 255;
Type
    S255 = String [MaxElemen];
    Tumpukan = Record
             Isi     : S255;
             Atas    : Integer;
    End;
Var
   Infix : S255; (* Notasi Infix *)
   Lagi  : Char;

(* Fungsi untuk menentukan Valensi operator *)

Function Valensi (Tanda_Op : char): integer;
Begin
     Case Tanda_Op Of
          '^'      : Valensi := 3;
          '*', '/' : Valensi := 2;
          '+', '-' : Valensi := 1;
          '('      : Valensi := 0;
     End;
End;

Procedure PUSH (Var T : Tumpukan; Elemen : char);
Begin
     If T.Atas = MaxElemen then
        Writeln('Tumpukan Sudah Penuh')
     Else
     Begin
          T.Atas := T.Atas + 1;
          T.Isi [T.Atas] := Elemen;
     End;
End;

Function POP (Var T : Tumpukan ) : Char;
Begin
     If T.Atas = 0 Then
     Begin
          Writeln('Tumpukan Sudah Kosong....');
         {POP:= 0}
     end
     Else
     Begin
          POP := T.Isi[T.Atas];
          T.Atas := T.Atas - 1;
     End;
End;

Procedure Konversi_Cetak (Infix : S255);
Var
   I            : Integer;
   Operator     : Set Of Char;
   Temp, Kar    : Char;
   T            : Tumpukan;
   Test         : Boolean;
Begin
     (* Himpunan operator yang diijinkan *)
     Operator := ['^']+['*']+['/']+['+']+['-'];

     For I := 1 to Length (Infix) Do          (* Melakukan Konversi *)
     Begin
           Kar := Infix[I]; (* Ambil karakter demi karakter *)
           If Kar = '('Then (* jika ketemu kurung buka *)
              PUSH(T, Kar)
           Else
           If Kar = ')' Then (* jika ketemu kurung tutup *)
           Begin
                While T.Isi[T.Atas] <> '(' Do
                      Write (POP (T) :2);
                Temp := POP (T);
           End
           Else
           If Kar in Operator Then (* jika ketemu operator *)
           Begin
                While (T.Atas <>0) AND (Valensi (Kar) <= Valensi (T.Isi[T.Atas])) Do
                Begin
                     Write(POP(T) :2);
                End;
                PUSH(T, Kar);
           End
           Else
           If Kar <> ' ' Then (* jika operand lgsg cetak*)
              Write (Kar:2);
     End; (* Akhir baca Infix *)

     If T.Atas <>0 Then (* Jika Stack belum kosong *)
     Begin
          Repeat
                Write (POP(T):2);
          Until T.Atas =0;
     End;
End; (* Akhir Procedure Konversi *)

(* Program Utama *)
Begin
     Clrscr;
     Writeln('Mengubah Notasi Infix menjadi Postfix');
     Writeln('Dengan Memanfaatkan Struktur Tumpukan');
     Writeln('_____________________________________');
     Writeln;
     Repeat
           Write('Masukkan Notasi Infix :');Readln(Infix);
           Writeln;
           write('Notasi Postfix Hasil  :');

           (* Panggil Procedure Konversi *)
           Konversi_Cetak (Infix);
           Writeln; Writeln;
           Write('Akan mencoba lagi [Y/T] : '); Readln(Lagi);
     Until Lagi in ['T','t','N','n'];
End.



















TUMPUKAN

uses crt;
const max = 5;
type
    data = record
         Nim     : string;
         Nama    : string;
         Nilai   : integer;
    end;
var
   Tumpuk       : Array[1..max] of data;
   Jl,I         : integer;
   Lagi,Pil     : Char;

Procedure Isi;
Begin
     Repeat
       if Jl=Max then
       writeln('Tumpukan Penuh')
       Else
       Begin
       Jl:=Jl+1;
       with Tumpuk [Jl] do
       Begin
         Write('Input Nim       :  '); readln(Nim);
         write('Input Nama      :  '); readln(Nama);
         write('Input Nilai     :  '); readln(Nilai);
         end;
          end;
       write('Lagi Y/T :  '); readln(Lagi);
     until (upcase (Lagi)<>'Y');
   end;

Procedure Tampil;
Begin
     writeln('Nim       Nama        Nilai');
     for I:= 1 to Jl Do
     Begin
          with Tumpuk[I] do
          Begin
            writeln(Nim, ' ' , Nama, ' ' , Nilai);
          End;
     End;
End;

Procedure Hapus;
Begin
     if Jl=0 Then
     Writeln('Tumpukan Dalam Keadaan Kosong')
     Else
     Dec(Jl);
     End;

{Program Utama}
Begin
     Clrscr;
     Jl:=0;
     Repeat
           writeln('1. Isi Tumpukan ');
           Writeln('2. Tampil       ');
           Writeln('3. Hapus        ');
           Writeln('4. Selesai      ');
           Write('Pilihan 1/2/3/4 :  ');Readln(Pil);
           Case Pil Of
                '1' : Isi;
                '2' : Tampil;
                '3' : Hapus;
           End;
     Until Pil='4';
end.