1-- FA13A00.A
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- FOUNDATION DESCRIPTION:
27--      This foundation code is used to check visibility of separate
28--      subunit of child packages.
29--      Declares a package containing type definitions; package will be
30--      with'ed by the root of the elevator abstraction.
31--
32--      Declare an elevator abstraction in a parent root package which manages
33--      basic operations.  This package has a private part.  Declare a
34--      private child package which calculates the floors for going up or
35--      down.  Declare a public child package which provides the actual
36--      operations.
37--
38-- CHANGE HISTORY:
39--      06 Dec 94   SAIC    ACVC 2.0
40--
41--!
42
43-- Simulates a fragment of an elevator operation application.
44
45package FA13A00_0 is                      -- Building Manager
46
47   type Electrical_Power is (Off, V120, V240);
48   Power : Electrical_Power := V120;
49
50   -- other type definitions and procedure declarations in real application.
51
52end FA13A00_0;
53
54-- No bodies provided for FA13A00_0.
55
56     --==================================================================--
57
58package FA13A00_1 is                      -- Basic Elevator Operations
59
60   type Call_Waiting_Type is private;
61   type Floor is (Basement, Floor1, Floor2, Floor3, Penthouse);
62   type Floor_No is range Floor'Pos(Floor'First) .. Floor'Pos(Floor'Last);
63   Current_Floor : Floor   := Floor1;
64
65   TC_Operation  : boolean := true;
66
67   procedure Call (F : in Floor; C : in out Call_Waiting_Type);
68   procedure Clear_Calls (C : in out Call_Waiting_Type);
69
70private
71   type Call_Waiting_Type is array (Floor) of boolean;
72   Call_Waiting : Call_Waiting_Type := (others => false);
73
74end FA13A00_1;
75
76
77     --==================================================================--
78
79package body FA13A00_1 is
80
81   -- Call the elevator.
82
83   procedure Call (F : in Floor; C : in out Call_Waiting_Type) is
84   begin
85      C (F) := true;
86   end Call;
87
88   --------------------------------------------
89
90   -- Clear all calls of the elevator.
91
92   procedure Clear_Calls (C : in out Call_Waiting_Type) is
93   begin
94      C := (others => false);
95   end Clear_Calls;
96
97end FA13A00_1;
98
99     --==================================================================--
100
101-- Private child package of an elevator application.  This package calculates
102-- how many floors to go up or down.
103
104private package FA13A00_1.FA13A00_2 is    -- Floor Calculation
105
106   -- Other type definitions in real application.
107
108   procedure Up (HowMany : in Floor_No);
109
110   procedure Down (HowMany : in Floor_No);
111
112end FA13A00_1.FA13A00_2;
113
114     --==================================================================--
115
116package body FA13A00_1.FA13A00_2 is
117
118   -- Go up from the current floor.
119
120   procedure Up (HowMany : in Floor_No) is
121   begin
122      Current_Floor := Floor'val (Floor'pos (Current_Floor) + HowMany);
123   end Up;
124
125   --------------------------------------------
126
127   -- Go down from the current floor.
128
129   procedure Down (HowMany : in Floor_No) is
130   begin
131      Current_Floor := Floor'val (Floor'pos (Current_Floor) - HowMany);
132   end Down;
133
134end FA13A00_1.FA13A00_2;
135
136     --==================================================================--
137
138-- Public child package of an elevator application.  This package provides
139-- the actual operation of the elevator.
140
141package FA13A00_1.FA13A00_3 is            -- Move Elevator
142
143   -- Other type definitions in real application.
144
145   procedure Move_Elevator (F : in     Floor;
146                            C : in out Call_Waiting_Type);
147
148end FA13A00_1.FA13A00_3;
149
150     --==================================================================--
151
152with FA13A00_1.FA13A00_2;                 -- Floor Calculation
153
154package body FA13A00_1.FA13A00_3 is
155
156   -- Going up or down depends on the current floor.
157
158   procedure Move_Elevator (F : in     Floor;
159                            C : in out Call_Waiting_Type) is
160   begin
161      if F > Current_Floor then
162         FA13A00_1.FA13A00_2.Up (Floor'Pos (F) - Floor'Pos (Current_Floor));
163         FA13A00_1.Call (F, C);
164      elsif F < Current_Floor then
165         FA13A00_1.FA13A00_2.Down (Floor'Pos (Current_Floor) - Floor'Pos (F));
166         FA13A00_1.Call (F, C);
167      end if;
168
169   end Move_Elevator;
170
171end FA13A00_1.FA13A00_3;
172