1------------------------------------------------------------------------------ 2-- GtkAda - Ada95 binding for Gtk+/Gnome -- 3-- -- 4-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 5-- Copyright (C) 1998-2015, AdaCore -- 6-- -- 7-- This library is free software; you can redistribute it and/or modify it -- 8-- under terms of the GNU General Public License as published by the Free -- 9-- Software Foundation; either version 3, or (at your option) any later -- 10-- version. This library is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 13-- -- 14-- As a special exception under Section 7 of GPL version 3, you are granted -- 15-- additional permissions described in the GCC Runtime Library Exception, -- 16-- version 3.1, as published by the Free Software Foundation. -- 17-- -- 18-- You should have received a copy of the GNU General Public License and -- 19-- a copy of the GCC Runtime Library Exception along with this program; -- 20-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 21-- <http://www.gnu.org/licenses/>. -- 22-- -- 23------------------------------------------------------------------------------ 24 25with Glib; use Glib; 26 27package body Gtkada.Canvas_View.Objects is 28 29 ----------------------- 30 -- Link_Anchor_Point -- 31 ----------------------- 32 33 function Link_Anchor_Point 34 (Self : not null access Abstract_Item_Record'Class; 35 Anchor : Anchor_Attachment) 36 return Item_Point 37 is 38 C : constant Item_Rectangle := Self.Bounding_Box; 39 begin 40 case Anchor.Toplevel_Side is 41 when Auto | No_Clipping => 42 return (C.Width * abs (Anchor.X), C.Height * abs (Anchor.Y)); 43 44 when Top => 45 return (C.Width * abs (Anchor.X), 0.0); 46 47 when Right => 48 return (C.Width, C.Height * abs (Anchor.Y)); 49 50 when Bottom => 51 return (C.Width * abs (Anchor.X), C.Height); 52 53 when Left => 54 return (0.0, C.Height * abs (Anchor.Y)); 55 end case; 56 end Link_Anchor_Point; 57 58 -------------- 59 -- Toplevel -- 60 -------------- 61 62 function Toplevel 63 (Self : not null access Abstract_Item_Record'Class) 64 return Abstract_Item 65 is 66 Result : Abstract_Item := Abstract_Item (Self); 67 P : Abstract_Item := Result.Parent; 68 begin 69 while P /= null loop 70 Result := P; 71 P := Result.Parent; 72 end loop; 73 return Result; 74 end Toplevel; 75 76end Gtkada.Canvas_View.Objects; 77