1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Ada Modeling Framework -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2011-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: 2864 $ $Date: 2012-04-13 14:08:07 +0400 (Fri, 13 Apr 2012) $ 43------------------------------------------------------------------------------ 44with AMF.Internals.Element_Collections; 45with AMF.Internals.Helpers; 46with AMF.Internals.Tables.UML_Attributes; 47with AMF.Visitors.UML_Iterators; 48with AMF.Visitors.UML_Visitors; 49with League.Strings.Internals; 50with Matreshka.Internals.Strings; 51 52package body AMF.Internals.UML_Images is 53 54 ------------------- 55 -- Enter_Element -- 56 ------------------- 57 58 overriding procedure Enter_Element 59 (Self : not null access constant UML_Image_Proxy; 60 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 61 Control : in out AMF.Visitors.Traverse_Control) is 62 begin 63 if Visitor in AMF.Visitors.UML_Visitors.UML_Visitor'Class then 64 AMF.Visitors.UML_Visitors.UML_Visitor'Class 65 (Visitor).Enter_Image 66 (AMF.UML.Images.UML_Image_Access (Self), 67 Control); 68 end if; 69 end Enter_Element; 70 71 ------------------- 72 -- Leave_Element -- 73 ------------------- 74 75 overriding procedure Leave_Element 76 (Self : not null access constant UML_Image_Proxy; 77 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 78 Control : in out AMF.Visitors.Traverse_Control) is 79 begin 80 if Visitor in AMF.Visitors.UML_Visitors.UML_Visitor'Class then 81 AMF.Visitors.UML_Visitors.UML_Visitor'Class 82 (Visitor).Leave_Image 83 (AMF.UML.Images.UML_Image_Access (Self), 84 Control); 85 end if; 86 end Leave_Element; 87 88 ------------------- 89 -- Visit_Element -- 90 ------------------- 91 92 overriding procedure Visit_Element 93 (Self : not null access constant UML_Image_Proxy; 94 Iterator : in out AMF.Visitors.Abstract_Iterator'Class; 95 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 96 Control : in out AMF.Visitors.Traverse_Control) is 97 begin 98 if Iterator in AMF.Visitors.UML_Iterators.UML_Iterator'Class then 99 AMF.Visitors.UML_Iterators.UML_Iterator'Class 100 (Iterator).Visit_Image 101 (Visitor, 102 AMF.UML.Images.UML_Image_Access (Self), 103 Control); 104 end if; 105 end Visit_Element; 106 107 ----------------- 108 -- Get_Content -- 109 ----------------- 110 111 overriding function Get_Content 112 (Self : not null access constant UML_Image_Proxy) 113 return AMF.Optional_String is 114 begin 115 declare 116 use type Matreshka.Internals.Strings.Shared_String_Access; 117 118 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 119 := AMF.Internals.Tables.UML_Attributes.Internal_Get_Content (Self.Element); 120 121 begin 122 if Aux = null then 123 return (Is_Empty => True); 124 125 else 126 return (False, League.Strings.Internals.Create (Aux)); 127 end if; 128 end; 129 end Get_Content; 130 131 ----------------- 132 -- Set_Content -- 133 ----------------- 134 135 overriding procedure Set_Content 136 (Self : not null access UML_Image_Proxy; 137 To : AMF.Optional_String) is 138 begin 139 if To.Is_Empty then 140 AMF.Internals.Tables.UML_Attributes.Internal_Set_Content 141 (Self.Element, null); 142 143 else 144 AMF.Internals.Tables.UML_Attributes.Internal_Set_Content 145 (Self.Element, 146 League.Strings.Internals.Internal (To.Value)); 147 end if; 148 end Set_Content; 149 150 ---------------- 151 -- Get_Format -- 152 ---------------- 153 154 overriding function Get_Format 155 (Self : not null access constant UML_Image_Proxy) 156 return AMF.Optional_String is 157 begin 158 declare 159 use type Matreshka.Internals.Strings.Shared_String_Access; 160 161 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 162 := AMF.Internals.Tables.UML_Attributes.Internal_Get_Format (Self.Element); 163 164 begin 165 if Aux = null then 166 return (Is_Empty => True); 167 168 else 169 return (False, League.Strings.Internals.Create (Aux)); 170 end if; 171 end; 172 end Get_Format; 173 174 ---------------- 175 -- Set_Format -- 176 ---------------- 177 178 overriding procedure Set_Format 179 (Self : not null access UML_Image_Proxy; 180 To : AMF.Optional_String) is 181 begin 182 if To.Is_Empty then 183 AMF.Internals.Tables.UML_Attributes.Internal_Set_Format 184 (Self.Element, null); 185 186 else 187 AMF.Internals.Tables.UML_Attributes.Internal_Set_Format 188 (Self.Element, 189 League.Strings.Internals.Internal (To.Value)); 190 end if; 191 end Set_Format; 192 193 ------------------ 194 -- Get_Location -- 195 ------------------ 196 197 overriding function Get_Location 198 (Self : not null access constant UML_Image_Proxy) 199 return AMF.Optional_String is 200 begin 201 declare 202 use type Matreshka.Internals.Strings.Shared_String_Access; 203 204 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 205 := AMF.Internals.Tables.UML_Attributes.Internal_Get_Location (Self.Element); 206 207 begin 208 if Aux = null then 209 return (Is_Empty => True); 210 211 else 212 return (False, League.Strings.Internals.Create (Aux)); 213 end if; 214 end; 215 end Get_Location; 216 217 ------------------ 218 -- Set_Location -- 219 ------------------ 220 221 overriding procedure Set_Location 222 (Self : not null access UML_Image_Proxy; 223 To : AMF.Optional_String) is 224 begin 225 if To.Is_Empty then 226 AMF.Internals.Tables.UML_Attributes.Internal_Set_Location 227 (Self.Element, null); 228 229 else 230 AMF.Internals.Tables.UML_Attributes.Internal_Set_Location 231 (Self.Element, 232 League.Strings.Internals.Internal (To.Value)); 233 end if; 234 end Set_Location; 235 236end AMF.Internals.UML_Images; 237