Penggunaan Procedure dalam Pascal

uses wincrt;

   { Program data mahasiswa }

   procedure data_mhs;

        var

           nm_mhs:string[30];

           jrs:string[20];

           npm:integer;

        begin

             write('Nama Mahasiswa : ');readln(nm_mhs);

             write('NPM            : ');readln(npm);

             write('Jurusan        : ');readln(jrs); { read in this line must be "readln", because it influences program when you use "repeat until" }

             writeln;

        end;

   { End program data mahasiswa }

   { Program Luas Persegi Panjang }

   procedure persegi_pjg;

    var

       p,l:integer;

       ls:real;

       cmd:integer;

    begin

       writeln(' " Program Menghitung Luas Persegi Panjang " ');

       writeln;

             write('Masukkan Panjang Persegi Panjang   : ');read(p);

             write('Masukkan Lebar Persegi panjang     : ');readln(l); { read in this line must be "readln", because it influences program when you use "repeat until" }

             ls:=p*l;

             writeln;

             writeln(' Luas Persegi Panjang adalah       ', ls:0:2,'  cm');

             writeln;

    end;

   { End Program Luas Persegi Panjang }

   { Program Segitiga }

   procedure segitiga;

    var

       a,t:integer;

       l:real;

    begin

       writeln(' " Program Menghitung Luas Segitiga " ');

       writeln;

       write('Masukkan Alas Segitiga   : ');read(a);

       write('Masukkan Tinggi Segitiga : ');readln(t); { read in this line must be "readln",because it influences program when you use "repeat until" }

       l:=(a*t) div 2;

       writeln;

       writeln(' Luas Segitiga adalah     ', l:0:2,'  cm');

    end;

   { End Program Segitiga }

   { Program Keliling Lingkaran }

   procedure kel_lingkaran;

    var

       r:integer;

       kel_link:real;

    const

       phi=3.14;

    begin

       writeln(' " Program Menghitung Keliling Lingaran " ');

       writeln;

       write('Masukkan Jari-jari Lingkaran   : ');readln(r); { read in this line must be "readln",because it influences program when you use "repeat until" }

       kel_link:=phi*(r*r);

       writeln;

       writeln(' Luas Segitiga adalah     ', kel_link:0:2,'  cm');

    end;

   { End Program Keliling Linkaran }

   { Question Procedure }

     procedure question;

      begin

          writeln;

          write('Apakah anda ingin mengulang ? (Y/N) : ');

      end;

   { End Question }

   { Footer }

     procedure footer;

       begin

        gotoxy(20,25);write('Free Share Pascal Programming, Made By Yans');

       end;

   { end Footer || no need to type this }

{ Main Program }     

   label m_utama;

   var

      i,menu:integer;

      ques:char;

   begin

    m_utama:

     footer; { for learning no need to call this, because it is only for style footer}

     gotoxy(1,1);

      writeln('       Daftar Menu      ');

      writeln('========================');

      writeln('1. Data Mahasiswa ');

      writeln('2. Luas Persegi Panjang ');

      writeln('3. Luas Segitiga ');

      writeln('4. Keliling Lingkaran ');

      writeln;

      write(' Pilih Menu no ..: ');readln(menu);

      case menu of

       1:

        begin

         ClrScr;

         writeln(' Program Data Mahasiswa/i ');

         writeln('--------------------------');

         repeat

          writeln;

          data_mhs;

          question;readln(ques); 

         until UpCase(ques)<>'Y';

          ClrScr;

          goto m_utama;

        end;

       2:

        begin

         repeat

          ClrScr;

          persegi_pjg;

          question;readln(ques);

         until UpCase(ques)<>'Y';

          ClrScr;

          goto m_utama;

        end;

       3:

        begin

         repeat

          ClrScr;

          segitiga; { calling procedure segitiga }

          question;readln(ques);    { calling procedure question, readln(ques) is used for giving you a choice }

         until UpCase(ques)<>'Y';

          ClrScr;             { Clear screen }

          goto m_utama;       { if you give answer not "Y", so it will be back to main menu }

        end;

       4:

        begin

          repeat

          ClrScr;

          kel_lingkaran;

          question;readln(ques); 

         until UpCase(ques)<>'Y';

          ClrScr;

          goto m_utama;

        end;

      else

        ClrScr;

        gotoxy(2,15);writeln('--> Menu Tidak Tersedia -||- Silakan pilih menu sesuai yang tertera diatas <--');

        writeln;

        goto m_utama;

      end; { end of case }

   

   end.

   {  Program finish well }