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 provides a basis for tagged type and dispatching
28 -- tests. Each test describes the utilizations.
31 -- 06 Dec 94 SAIC ACVC 2.0
32 -- 24 OCT 95 SAIC Updated for ACVC 2.0.1
36 package F392C00_1
is -- Switches
38 type Toggle
is tagged private; ---------------------------------- Toggle
40 function Create
return Toggle
;
41 procedure Flip
( It
: in out Toggle
);
42 function On
( It
: Toggle
'Class ) return Boolean;
43 function Off
( It
: Toggle
'Class ) return Boolean;
45 type Dimmer
is new Toggle
with private; ------------------------- Dimmer
47 type Luminance
is range 0..100;
49 function Create
return Dimmer
;
50 procedure Flip
( It
: in out Dimmer
);
51 procedure Brighten
( It
: in out Dimmer
;
52 By
: in Luminance
:= 10 );
53 procedure Dim
( It
: in out Dimmer
;
54 By
: in Luminance
:= 10 );
55 function Intensity
( It
: Dimmer
) return Luminance
;
57 type Auto_Dimmer
is new Dimmer
with private; --------------- Auto_Dimmer
59 function Create
return Auto_Dimmer
;
60 procedure Flip
( It
: in out Auto_Dimmer
);
61 procedure Set_Auto
( It
: in out Auto_Dimmer
);
62 procedure Clear_Auto
( It
: in out Auto_Dimmer
);
63 -- procedure Set_Manual( It: in out Auto_Dimmer ) renames Clear_Auto;
64 procedure Set_Cutin
( It
: in out Auto_Dimmer
; Lumens
: in Luminance
);
65 procedure Set_Cutout
( It
: in out Auto_Dimmer
; Lumens
: in Luminance
);
67 function Auto
( It
: Auto_Dimmer
) return Boolean;
68 function Cutout_Threshold
( It
: Auto_Dimmer
) return Luminance
;
69 function Cutin_Threshold
( It
: Auto_Dimmer
) return Luminance
;
71 function TC_CW_TI
( Key
: Character ) return Toggle
'Class;
73 function TC_Non_Disp
( It
: Toggle
) return Boolean;
74 function TC_Non_Disp
( It
: Dimmer
) return Boolean;
75 function TC_Non_Disp
( It
: Auto_Dimmer
) return Boolean;
79 type Toggle
is tagged record
80 On
: Boolean := False;
83 type Dimmer
is new Toggle
with record
84 Intensity
: Luminance
:= 100;
87 type Auto_Dimmer
is new Dimmer
with record
88 Cutout_Threshold
: Luminance
:= 60;
89 Cutin_Threshold
: Luminance
:= 40;
90 Auto_Engaged
: Boolean := False;
96 package body F392C00_1
is
98 function Create
return Toggle
is
100 TCTouch
.Touch
( '1' ); ------------------------------------------------ 1
101 return Toggle
'( On => True );
104 function Create return Dimmer is
106 TCTouch.Touch( '2' ); ------------------------------------------------ 2
107 return Dimmer'( On
=> True, Intensity
=> 75 );
110 function Create
return Auto_Dimmer
is
112 TCTouch
.Touch
( '3' ); ------------------------------------------------ 3
113 return Auto_Dimmer
'( On => True, Intensity => 25,
114 Cutout_Threshold | Cutin_Threshold => 50,
115 Auto_Engaged => True );
118 procedure Flip ( It : in out Toggle ) is
120 TCTouch.Touch( 'A
' ); ------------------------------------------------ A
124 function On( It : Toggle'Class ) return Boolean is
126 TCTouch.Touch( 'B
' ); ------------------------------------------------ B
130 function Off( It : Toggle'Class ) return Boolean is
132 TCTouch.Touch( 'C
' ); ------------------------------------------------ C
136 procedure Brighten( It : in out Dimmer;
137 By : in Luminance := 10 ) is
139 TCTouch.Touch( 'D
' ); ------------------------------------------------ D
140 if (It.Intensity+By) <= Luminance'Last then
141 It.Intensity := It.Intensity+By;
143 It.Intensity := Luminance'Last;
147 procedure Dim ( It : in out Dimmer;
148 By : in Luminance := 10 ) is
150 TCTouch.Touch( 'E
' ); ------------------------------------------------ E
151 if (It.Intensity-By) >= Luminance'First then
152 It.Intensity := It.Intensity-By;
154 It.Intensity := Luminance'First;
158 function Intensity( It : Dimmer ) return Luminance is
160 TCTouch.Touch( 'F
' ); ------------------------------------------------ F
164 return Luminance'First;
168 procedure Flip ( It : in out Dimmer ) is
170 TCTouch.Touch( 'G
' ); ------------------------------------------------ G
171 if On( It ) and (It.Intensity < 50) then
172 It.Intensity := Luminance'Last - It.Intensity;
174 Flip( Toggle( It ) );
178 procedure Set_Auto ( It: in out Auto_Dimmer ) is
180 TCTouch.Touch( 'H
' ); ------------------------------------------------ H
181 It.Auto_Engaged := True;
184 procedure Clear_Auto( It: in out Auto_Dimmer ) is
186 TCTouch.Touch( 'I
' ); ------------------------------------------------ I
187 It.Auto_Engaged := False;
190 function Auto ( It: Auto_Dimmer ) return Boolean is
192 TCTouch.Touch( 'J
' ); ------------------------------------------------ J
193 return It.Auto_Engaged;
196 procedure Flip ( It: in out Auto_Dimmer ) is
198 TCTouch.Touch( 'K
' ); ------------------------------------------------ K
199 if It.Auto_Engaged then
201 Flip( Dimmer( It ) );
203 It.Auto_Engaged := False;
206 Flip( Dimmer( It ) );
210 procedure Set_Cutin ( It : in out Auto_Dimmer;
211 Lumens : in Luminance) is
213 TCTouch.Touch( 'L
' ); ------------------------------------------------ L
214 It.Cutin_Threshold := Lumens;
217 procedure Set_Cutout( It : in out Auto_Dimmer;
218 Lumens : in Luminance) is
220 TCTouch.Touch( 'M
' ); ------------------------------------------------ M
221 It.Cutout_Threshold := Lumens;
224 function Cutout_Threshold( It : Auto_Dimmer ) return Luminance is
226 TCTouch.Touch( 'N
' ); ------------------------------------------------ N
227 return It.Cutout_Threshold;
228 end Cutout_Threshold;
230 function Cutin_Threshold ( It : Auto_Dimmer ) return Luminance is
232 TCTouch.Touch( 'O
' ); ------------------------------------------------ O
233 return It.Cutin_Threshold;
236 function TC_CW_TI( Key : Character ) return Toggle'Class is
238 TCTouch.Touch( 'W
' ); ------------------------------------------------ W
240 when 'T
' | 't
' => return Toggle'( On
=> True );
241 when 'D' |
'd' => return Dimmer
'( On => True, Intensity => 75 );
242 when 'A
' | 'a
' => return Auto_Dimmer'( On
=> True, Intensity
=> 25,
243 Cutout_Threshold | Cutin_Threshold
=> 50,
244 Auto_Engaged
=> True );
249 function TC_Non_Disp
( It
: Toggle
) return Boolean is
251 TCTouch
.Touch
( 'X' ); ------------------------------------------------ X
255 function TC_Non_Disp
( It
: Dimmer
) return Boolean is
257 TCTouch
.Touch
( 'Y' ); ------------------------------------------------ Y
261 function TC_Non_Disp
( It
: Auto_Dimmer
) return Boolean is
263 TCTouch
.Touch
( 'Z' ); ------------------------------------------------ Z