/euler002/Euler002b.adb

 1pragma License ( GPL );
 2------------------------------------------------------------------------------
 3-- Author: darkestkhan                                                      --
 4-- Email:  darkestkhan@gmail.com                                            --
 5-- License: GNU GPLv3 or any later as published by Free Software Foundation --
 6-- ( see license.txt file )                                                 --
 7-- Copyright Š 2011 darkestkhan                                             --
 8------------------------------------------------------------------------------
 9-- This Program is Free Software: You Can Redistribute It and/or Modify     --
10-- It Under The Terms of The GNU General Public License As Published By     --
11-- The Free Software Foundation, Either Version 3 of The License, or        --
12-- (at Your Option) Any Later Version.                                      --
13--                                                                          --
14-- This Program is Distributed in The Hope That It Will Be Useful,          --
15-- But WITHOUT ANY WARRANTY; Without Even The Implied Warranty of           --
16-- MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE.  See The            --
17-- GNU General Public License for More Details.                             --
18--                                                                          --
19-- You Should Have Received A Copy of The GNU General Public License        --
20-- Along with This Program.  if not, See <Http://Www.Gnu.Org/Licenses/>.    --
21------------------------------------------------------------------------------
22with Ada.Task_Identification;
23with TTY; -- it is at <https://github.com/darkestkhan/tty>
24with Ada.Command_Line;
25with Ada.IO_Exceptions;
26procedure Euler002b is
27
28  Terminal: TTY.TTY;
29  Argc: constant Integer := Ada.Command_Line.Argument_Count;
30
31  function Sum_Even_Fib ( Limit: in Integer ) return Integer is
32    Sum: Integer := 0;
33    First: Integer := 1;
34    Second: Integer := 2;
35    Fib: Integer := Second;
36  begin
37    while Fib < Limit loop
38      if Fib mod 2 = 0 then
39        Sum := Sum + Fib;
40      end if;
41      Fib := First + Second;
42      First := Second;
43      Second := Fib;
44    end loop;
45    return Sum;
46  exception
47    when constraint_error => return -1;
48  end Sum_Even_Fib;
49
50  task type Calculate ( Arg: Integer );
51  task body Calculate is
52    Sum: Integer;
53  begin
54    Sum := Sum_Even_Fib ( Limit => Arg );
55    if Sum = -1 then
56      Terminal.Write_Line ( "The sum of even terms of Fibonacci series below " & Arg'img  & " is greater than integer'last" );
57      Ada.Task_Identification.Abort_Task ( Ada.Task_Identification.Current_Task );
58    else
59      Terminal.Write_Line ( "The sum of even terms of Fibonacii series below " & Arg'img & " equals " & Sum'img );
60    end if;
61  end Calculate;
62
63  type Calculate_Array is array ( Integer range <> ) of access Calculate;
64  Calculates: Calculate_Array ( 1 .. Argc );
65
66  function Create ( Arg: in Integer ) return access Calculate is
67  begin
68    return new Calculate ( Arg => Arg );
69  end Create;
70
71  task type Creator;
72  task body Creator is
73    Arg: Integer;
74  begin
75    if Argc < 1 then
76      Terminal.Write_Line ( "Usage: " & Ada.Command_Line.Command_Name & " [int] ... " );
77      Ada.Task_Identification.Abort_Task ( Ada.Task_Identification.Current_Task );
78    end if;
79
80    for Index in 1 .. Argc loop
81      Arg := Integer'Value ( Ada.Command_Line.Argument ( Index );
82      Calculates ( Index ) := Create ( Arg => Arg );
83    end loop;
84  exception
85    when Ada.IO_Exceptions.Data_Error => Terminal.Write_Line ( "One of arguments was too big. Aborting. Aborting." );
86                                    Ada.Task_Identification.Abort_Task ( Ada.Task_Identification.Current_Task );
87  end Creator;
88
89  God: Creator;
90
91begin
92  null;
93end Euler002b;