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;