-- FA11B00.A
|
-- FA11B00.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- FOUNDATION DESCRIPTION:
|
-- FOUNDATION DESCRIPTION:
|
-- This foundation declares parent types and operations that can
|
-- This foundation declares parent types and operations that can
|
-- be inherited by its children.
|
-- be inherited by its children.
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
--
|
--
|
--!
|
--!
|
|
|
package FA11B00 is -- Application_One_Widget
|
package FA11B00 is -- Application_One_Widget
|
-- This foundation simulates code that might be obtained as an already
|
-- This foundation simulates code that might be obtained as an already
|
-- implemented set of objects and services, perhaps from a source code
|
-- implemented set of objects and services, perhaps from a source code
|
-- vendor. It represents processing of widgets in a window system.
|
-- vendor. It represents processing of widgets in a window system.
|
-- These widgets all have the same characteristics, but they are application
|
-- These widgets all have the same characteristics, but they are application
|
-- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget.
|
-- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget.
|
|
|
-- The dimension measurement is in pixels (dots on the screen).
|
-- The dimension measurement is in pixels (dots on the screen).
|
type Pixels is range 0 .. 10_000;
|
type Pixels is range 0 .. 10_000;
|
type Widget_Id is new Integer;
|
type Widget_Id is new Integer;
|
type Widget_Color_Enum is (Amber, Green, White, None);
|
type Widget_Color_Enum is (Amber, Green, White, None);
|
subtype Widget_Label_Str is string (1 .. 15);
|
subtype Widget_Label_Str is string (1 .. 15);
|
|
|
type Widget_Location is
|
type Widget_Location is
|
record
|
record
|
X_Location, Y_Location : Pixels;
|
X_Location, Y_Location : Pixels;
|
end record;
|
end record;
|
|
|
type Widget_Size is
|
type Widget_Size is
|
record
|
record
|
X_Length, Y_Length : Pixels;
|
X_Length, Y_Length : Pixels;
|
end record;
|
end record;
|
|
|
-- NOTE : not a tagged record.
|
-- NOTE : not a tagged record.
|
type App1_Widget (Maximum_Size : Pixels := Pixels'Last)
|
type App1_Widget (Maximum_Size : Pixels := Pixels'Last)
|
is record -- Parent type
|
is record -- Parent type
|
Size : Widget_Size := (Maximum_Size, Maximum_Size);
|
Size : Widget_Size := (Maximum_Size, Maximum_Size);
|
ID : Widget_Id := 1;
|
ID : Widget_Id := 1;
|
Location : Widget_Location := (0,0);
|
Location : Widget_Location := (0,0);
|
Color : Widget_Color_Enum := None;
|
Color : Widget_Color_Enum := None;
|
Label : Widget_Label_Str := " ";
|
Label : Widget_Label_Str := " ";
|
end record;
|
end record;
|
|
|
-- Primitive operation of type Widget.
|
-- Primitive operation of type Widget.
|
-- To be inherited by its children derivatives.
|
-- To be inherited by its children derivatives.
|
procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget;
|
procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget;
|
I : in Widget_Id;
|
I : in Widget_Id;
|
C : in Widget_Color_Enum;
|
C : in Widget_Color_Enum;
|
L : in Widget_Label_Str);
|
L : in Widget_Label_Str);
|
|
|
end FA11B00; -- Application_One_Widget
|
end FA11B00; -- Application_One_Widget
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
package body FA11B00 is -- Application_One_Widget
|
package body FA11B00 is -- Application_One_Widget
|
|
|
procedure Set_Color (The_Widget : in out App1_Widget;
|
procedure Set_Color (The_Widget : in out App1_Widget;
|
C : in Widget_Color_Enum) is
|
C : in Widget_Color_Enum) is
|
begin
|
begin
|
The_Widget.Color := C;
|
The_Widget.Color := C;
|
end Set_Color;
|
end Set_Color;
|
-------------------------------------------------------------
|
-------------------------------------------------------------
|
procedure Set_Label (The_Widget : in out App1_Widget;
|
procedure Set_Label (The_Widget : in out App1_Widget;
|
L : in Widget_Label_Str) is
|
L : in Widget_Label_Str) is
|
begin
|
begin
|
The_Widget.Label := L;
|
The_Widget.Label := L;
|
end Set_Label;
|
end Set_Label;
|
-------------------------------------------------------------
|
-------------------------------------------------------------
|
procedure Set_Id (The_Widget : in out App1_Widget;
|
procedure Set_Id (The_Widget : in out App1_Widget;
|
I : in Widget_Id) is
|
I : in Widget_Id) is
|
begin
|
begin
|
The_Widget.Id := I;
|
The_Widget.Id := I;
|
end Set_Id;
|
end Set_Id;
|
-------------------------------------------------------------
|
-------------------------------------------------------------
|
procedure App1_Widget_Specific_Oper
|
procedure App1_Widget_Specific_Oper
|
(The_Widget : in out App1_Widget;
|
(The_Widget : in out App1_Widget;
|
I : in Widget_Id;
|
I : in Widget_Id;
|
C : in Widget_Color_Enum;
|
C : in Widget_Color_Enum;
|
L : in Widget_Label_Str) is
|
L : in Widget_Label_Str) is
|
begin
|
begin
|
Set_Color (The_Widget, C);
|
Set_Color (The_Widget, C);
|
Set_Label (The_Widget, L);
|
Set_Label (The_Widget, L);
|
Set_Id (The_Widget, I);
|
Set_Id (The_Widget, I);
|
end App1_Widget_Specific_Oper;
|
end App1_Widget_Specific_Oper;
|
|
|
end FA11B00; -- Application_One_Widget
|
end FA11B00; -- Application_One_Widget
|
|
|
