1-- Copyright 2012-2020 Free Software Foundation, Inc. 2-- 3-- This program is free software; you can redistribute it and/or modify 4-- it under the terms of the GNU General Public License as published by 5-- the Free Software Foundation; either version 3 of the License, or 6-- (at your option) any later version. 7-- 8-- This program is distributed in the hope that it will be useful, 9-- but WITHOUT ANY WARRANTY; without even the implied warranty of 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11-- GNU General Public License for more details. 12-- 13-- You should have received a copy of the GNU General Public License 14-- along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16package Classes is 17 18 type Point is record 19 X : Integer; 20 Y : Integer; 21 end record; 22 23 type Shape is abstract tagged null record; 24 25 type Shape_Access is access all Shape'Class; 26 27 type Drawable is interface; 28 29 type Drawable_Access is access all Drawable'Class; 30 31 procedure Draw (D : Drawable) is abstract; 32 33 type Circle is new Shape and Drawable with record 34 Center : Point; 35 Radius : Natural; 36 end record; 37 38 procedure Draw (R : Circle); 39 40 My_Circle : Circle := ((1, 2), 3); 41 My_Shape : Shape'Class := Shape'Class (My_Circle); 42 My_Drawable : Drawable'Class := Drawable'Class (My_Circle); 43 44 S_Access : Shape_Access := new Circle'(My_Circle); 45 D_Access : Drawable_Access := new Circle'(My_Circle); 46 47 type R (MS : Shape_Access; MD : Drawable_Access) is record 48 E : Integer; 49 end record; 50 51 MR : R := (MS => S_Access, MD => D_Access, E => 42); 52 53 type Shape_Array is array (1 .. 4) of Shape_Access; 54 type Drawable_Array is array (1 .. 4) of Drawable_Access; 55 56 S_Array : Shape_Array := (others => S_Access); 57 D_Array : Drawable_Array := (others => D_Access); 58 59end Classes; 60