Monday, November 21, 2011

program queue dalam pascal


Program Queveueeueueueueueueueuee;

Uses wincrt;

Const N = 100;

Type Queve = record
      isi : Array[1..N]of integer;
      head:integer;
      tail: integer;
     end;

Procedure CreateQueve(Var S:Queve);
     begin
          S.head:=0;
          S.tail:=0;
     end;

Function IsFull(S:Queve):boolean;
     begin
         IsFull := (S.head = 1) and (S.tail = N);
     end;

Function IsEmpty(S:Queve):boolean;
     begin
          IsEmpty := (S.head = 0 ) and (S.tail = 0);
     end;

Procedure add(X:integer; var S:Queve);
     begin
          If Not IsFull(S) then
           begin
                S.tail := S.tail + 1;
                S.isi[S.tail] := X;
                if S.head=0 then
                S.head:=S.head+1;

           end;
     end;

Procedure remove(var X:integer; var S:Queve);
var i:integer;
    begin
         IF NOt IsEmpty(S) then
          begin
               X:=S.isi[S.head];
               for i:= 2 to S.tail do
               S.isi[i-1]:=S.isi[i];
               S.tail :=S.tail - 1;
               if S.tail=0 then
               S.head:=S.head-1;
          end;
    end;

{Main Program}
Var S : Queve;
    X,i,z,m,Y: integer;

Begin
      write('masukan jumlah data ');readln(X);
      CreateQueve(S);
      for i:= 1 to X do
          begin
               write('masukan data ke',i,' : ');readln(m);
               add(m,S);
          end;
      writeln;
        write('jumlah data yang akan dikeluarkan ');readln(Y);
        writeln('data yang dikeluarkan : ');
      for i:= 1 to Y do
          begin
               remove(z,S);
               writeln(z);
          end;
          writeln;
          writeln('data yang tersisa : ');
          for i:= 1 to S.tail do
          writeln(S.isi[i]);
          writeln;
          writeln('S.tail berada di elemen ke ',S.tail);
          writeln('S.head berada di elemen ke ',S.head);

End.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          

1 comment: