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: 3436 $ $Date: 2012-11-14 10:14:34 +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_Classifier_Shapes is 52 53 ------------------------- 54 -- Get_Is_Double_Sided -- 55 ------------------------- 56 57 overriding function Get_Is_Double_Sided 58 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 59 return Boolean is 60 begin 61 return 62 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Double_Sided 63 (Self.Element); 64 end Get_Is_Double_Sided; 65 66 ------------------------- 67 -- Set_Is_Double_Sided -- 68 ------------------------- 69 70 overriding procedure Set_Is_Double_Sided 71 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 72 To : Boolean) is 73 begin 74 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Double_Sided 75 (Self.Element, To); 76 end Set_Is_Double_Sided; 77 78 ---------------------------------- 79 -- Get_Is_Indent_For_Visibility -- 80 ---------------------------------- 81 82 overriding function Get_Is_Indent_For_Visibility 83 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 84 return Boolean is 85 begin 86 return 87 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Indent_For_Visibility 88 (Self.Element); 89 end Get_Is_Indent_For_Visibility; 90 91 ---------------------------------- 92 -- Set_Is_Indent_For_Visibility -- 93 ---------------------------------- 94 95 overriding procedure Set_Is_Indent_For_Visibility 96 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 97 To : Boolean) is 98 begin 99 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Indent_For_Visibility 100 (Self.Element, To); 101 end Set_Is_Indent_For_Visibility; 102 103 ----------------------- 104 -- Get_Model_Element -- 105 ----------------------- 106 107 overriding function Get_Model_Element 108 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 109 return AMF.UML.Classifiers.UML_Classifier_Access is 110 begin 111 return 112 AMF.UML.Classifiers.UML_Classifier_Access 113 (AMF.Internals.Helpers.To_Element 114 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Model_Element 115 (Self.Element))); 116 end Get_Model_Element; 117 118 ----------------------- 119 -- Set_Model_Element -- 120 ----------------------- 121 122 overriding procedure Set_Model_Element 123 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 124 To : AMF.UML.Classifiers.UML_Classifier_Access) is 125 begin 126 raise Program_Error; 127-- AMF.Internals.Tables.UML_Attributes.Internal_Set_Model_Element 128-- (Self.Element, 129-- AMF.Internals.Helpers.To_Element 130-- (AMF.Elements.Element_Access (To))); 131 end Set_Model_Element; 132 133 --------------------- 134 -- Get_Compartment -- 135 --------------------- 136 137 overriding function Get_Compartment 138 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 139 return AMF.UMLDI.UML_Compartments.Collections.Ordered_Set_Of_UMLDI_UML_Compartment is 140 begin 141 return 142 AMF.UMLDI.UML_Compartments.Collections.Wrap 143 (AMF.Internals.Element_Collections.Wrap 144 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Compartment 145 (Self.Element))); 146 end Get_Compartment; 147 148 ----------------- 149 -- Get_Is_Icon -- 150 ----------------- 151 152 overriding function Get_Is_Icon 153 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 154 return Boolean is 155 begin 156 return 157 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Icon 158 (Self.Element); 159 end Get_Is_Icon; 160 161 ----------------- 162 -- Set_Is_Icon -- 163 ----------------- 164 165 overriding procedure Set_Is_Icon 166 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 167 To : Boolean) is 168 begin 169 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Icon 170 (Self.Element, To); 171 end Set_Is_Icon; 172 173 --------------------- 174 -- Get_Local_Style -- 175 --------------------- 176 177 overriding function Get_Local_Style 178 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 179 return AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access is 180 begin 181 return 182 AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access 183 (AMF.Internals.Helpers.To_Element 184 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Local_Style 185 (Self.Element))); 186 end Get_Local_Style; 187 188 --------------------- 189 -- Set_Local_Style -- 190 --------------------- 191 192 overriding procedure Set_Local_Style 193 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 194 To : AMF.UMLDI.UML_Styles.UMLDI_UML_Style_Access) is 195 begin 196 AMF.Internals.Tables.UML_Attributes.Internal_Set_Local_Style 197 (Self.Element, 198 AMF.Internals.Helpers.To_Element 199 (AMF.Elements.Element_Access (To))); 200 end Set_Local_Style; 201 202 ----------------------- 203 -- Get_Model_Element -- 204 ----------------------- 205 206 overriding function Get_Model_Element 207 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 208 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 209 begin 210 raise Program_Error; 211 return X : AMF.UML.Elements.Collections.Set_Of_UML_Element; 212-- return 213-- AMF.UML.Elements.Collections.Wrap 214-- (AMF.Internals.Element_Collections.Wrap 215-- (AMF.Internals.Tables.UML_Attributes.Internal_Get_Model_Element 216-- (Self.Element))); 217 end Get_Model_Element; 218 219 ----------------------- 220 -- Get_Model_Element -- 221 ----------------------- 222 223 overriding function Get_Model_Element 224 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 225 return AMF.CMOF.Elements.CMOF_Element_Access is 226 begin 227 return 228 AMF.CMOF.Elements.CMOF_Element_Access 229 (AMF.Internals.Helpers.To_Element 230 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Model_Element 231 (Self.Element))); 232 end Get_Model_Element; 233 234 --------------------- 235 -- Get_Local_Style -- 236 --------------------- 237 238 overriding function Get_Local_Style 239 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy) 240 return AMF.DI.Styles.DI_Style_Access is 241 begin 242 return 243 AMF.DI.Styles.DI_Style_Access 244 (AMF.Internals.Helpers.To_Element 245 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Local_Style 246 (Self.Element))); 247 end Get_Local_Style; 248 249 --------------------- 250 -- Set_Local_Style -- 251 --------------------- 252 253 overriding procedure Set_Local_Style 254 (Self : not null access UMLDI_UML_Classifier_Shape_Proxy; 255 To : AMF.DI.Styles.DI_Style_Access) is 256 begin 257 AMF.Internals.Tables.UML_Attributes.Internal_Set_Local_Style 258 (Self.Element, 259 AMF.Internals.Helpers.To_Element 260 (AMF.Elements.Element_Access (To))); 261 end Set_Local_Style; 262 263 ------------------- 264 -- Enter_Element -- 265 ------------------- 266 267 overriding procedure Enter_Element 268 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy; 269 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 270 Control : in out AMF.Visitors.Traverse_Control) is 271 begin 272 if Visitor in AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class then 273 AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class 274 (Visitor).Enter_UML_Classifier_Shape 275 (AMF.UMLDI.UML_Classifier_Shapes.UMLDI_UML_Classifier_Shape_Access (Self), 276 Control); 277 end if; 278 end Enter_Element; 279 280 ------------------- 281 -- Leave_Element -- 282 ------------------- 283 284 overriding procedure Leave_Element 285 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy; 286 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 287 Control : in out AMF.Visitors.Traverse_Control) is 288 begin 289 if Visitor in AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class then 290 AMF.Visitors.UMLDI_Visitors.UMLDI_Visitor'Class 291 (Visitor).Leave_UML_Classifier_Shape 292 (AMF.UMLDI.UML_Classifier_Shapes.UMLDI_UML_Classifier_Shape_Access (Self), 293 Control); 294 end if; 295 end Leave_Element; 296 297 ------------------- 298 -- Visit_Element -- 299 ------------------- 300 301 overriding procedure Visit_Element 302 (Self : not null access constant UMLDI_UML_Classifier_Shape_Proxy; 303 Iterator : in out AMF.Visitors.Abstract_Iterator'Class; 304 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 305 Control : in out AMF.Visitors.Traverse_Control) is 306 begin 307 if Iterator in AMF.Visitors.UMLDI_Iterators.UMLDI_Iterator'Class then 308 AMF.Visitors.UMLDI_Iterators.UMLDI_Iterator'Class 309 (Iterator).Visit_UML_Classifier_Shape 310 (Visitor, 311 AMF.UMLDI.UML_Classifier_Shapes.UMLDI_UML_Classifier_Shape_Access (Self), 312 Control); 313 end if; 314 end Visit_Element; 315 316end AMF.Internals.UMLDI_UML_Classifier_Shapes; 317