-- File: oo.ads
-- Author: Michael Neumann
package OO is
type Byte is range 0 .. 255;
for Byte'Size use 8;
type Color is
record
Red,
Green,
Blue : Byte;
end record;
type Shape is abstract tagged
record
X,
Y : Integer;
C : Color;
end record;
type Circle is new Shape with
record
Radius : Integer;
end record;
type Rectangle is new Shape with
record
Width,
Height : Integer;
end record;
procedure Move (
Self : in out Shape'Class;
DX,
DY : Integer );
procedure Draw (
Self : in Circle'Class );
procedure Draw (
Self : in Rectangle'Class );
function Get_Area (
Self : in Circle'Class )
return Integer;
function Get_Area (
Self : in Rectangle'Class )
return Integer;
end OO;
-- File: oo.adb
-- Author: Michael Neumann
package body OO is
procedure Move (
Self : in out Shape'Class;
DX,
DY : Integer ) is
begin
Self.X := Self.X + DX;
Self.Y := Self.Y + DY;
end Move;
procedure Draw (
Self : in Circle'Class ) is
begin
-- Do something here
null;
end Draw;
procedure Draw (
Self : in Rectangle'Class ) is
begin
-- Do something here
null;
end Draw;
function Get_Area (
Self : in Circle'Class )
return Integer is
Pi : constant Float := 3.1415;
begin
return Integer( Pi * Float(Self.Radius) );
end;
function Get_Area (
Self : in Rectangle'Class )
return Integer is
begin
return Self.Width * Self.Height;
end;
end OO;
-- File: oo_test.adb
-- Author: Michael Neumann
with Ada.Text_IO, OO;
use Ada.Text_IO, OO;
procedure OO_Test is
package MyInt is new Integer_IO(Integer);
use MyInt;
BLACK : constant Color := (0, 0, 0);
WHITE : constant Color := (255, 255, 255);
Circ : Circle;
Rect : Rectangle;
begin
Circ := Circle'(
X => 100,
Y => 100,
Radius => 50,
C => BLACK);
Rect := Rectangle'(
X => 20,
Y => 20,
Width => 5,
Height => 5,
C => WHITE);
Move(Circ, DY => 10, DX => 10);
Circ.X := 50;
Circ.Radius := 5;
Put( Get_Area(Circ) ); -- => 16 (Ada always rounds numbers up)
Put( Get_Area(Rect) ); -- => 25
Put( Rect.Width ); -- => 5
Rect.Width := 10;
Put( Rect.Width ); -- => 10
Draw(Circ);
Draw(Rect);
end;
|