3 -- Grant of Unlimited Rights
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
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.
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.
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
39 -- 06 Dec 94 SAIC ACVC 2.0
43 -- Simulates a fragment of an elevator operation application.
45 package FA13A00_0
is -- Building Manager
47 type Electrical_Power
is (Off
, V120
, V240
);
48 Power
: Electrical_Power
:= V120
;
50 -- other type definitions and procedure declarations in real application.
54 -- No bodies provided for FA13A00_0.
56 --==================================================================--
58 package FA13A00_1
is -- Basic Elevator Operations
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
;
65 TC_Operation
: boolean := true;
67 procedure Call
(F
: in Floor
; C
: in out Call_Waiting_Type
);
68 procedure Clear_Calls
(C
: in out Call_Waiting_Type
);
71 type Call_Waiting_Type
is array (Floor
) of boolean;
72 Call_Waiting
: Call_Waiting_Type
:= (others => false);
77 --==================================================================--
79 package body FA13A00_1
is
83 procedure Call
(F
: in Floor
; C
: in out Call_Waiting_Type
) is
88 --------------------------------------------
90 -- Clear all calls of the elevator.
92 procedure Clear_Calls
(C
: in out Call_Waiting_Type
) is
94 C
:= (others => false);
99 --==================================================================--
101 -- Private child package of an elevator application. This package calculates
102 -- how many floors to go up or down.
104 private package FA13A00_1
.FA13A00_2
is -- Floor Calculation
106 -- Other type definitions in real application.
108 procedure Up
(HowMany
: in Floor_No
);
110 procedure Down
(HowMany
: in Floor_No
);
112 end FA13A00_1
.FA13A00_2
;
114 --==================================================================--
116 package body FA13A00_1
.FA13A00_2
is
118 -- Go up from the current floor.
120 procedure Up
(HowMany
: in Floor_No
) is
122 Current_Floor
:= Floor
'val (Floor
'pos (Current_Floor
) + HowMany
);
125 --------------------------------------------
127 -- Go down from the current floor.
129 procedure Down
(HowMany
: in Floor_No
) is
131 Current_Floor
:= Floor
'val (Floor
'pos (Current_Floor
) - HowMany
);
134 end FA13A00_1
.FA13A00_2
;
136 --==================================================================--
138 -- Public child package of an elevator application. This package provides
139 -- the actual operation of the elevator.
141 package FA13A00_1
.FA13A00_3
is -- Move Elevator
143 -- Other type definitions in real application.
145 procedure Move_Elevator
(F
: in Floor
;
146 C
: in out Call_Waiting_Type
);
148 end FA13A00_1
.FA13A00_3
;
150 --==================================================================--
152 with FA13A00_1
.FA13A00_2
; -- Floor Calculation
154 package body FA13A00_1
.FA13A00_3
is
156 -- Going up or down depends on the current floor.
158 procedure Move_Elevator
(F
: in Floor
;
159 C
: in out Call_Waiting_Type
) is
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
);
171 end FA13A00_1
.FA13A00_3
;