ALGORITMA DENGAN PASCAL

DASAR-DASAR PEMROGRAMAN PASCAL

program Luas_segitiga;
uses wincrt;
procedure
var a,t,L: real;

begin
     write('tulis alas'); readln(a);
     write('tulis tinggi'); readln(t);
     L:= a*t/2;
     write('luas segitiga',L);
end.


program akar_kuadrat;
uses wincrt;
var
   a,b,c:real;
   function akar(a,b,c:real):real;
   begin
   akar:=sqrt (a*a)+(b*b)+(c*c);
   end;
 begin
   writeln(' PROGRAM AKAR KUADRAT');
   writeln(' ********************');
   writeln;
   writeln;
   writeln;
   write(' masukan angka pertama:');readln(a);
   write(' masukan angka kedua :');readln(b);
   write('  masukan angka ketiga :');readln(c);
   writeln('--------------------------');
   writeln('  hasil akar dari:',akar(a,b,c):8:2);
 end.


Program Menara;
uses wincrt;
Var
Jarak, Alfa, Rad, Tinggi    : Real;
begin
          Writeln(' PROGRAM MENGHITUNG TINGGI MENARA');
          Writeln(' ________________________________');
          Writeln;
          writeln;
          Write ('Jarak pengukur hingga menara (meter) =');readln(Jarak);
          Write ('Sudut antara tanah & puncak (derajat) =');readln(alfa);

          rad:= alfa *pi/180;
          tinggi:= sin (rad) / cos (rad) * jarak;
          Writeln('TInggi Menara adalah = ',Tinggi:0:4, ' meter');
          readln;
end.

program konversi_suhu;
uses wincrt;
var celcius,fahrenheit,reamour: real;

begin
     clrscr;
     writeln ('konversi derajad celcius ke fahrenheit dan reamour');
     writeln ('--------------------------------------------------');
     writeln;
     write   ('berapa derajad celcius yang akan di konversikan:');

     readln(celcius);
     fahrenheit:= 9/5*celcius + 32;
     reamour := 4/5*celcius;
     writeln;
     writeln ('derajad celcius =',celcius:1:3);
     writeln ('derajad fahrenheit=',fahrenheit:1:3);
     writeln ('derajad reamour =',reamour:1:3);
end.


PENGGUNAAN WHILE DO

Program menghitung_nilai_rata2;
uses wincrt;
var x,n,k,jumlah:integer;
    rata: real;

begin
     clrscr;
     write('masukkan data:'); readln (n);
     k:=1;
     jumlah:=0;

     while k <= n do
     begin
     write('x=?'); readln(x);
     jumlah:= jumlah+x;
     k:=k+1;
     end;
     rata:=jumlah/n;
     writeln('rata-rata seluruh data=',rata);
end.


PENGGUNAAN IF THEN

program warisan_Pak_Hamzah;
uses wincrt;
var i,al,ap,x: real;
begin
     clrscr;
     writeln ('Telah Meninggal Dengan Tenang');
     writeln ('Prof. Dr. Ir. Hamka Hamzah, M.Sc');
     writeln ('Pada tanggal 25 Desember 2008');
     writeln ('Dengan usia 112 tahun');
     writeln ('Dengan meninggalkan warisan senilai "x"juta rupiah');
     writeln ('Tertanda');
     writeln ('=====Notaris "Adi Prasetia,S.H, M.Hum.=====');
     writeln ('masukkan warisan:'); readln(x);
             i:= 1/2*x;
             al:=1/3*x;
             ap:=1/6*x;
     writeln ('bagian istri adalah:',i:4:0,' juta rupiah');
     writeln ('bagian anal laki-laki adalah:',al:4:0,' juta rupiah');
     writeln ('bagian anak perempuan adalah:',ap:4:0,' juta rupiah');
     writeln;
    
     if  i>al then
         if i>ap then
            writeln ('bagian istri paling banyak senilai',i:4:0,' juta rupiah')
         else
             writeln ('bagian anak perempuan paling banyak senilai',ap:4:0,' juta rupiah')
     else
         if al>ap then
            writeln ('bagian anak laki-laki paling banyak senilai',al:4:0,' juta rupiah')
         else
             writeln ('bagian anak perempuan paling banyak senilai',ap:4:0,' juta rupiah')
end. 
  
Program Bonus;
uses wincrt;

     Var
     TotalPembelian     : LongInt;
     Begin
          Clrscr;
          Write (' Total Pembelian Anda = '); readln(TotalPembelian);

          If TotalPembelian >= 100000 then
          Writeln ('Anda Mendapat Diskon 10%')
          else
              If TotalPembelian >= 50000 then
              Writeln ('ANda Mendapat Bonus 1 buah piring cantik')
              else
                  If TotalPembelian >=10000 then
                  Writeln('anda Mendapat Bonus 1 buah Gelas')
                  else
                      Writeln('Maaf .............. anda Lom Dapat Bonus...!!! silakan belanja Lebih Banyak yaaa!!!');
     End.



