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