All pastes #407101 Raw Edit

Someone

public text v1 · immutable
#407101 ·published 2007-03-22 21:49 UTC
rendered paste body
with Ada.Text_Io;           use Ada.Text_Io;
with Ada.Integer_Text_Io;   use Ada.Integer_TexT_Io;
with Ada.Sequential_Io;
with Ada.Exceptions; use Ada.Exceptions;


procedure Labb6 is


   type Intresse_Array is
     array(1..10) of Integer;

   type Person_Type is
      record
         Fornamn, Postadress, Efternamn, Gatuadress : String(1..20);
         Intresse : Intresse_Array;
      end record;

   package Person_Binary_File is
      new Ada.Sequential_Io(Person_Type);
   use Person_Binary_File;


   function Check_intresse (Left : in Intresse_Array;
                            Right : in Intresse_Array;
                            Length : in Integer)
                           return Boolean is
   begin
      for I in 1 .. Length loop
         for j in 1 .. 10 loop
            if Left(J) = Right(I) then
               return True;
            end if;
         end loop;
      end loop;

      return False;
   end Check_intresse;



   procedure Get_input (N : out Integer;
                        Intresse : out Intresse_Array) is
      Insert_intresse : Boolean;
      I : Integer;

   begin

      for J in Intresse'Range loop
         Intresse(J) := 0;
      end loop;

      N := 0;

      loop
         Get(I);

         if I = 0 then
            exit;
         end if;

         for I in 1..15 loop
           Insert_Intresse := True;
           for J in 1..N loop

              if I = Intresse(J) then
                 Insert_Intresse := False;
                 exit;
              end if;
              Insert_Intresse := True;
           end loop;

           if insert_intresse then
              N := N +1;
              Intresse(N) := I;
           end if;
           if N >= 10 then
              exit;
           end if;
         end loop;
      end loop;
   end Get_input;


   function compare (Left : in Intresse_Array;
                    Right : in Intresse_Array;
                    Length : in Integer)
                   return Intresse_Array is
      Intresse : Intresse_Array;
      N : Integer;
   begin
      for I in Intresse'Range loop
         Intresse(I) := 0;
      end loop;

      N := 0;

      for I in 1 .. Length loop
         for J in 1 .. 10 loop
            if Left(J) = Right(I) then
               N := N +1;
               Intresse(N) := Left (J);
            end if;
         end loop;
      end loop;
      return Intresse;
   end compare;


   procedure Put (File : in Ada.Text_Io.File_Type;
                  P : in Person_Type;
                  Intresse : in Intresse_Array) is
   begin

      Put(File, P.Fornamn);
      Put(File, P.Efternamn);
      Put(File, P.Gatuadress);
      Put(File, P.Postadress);
      Put(File, "intressen: ");

      for I in 1.. Intresse'Last loop
         if (Intresse(I) /= 0) then
            Put(File, Intresse(I));
         end if;
      end loop;
      New_Line(File);
   end Put;

   Inputfile : Person_Binary_File.File_Type;
   Outputfile : Ada.Text_Io.File_Type;
   P : Person_Type;
   Antal_Intressen : Integer;
   Intressen : Intresse_Array;

begin

   Put("Ange intressen: ");
   Get_Input(Antal_intressen, Intressen);

   Open(Inputfile, In_File, "REG.BIN");
   Create (Outputfile, Out_File, "RESULTAT.TXT");

   while not End_Of_File(Inputfile) loop
      Read (Inputfile, P);
      if Check_Intresse (Intressen, P.Intresse, Antal_Intressen) = true then
         Put(Outputfile, P,
             Compare(Intressen, P.Intresse, Antal_intressen));
      end if;
   end loop;

   Put_Line("Klart, resultat finns på filen Resultat.txt");
end Labb6;