------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2016, Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285 laboratory, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev: 1249 $ -- $Date: 2014-08-28 07:02:15 +0200 (Fri, 28 Aug 2014) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Glib; use Glib; with Gdk.Types; use Gdk.Types; with Gtk.Enums; use Gtk.Enums; with Gtk.Widget; use Gtk.Widget; with graphical_editor.Select_Time_Line.Callbacks; use graphical_editor.Select_Time_Line.Callbacks; with Framework_Config; use Framework_Config; with Translate; use Translate; with unbounded_strings; use unbounded_strings; use unbounded_strings.strings_table_package; with Task_Set; use Task_Set; use Task_Set.Generic_Task_Set; with Tasks; use Tasks; with Resource_Set; use Resource_Set; use Resource_Set.Generic_Resource_Set; with Resources; use Resources; with Message_Set; use Message_Set; use Message_Set.Generic_Message_Set; with Messages; use Messages; with Buffer_Set; use Buffer_Set; use Buffer_Set.Generic_Buffer_Set; with Buffers; use Buffers; with objects.extended; use objects.extended; with Gtk; use Gtk; with Gtk.Main; use Gtk.Main; with Glib.Error; use Glib.Error; with Ada.Text_IO; use Ada.Text_IO; package body graphical_editor.Select_Time_Line is procedure Gtk_New (Select_Time_Line : out Select_Time_Line_Access; A_System : in System; Call : in Select_Time_Line_Callback_Type) is begin Select_Time_Line := new Select_Time_Line_Record; graphical_editor.Select_Time_Line.Initialize (Select_Time_Line, Sys, Call); end Gtk_New; procedure Initialize (Select_Time_Line : access Select_Time_Line_Record'Class; A_System : in System; Call : in Select_Time_Line_Callback_Type) is My_Task_Iterator : Tasks_Iterator; My_Resource_Iterator : Resources_Iterator; My_Buffer_Iterator : Buffers_Iterator; My_Message_Iterator : Messages_Iterator; A_Task : Generic_Task_Ptr; A_Message : Generic_Message_Ptr; A_Resource : Generic_Resource_Ptr; A_Buffer : Buffer_Ptr; Line : Guint := 1; procedure New_Object (An_Object : Generic_Object_Ptr) is begin Gtk_New (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name) ; Set_Editable (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name, False); Set_Max_Length (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name, 0); Set_Text (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name, To_String (get_name_of_generic_object(An_Object))); Set_Visibility (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name, True); Attach (Select_Time_Line.Table, Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Name, 0, 1, Line, Line + 1, Expand or Fill, 0, 0, 0); Gtk_New (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Type) ; Set_Editable (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Type, False); Set_Max_Length (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Type, 0); case An_Object.object_type is when Message_Object_Type => Set_Text (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Object_Type, To_String (Lb_Message (Current_Language))); when Task_Object_Type => Set_Text (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Object_Type, To_String (Lb_Task (Current_Language))); when Buffer_Object_Type => Set_Text (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Object_Type, To_String (Lb_Buffer (Current_Language))); when Resource_Object_Type => Set_Text (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Object_Type, To_String (Lb_Resource (Current_Language))); when others => null; end case; Set_Visibility (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Type, True); Attach (Select_Time_Line.Table, Select_Time_Line.Entries (Select_Time_Line.Nb_Entries).Object_Type, 1, 2, Line, Line + 1, Expand or Fill, 0, 0, 0); Gtk_New (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Display_Time_Line, ""); Set_Active (Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Display_Time_Line, False); Attach (Select_Time_Line.Table, Select_Time_Line.Entries (Select_Time_Line.Nb_Entries). Display_Time_Line, 2, 3, Line, Line + 1, Expand or Fill, 0, 0, 0); Line := Line + 1; Select_Time_Line.Nb_Entries := Select_Time_Line.Nb_Entries + 1; end New_Object; begin reset (Time_Line_To_Display); Select_Time_Line.Nb_Entries := 0; Select_Time_Line.To_Be_Called := Call; Gtk.Window.Initialize (Select_Time_Line, Window_Toplevel); Set_Title (Select_Time_Line, To_String (Lb_Select_Time_Line (Current_Language))); Set_Policy (Select_Time_Line, True, True, True); Set_Position (Select_Time_Line, Win_Pos_Center_Always); Set_Modal (Select_Time_Line, True); Set_Default_Size (Select_Time_Line, 530, 550); Set_Extension_Events (Select_Time_Line, Extension_Events_All); Set_Flags (Select_Time_Line, Can_Default); Grab_Focus (Select_Time_Line); Gtk_New (Select_Time_Line.Scroll); Set_Border_Width (Select_Time_Line.Scroll, Border_Width => 10); Set_Policy (Select_Time_Line.Scroll, H_Scrollbar_Policy => Policy_Automatic, V_Scrollbar_Policy => Policy_Automatic); Add (Select_Time_Line, Select_Time_Line.Scroll); Gtk_New (Select_Time_Line.Table, 0, 0, True); Set_Row_Spacings (Select_Time_Line.Table, 8); Set_Col_Spacings (Select_Time_Line.Table, 7); Add_With_Viewport (Select_Time_Line.Scroll, Select_Time_Line.Table); Set_Focus_Hadjustment (Select_Time_Line.Table, Get_Hadjustment (Select_Time_Line.Scroll)); Set_Focus_Vadjustment (Select_Time_Line.Table, Get_Vadjustment (Select_Time_Line.Scroll)); Gtk_New (Select_Time_Line.Lab, To_String (Lb_Name (Current_Language))); Set_Alignment (Select_Time_Line.Lab, 0.5, 0.5); Set_Padding (Select_Time_Line.Lab, 0, 0); Set_Justify (Select_Time_Line.Lab, Justify_Center); Set_Line_Wrap (Select_Time_Line.Lab, False); Attach (Select_Time_Line.Table, Select_Time_Line.Lab, 0, 1, 0, 1, 0, 0, 0, 0); Gtk_New (Select_Time_Line.Lab, To_String (Lb_Type (Current_Language))); Set_Alignment (Select_Time_Line.Lab, 0.5, 0.5); Set_Padding (Select_Time_Line.Lab, 0, 0); Set_Justify (Select_Time_Line.Lab, Justify_Center); Set_Line_Wrap (Select_Time_Line.Lab, False); Attach (Select_Time_Line.Table, Select_Time_Line.Lab, 1, 2, 0, 1, 0, 0, 0, 0); Gtk_New (Select_Time_Line.Lab, To_String (Lb_To_Display (Current_Language))); Set_Alignment (Select_Time_Line.Lab, 0.5, 0.5); Set_Padding (Select_Time_Line.Lab, 0, 0); Set_Justify (Select_Time_Line.Lab, Justify_Center); Set_Line_Wrap (Select_Time_Line.Lab, False); Attach (Select_Time_Line.Table, Select_Time_Line.Lab, 2, 3, 0, 1, 0, 0, 0, 0); reset_iterator (Sys.Tasks, My_Task_Iterator); loop current_element (Sys.Tasks, A_Task, My_Task_Iterator); New_Object (Generic_Object_Ptr (A_Task)); exit when is_last_element (Sys.Tasks, My_Task_Iterator); next_element (Sys.Tasks, My_Task_Iterator); end loop; if not is_empty (Sys.Buffers) then reset_iterator (Sys.Buffers, My_Buffer_Iterator); loop current_element (Sys.Buffers, A_Buffer, My_Buffer_Iterator); New_Object (Generic_Object_Ptr (A_Buffer)); exit when is_last_element (Sys.Buffers, My_Buffer_Iterator); next_element (Sys.Buffers, My_Buffer_Iterator); end loop; end if; if not is_empty (Sys.Messages) then reset_iterator (Sys.Messages, My_Message_Iterator); loop current_element (Sys.Messages, A_Message, My_Message_Iterator); New_Object (Generic_Object_Ptr (A_Message)); exit when is_last_element (Sys.Messages, My_Message_Iterator); next_element (Sys.Messages, My_Message_Iterator); end loop; end if; if not is_empty (Sys.Resources) then reset_iterator (Sys.Resources, My_Resource_Iterator); loop current_element (Sys.Resources, A_Resource, My_Resource_Iterator); New_Object (Generic_Object_Ptr (A_Resource)); exit when is_last_element (Sys.Resources, My_Resource_Iterator); next_element (Sys.Resources, My_Resource_Iterator); end loop; end if; Gtk_New_Hseparator (Select_Time_Line.Hseparator); Attach (Select_Time_Line.Table, Select_Time_Line.Hseparator, 0, 3, Line, Line + 1, Fill, Expand or Fill, 0, 0); Gtk_New_Hbox (Select_Time_Line.Hbox, True, 0); Set_Border_Width (Select_Time_Line.Hbox, 6); Attach (Select_Time_Line.Table, Select_Time_Line.Hbox, 0, 3, Line + 1, Line + 2, Fill, Expand or Fill, 0, 0); Gtk_New (Select_Time_Line.Ok_Button, "Ok"); Pack_Start (Select_Time_Line.Hbox, Select_Time_Line.Ok_Button, True, True, 0); Button_Callback.Connect (Select_Time_Line.Ok_Button, "clicked", Button_Callback.To_Marshaller (On_Ok_Pressed'Access)); end Initialize; function To_Display (Searched_Name : in Unbounded_String; Searched_Type : in Objects_Type) return Boolean is Ite : Time_Line_Object_Iterator; An_Object : Generic_Object_Ptr; begin if is_empty (Time_Line_To_Display) then return True; end if; reset_iterator (Time_Line_To_Display, Ite); loop current_element (Time_Line_To_Display, An_Object, Ite); if (get_name_of_generic_object(An_Object) = Searched_Name) and (An_Object.object_type = Searched_Type) then return True; end if; exit when is_last_element (Time_Line_To_Display, Ite); next_element (Time_Line_To_Display, Ite); end loop; return False; end To_Display; end graphical_editor.Select_Time_Line;