code-examples/2015/2015_03/ada/nauka/SPOJ/bajtek.adb

with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Integer_Text_IO;

-- Nie działa to poprawnie

procedure bajtek is

   package T_IO renames Ada.Text_IO;
   package CL   renames Ada.Command_Line;
   package S    renames Ada.Strings;
   package SF   renames Ada.Strings.Fixed;
   package I_IO renames Ada.Integer_Text_IO;

   function FindFirstEqual(
       str: String;
       c: Character;
       from: Integer) return Integer is
   begin
       FindCharacter:
       for i in Natural range from .. str'Last loop
           if str(i) = c then
               return i;
           end if;
       end loop FindCharacter;

       return -1;

   end FindFirstEqual;

   function FindFirstNotEqual(
       str: String;
       c: Character;
       from: Integer) return Integer is
   begin
       FindCharacter:
       for i in Natural range from .. str'Last loop
           if str(i) /= c or str(i) = Character'Val(0) then
               return i;
           end if;
       end loop FindCharacter;

       return -1;

   end FindFirstNotEqual;

   PartsLength : constant := 100;
   BlackPerformance: constant := 10.0;
   GrayPerformance: constant := 6.00;

   subtype ICM is Integer;
   subtype FCM2 is Float;

   beginningX: constant := -10;
   beginningY: constant := -10;

   subtype xType is ICM range beginningX .. 10000;
   subtype yType is ICM range beginningY .. 10000;

   procedure FindNextPoint(
       str: in String;
       from: in out Integer;
       pointX: out xType;
       pointY: out yType;
       found: out Boolean) is

       f,t: Integer := from;
   begin
       f := FindFirstNotEqual(str,S.Space, f);
       if f < 0 then
           found := false;
           return;
       end if;

       t := FindFirstEqual(str,S.Space,f+1);
       if t < 0 then
           found := false;
           return;
       end if;

       pointX := xType'Value(str(f .. t-1));

       f := t;

       f := FindFirstNotEqual(str,S.Space, f);
       if f < 0 then
           found := false;
           return;
       end if;

       t := FindFirstEqual(str,S.Space,f+1);
       if t < 0 then
           t := FindFirstEqual(str, Character'Val(0), f+1);
       end if;

       pointY := yType'Value(str(f .. t-1));

       from := t;

       found := true;

   end FindNextPoint;


   -- ala ma kota

   X : String (1..1000);
   Length : Integer;
   CurrentX,LastX : xType := beginningX;
   CurrentY,LastY : yType := beginningY;
   Field: Float := 0.0;
   found: Boolean;
   FieldWhite,FieldBlack: FCM2;
   NrPaintings : Integer;
   BlackBitoKule,GrayBitoKule: Float := 0.0;

   i: Integer;

   function strlen(s : String) return Integer is
       pos : Integer := s'First;
   begin
       SearchNull:
       while pos < s'Last and s(pos) /= Character'Val(0) loop
           pos := pos + 1;
       end loop SearchNull;
       return pos-s'First;
   end strlen;

begin

    T_IO.Put_Line("Put nr of lines");

    T_IO.Get_Line(X,Length);
    NrPaintings := Integer'Value(X(X'First .. Length));

    T_IO.Put_Line("Put data");

    ReadingLines:
    for line in Integer range 1 .. 2*NrPaintings loop
        exit ReadingLines when T_IO.End_Of_File;

        T_IO.Get_Line(X, Length);
        SF.Move(
            X(X'First..Length),
            X,
            S.Right,
            S.Left,
            Character'Val(0));

        i := X'First;
        LastX := beginningX;
        LastY := beginningY;
        Field := 0.0;

        IfNotAllPointsRead:
        while i <= Length loop
            FindNextPoint(
                X,
                i,
                CurrentX,
                CurrentY,
                found);

            if found = false then
                exit IfNotAllPointsRead;
            end if;

            T_IO.Put_Line("Wczytano punkt (" 
                & xType'Image(CurrentX) & ","
                & yType'Image(CurrentY) & ")");

            Field := Field
                + Float((CurrentY + LastX) * (CurrentX - LastX)) / 2.0;

            LastX := CurrentX;
            LastY := CurrentY;

        end loop IfNotAllPointsRead;

        if line mod 2 = 0 then
            -- opis czarnego
            FieldBlack := Field;
            BlackBitoKule := BlackBitoKule + FieldBlack * BlackPerformance;
        else
            -- opis szarego
            FieldWhite := Field-FieldBlack; -- pomijamy czarny zawarty
            GrayBitoKule := GrayBitoKule + FieldWhite * GrayPerformance;
        end if;

    end loop ReadingLines;

    T_IO.Put_Line(Integer'Image(Integer(Float'Rounding(BlackBitoKule))));
    T_IO.Put_Line(Integer'Image(Integer(Float'Rounding(GrayBitoKule))));

    

end bajtek;