PROCEDURE DALAM PEMROGRAMAN PASCAL

Program prosedur_input_dan_output;
uses wincrt;
var A,B,x,y: integer;
procedure Input (var A,B:integer);
begin
writeln('  Prosedur Memasukkan dan Menampilkan Dua Bilangan'); {prosedur Memasukkan dua bilangan} writeln;
Writeln('------------------------------------------------------');writeln;
write('Masukkan bilangan pertamanya! : ');readln(a);
write('Masukkan juga bilangan kedua! : '); readln(b);
end;
procedure Output (var x,y:integer);
begin
x:=A;
y:=B;
writeln; { prosedur menampilkan dua bilangan yang diinput diantara dua bilangan tersebut}
writeln(' kedua bilangan yang diminta untuk ditampilkan yaitu: ',x,', ',a,', ',b,', ',y); writeln;
writeln('(bilangan itu berada diantara dua bilangan yang diinput/pangkal dan ujung).');
end;
 begin
 input(A,B);
 output(X,Y);
 end.
 
PENGGUNAAN CASE OF

program des_hexa;
uses wincrt;
var x,des,hexa: integer;
    A,B,C,D,E,F: string;

begin
     clrscr;
     write('brp des_nya?????');readln(des);
     x:=28;
     repeat
     GOTOXY (X,12);
     hexa:= des mod 16;
     des := des mod 16;
     x:=x-1;
     case hexa of
     0..9:write(hexa) ;
     10:write('A')     ;
     11:write('B')     ;
     12:write('C')      ;
     13:write('D')      ;
     14:write('E')       ;
     15:write('F') ;
          
     until des=0;
    
end.

Program Hari;
uses wincrt;
Var
KodeBulan       : integer;

     Begin
          Write ('bingung Menghitung Jumlah Hari ?? Tulislah kode bulannya [1..12] :');
          readln(kodebulan);

          Case KodeBulan Of
          1, 3, 5, 7, 8,  10, 12: Writeln (' Jumlah hari adalah 31');
          4,6,9, 11 : Writeln ('Jumlah Hari adalah 30');
          2 : Writeln ('Jumlah adalah 28 atau 29, kalo tahun kabisat berarti ya 29 hari.');
          end;
     end.


program Channel_TV;
uses wincrt;

     Var
     no_ke      : Integer;
     Saluran_ke : string;

     begin
          Write ('Masukkan Saluran yang anda pilih ');
          readln (no_ke);

          Case no_ke of
          1: saluran_ke := 'TVRI';
          2: saluran_ke := 'TPI';
          3: saluran_ke := 'RCTI';
          4: saluran_ke := 'SCTV';
          5: saluran_ke := 'ANTV';
          6: saluran_ke := 'Indosiar';
          else
          saluran_ke := 'Saluran anda salah, Error Not Responding!! Try Again.. he..he..he';
          end;

     writeln ('Saluran ke ',no_ke, ' adalah ', saluran_ke);
     end.


PENGGUNAAN REPEAT UNTIL

program des_ke_oktaf;
uses wincrt;
var x,des,okt:integer;
begin
     clrscr;
     write('brp des?');readln(des);
     x:=6;
     repeat
     gotoxy (x,6);
     okt := des mod 8;
     des  := des div 8;
     write(okt);
     x:=x-1;
     until des =0;
end.

program kon_des_biner;
uses wincrt;
var des,x,bin:integer;
begin
     clrscr;
     write('brp des?');readln(des);
     X:=30;
     repeat
           gotoxy (x-1,15);
           write(des mod 2);
           des := des div 2;
     until des = 0;
end.


program des_ke_hexa;
uses wincrt;
var x,des,hexa:integer;
begin
     clrscr;
     write('brp des?');readln(des);
     x:=6;
     repeat
     gotoxy (x,6);
     hexa := des mod 16;
     des  := des div 16;
     write(hexa);
     x:=x-1;
     until des =0;
end.


PENGGUNAAN ARRAY DALAM MATRIKS

program penjumlahan_matriks;
uses wincrt;
type
matriks=array[1..10,1..10]of real;
var
mat_a,mat_b,mat_c:matriks;
baris,kolom,i,j:byte;
procedure baca(var x:matriks);
begin
     for i:=1 to baris do
     for j:=1 to kolom do
     begin
     write('element matriks[',i,',',j,']='); readln(x[i,j]);
     end;
end;
    procedure jumlah (A,B:matriks; var C:matriks);
    var i,j:byte;
    begin
         for i:=1 to baris do
         for j:=1 to kolom do
         begin
         c[i,j]:=A[i,j]+B[i,j];
         writeln('matriks C[',i,',',j,']=',C[i,j]);
         end;
    end;
