1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Ada Modeling Framework -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2012, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 3432 $ $Date: 2012-11-14 00:51:21 +0400 (Wed, 14 Nov 2012) $ 43------------------------------------------------------------------------------ 44with AMF.Elements; 45with AMF.Internals.Element_Collections; 46with AMF.Internals.Helpers; 47with AMF.Internals.Tables.UML_Attributes; 48with AMF.Visitors.UMLDI_Iterators; 49with AMF.Visitors.UMLDI_Visitors; 50 51package body AMF.Internals.UMLDI_UML_Compartments is 52 53 -------------------------------- 54 -- Get_Element_In_Compartment -- 55 -------------------------------- 56 57 overriding function Get_Element_In_Compartment 58 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 59 return AMF.UMLDI.UML_Diagram_Elements.Collections.Ordered_Set_Of_UMLDI_UML_Diagram_Element is 60 begin 61 return 62 AMF.UMLDI.UML_Diagram_Elements.Collections.Wrap 63 (AMF.Internals.Element_Collections.Wrap 64 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Element_In_Compartment 65 (Self.Element))); 66 end Get_Element_In_Compartment; 67 68 ----------------- 69 -- Get_Is_Icon -- 70 ----------------- 71 72 overriding function Get_Is_Icon 73 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 74 return Boolean is 75 begin 76 return 77 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Icon 78 (Self.Element); 79 end Get_Is_Icon; 80 81 ----------------- 82 -- Set_Is_Icon -- 83 ----------------- 84 85 overriding procedure Set_Is_Icon 86 (Self : not null access UMLDI_UML_Compartment_Proxy; 87 To : Boolean) is 88 begin 89 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Icon 90 (Self.Element, To); 91 end Set_Is_Icon; 92 93 --------------------- 94 -- Get_Local_Style -- 95 --------------------- 96 97 overriding function Get_Local_Style 98 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 99 return AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access is 100 begin 101 return 102 AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access 103 (AMF.Internals.Helpers.To_Element 104 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Local_Style 105 (Self.Element))); 106 end Get_Local_Style; 107 108 --------------------- 109 -- Set_Local_Style -- 110 --------------------- 111 112 overriding procedure Set_Local_Style 113 (Self : not null access UMLDI_UML_Compartment_Proxy; 114 To : AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access) is 115 begin 116 AMF.Internals.Tables.UML_Attributes.Internal_Set_Local_Style 117 (Self.Element, 118 AMF.Internals.Helpers.To_Element 119 (AMF.Elements.Element_Access (To))); 120 end Set_Local_Style; 121 122 ----------------------- 123 -- Get_Model_Element -- 124 ----------------------- 125 126 overriding function Get_Model_Element 127 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 128 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 129 begin 130 raise Program_Error; 131 return X : AMF.UML.Elements.Collections.Set_Of_UML_Element; 132-- return 133-- AMF.UML.Elements.Collections.Wrap 134-- (AMF.Internals.Element_Collections.Wrap 135-- (AMF.Internals.Tables.UML_Attributes.Internal_Get_Model_Element 136-- (Self.Element))); 137 end Get_Model_Element; 138 139 ----------------------- 140 -- Get_Model_Element -- 141 ----------------------- 142 143 overriding function Get_Model_Element 144 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 145 return AMF.CMOF.Elements.CMOF_Element_Access is 146 begin 147 return 148 AMF.CMOF.Elements.CMOF_Element_Access 149 (AMF.Internals.Helpers.To_Element 150 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Model_Element 151 (Self.Element))); 152 end Get_Model_Element; 153 154 --------------------- 155 -- Get_Local_Style -- 156 --------------------- 157 158 overriding function Get_Local_Style 159 (Self : not null access constant UMLDI_UML_Compartment_Proxy) 160 return AMF.DI.Styles.DI_Style_Access is 161 begin 162 return 163 AMF.DI.Styles.DI_Style_Access 164 (AMF.Internals.Helpers.To_Element 165 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Local_Style 166 (Self.Element))); 167 end Get_Local_Style; 168 169 --------------------- 170 -- Set_Local_Style -- 171 --------------------- 172 173 overriding procedure Set_Local_Style 174 (Self : not null access UMLDI_UML_Compartment_Proxy; 175 To : AMF.DI.Styles.DI_Style_Access) is 176 begin 177 AMF.Internals.Tables.UML_Attributes.Internal_Set_Local_Style 178 (Self.Element, 179 AMF.Internals.Helpers.To_Element 180 (AMF.Elements.Element_Access (To))); 181 end Set_Local_Style; 182 183 ------------------- 184 -- Enter_Element -- 185 ------------------- 186 187 overriding procedure Enter_Element 188 (Self : not null access constant UMLDI_UML_Compartment_Proxy; 189 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 190 Control : in out AMF.Visitors.Traverse_Control) is 191 begin 192 if Visitor in AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class then 193 AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class 194 (Visitor).Enter_UML_Compartment 195 (AMF.UMLDI.UML_Compartments.UMLDI_UML_Compartment_Access (Self), 196 Control); 197 end if; 198 end Enter_Element; 199 200 ------------------- 201 -- Leave_Element -- 202 ------------------- 203 204 overriding procedure Leave_Element 205 (Self : not null access constant UMLDI_UML_Compartment_Proxy; 206 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 207 Control : in out AMF.Visitors.Traverse_Control) is 208 begin 209 if Visitor in AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class then 210 AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class 211 (Visitor).Leave_UML_Compartment 212 (AMF.UMLDI.UML_Compartments.UMLDI_UML_Compartment_Access (Self), 213 Control); 214 end if; 215 end Leave_Element; 216 217 ------------------- 218 -- Visit_Element -- 219 ------------------- 220 221 overriding procedure Visit_Element 222 (Self : not null access constant UMLDI_UML_Compartment_Proxy; 223 Iterator : in out AMF.Visitors.Abstract_Iterator'Class; 224 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 225 Control : in out AMF.Visitors.Traverse_Control) is 226 begin 227 if Iterator in AMF.Visitors.UMLDI_Iterators.UMLDI_Iterator'Class then 228 AMF.Visitors.UMLDI_Iterators.UMLDI_Iterator'Class 229 (Iterator).Visit_UML_Compartment 230 (Visitor, 231 AMF.UMLDI.UML_Compartments.UMLDI_UML_Compartment_Access (Self), 232 Control); 233 end if; 234 end Visit_Element; 235 236end AMF.Internals.UMLDI_UML_Compartments; 237