begin
clrscr;
write('berapa jumlah baris:'); readln(baris);
write('berapa jumlah kolom:'); readln(kolom);
writeln('masukan element matriiks A');
baca(mat_a);
writeln('masukan element matriks B');
baca (mat_b);
jumlah(mat_a,mat_b,mat_c);
end.


PENGGUNAAN FOR
Program Bintang;
Uses wincrt;
Const
Akhir = 10;
Var
Baris, kolom : integer;
                                     
BEGIN
     Clrscr;
     For Baris := 1 TO Akhir DO
         BEGIN
         FOR kolom := 1 TO Baris DO
         Write ('=ADEC=');
         Writeln;
         END;
END.


PROGRAM TINGKAT TINGGI

program averagewaittime;
uses wincrt;
type
    time1=array [1..100] of integer;
    wait1=array [1..100] of integer;
var
   ulang:char;
   pilih:byte;
   n:integer;
procedure FCFS;
var
   waktu:time1;
   wait:wait1;
   i,jumlah,sum:integer;
   awt:real;
begin
     clrscr;
     writeln('#################################');
     writeln('First Come First Server ( FCFS )');
     writeln('#################################');
     write('Jumlah proses : '); readln(n);
     jumlah:=0;
     sum:=0;
     wait[1]:=0;
     for i:=1 to n do
     begin
          write('Masukan lama proses ke-',i,':'); readln(waktu[i]);
          jumlah:=wait[i];
          wait[i+1]:=jumlah+waktu[i];
          sum:=sum+wait[i];
     end;
     gotoxy(1,5+n);
     writeln('#################################');
     writeln('Proses |Working Time| Waiting Time ( WT )');
     writeln('#################################');
     for i:=1 to n do;
     begin
          gotoxy(1,(7+n)+i); write('|');
          gotoxy(11,(7+n)+i); write('|');
          gotoxy(24,(7+n)+i); write('|');
          gotoxy(38,(7+n)+i); write('|');
     end;
     gotoxy(1,((7+n)+n)+i);
     write('################################');
     for i:=1 to n do
     begin
          gotoxy(2,(7+n)+i);
          write('Proses',i);
          gotoxy(14,(7+n)+i);
          write(waktu[i]);
          gotoxy(26,(7+n)+i);
          write(wait[i]);
     end;
     awt:=sum/n;
     gotoxy(1,(9+n)+n);
     writeln('Average Waiting Time ( AWT ) :',sum,'/',n,':',awt:2:2);
     readln;
end;
procedure SJF;
var
   i,j,jumlah,sum,temp:integer;
   awt:real;
   waktu:time1;
   wait:wait1;
begin
     clrscr;
     writeln('##############################');
     writeln('Shortest Job First ( SJF )');
     writeln('##############################');
     write('Jumlah proses : '); readln(n);
     jumlah:=0;
     sum:=0;
     wait[1]:=0;
     temp:=0;

     for i:=1 to n do
     begin
          write('Masukan lama proses ke-',i,':'); readln(waktu[i]);
     end;
     for i:=1 to (n-1) do
         for j:=(i+1)to n do
         begin
              if waktu[j]
              begin
                   temp:=waktu[i];
                   waktu[i]:=waktu[j];
                   waktu[j]:=temp;
              end;
         end;
     gotoxy(1,5+n);
     writeln('###############################');
     writeln('Proses |Working Time|Waiting Time ( WT )');
     writeln('###############################');
     for i:=1 to n do
     begin
          gotoxy(1,(7+n)+i);write('|');
          gotoxy(11,(7+n)+i);write('|');
          gotoxy(24,(7+n)+i);write('|');
          gotoxy(38,(7+n)+i);write('|');
     end;
     gotoxy(1,((7+n)+n)+1);
     write('################################');
     for i:=1 to n do
     begin
          gotoxy(2,(7+n)+i);write('Proses',i);
          gotoxy(14,(7+n)+i);write(waktu[i]);
          gotoxy(26,(7+n)+i);write(wait[i]);
          jumlah:=wait[i];
          wait[i+1]:=jumlah+waktu[i];
          sum:=sum+wait[i];
     end;
     awt:=sum/n;
     gotoxy(1,(9+n)+n);
     writeln('Averge Waiting Time ( AWT ) :',sum,'/',n,';',awt:2:2);
     readln;
end;
procedure pilihan(pilih:byte);
begin
     clrscr;
     writeln('Pilihan :');
     writeln('1. First Come First Served');
     writeln('2. Shortest Job First');
     writeln('3. Exit');
     write('Your Choice : ');readln(pilih);
     case pilih of
     1:fcfs;
     2:sjf;
     3:exit;
     end;
end;
begin
     ulang:='Y';
     repeat
     clrscr;
     pilihan(pilih);
     gotoxy(1,(10+n)+n);
     write('Back to Main Menu (y/n) ?');
     readln(ulang);
     until upcase(ulang)='N';
end.