|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Qualit_Environement, package body Qualit_Visual_System, seg_04c80a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Slot;
with Qualit_Generic_Agent;
with System_Utilities;
with Time_Utilities;
package body Qualit_Environement is
use Slot;
type The_Agent_Ids is (Agent1, Agent2);
package Qualit_Visual_System is
procedure Set_Position (The_Agent : The_Agent_Ids;
The_Pos_Value : Slot.Object);
function Get_Position (The_Agent : The_Agent_Ids) return Slot.Object;
procedure Set_Position_Variation
(The_Agent : The_Agent_Ids; The_Variation : Slot.Object);
procedure Terminated (The_Agent : The_Agent_Ids);
end Qualit_Visual_System;
package The_First_Agent is
new Qualit_Generic_Agent
(Agent_Ids => The_Agent_Ids,
Inc_Max => Value (3), --cm/s
Inc_Min => Value (1),
Dec_Max => Value (3),
Dec_Min => Value (1),
Max_Up_Value => Value (10),
Max_Down_Value => Value (10),
Agent_Id => Agent1,
The_Other_Agent => Agent2,
Set_Position => Qualit_Visual_System.Set_Position,
Get_Position => Qualit_Visual_System.Get_Position,
Set_Position_Variation =>
Qualit_Visual_System.Set_Position_Variation,
Job_Terminated => Qualit_Visual_System.Terminated);
package The_Second_Agent is
new Qualit_Generic_Agent
(Agent_Ids => The_Agent_Ids,
Inc_Max => Value (2), -- cm/s
Inc_Min => Value (1),
Dec_Max => Value (2),
Dec_Min => Value (1),
Max_Up_Value => Value (8),
Max_Down_Value => Value (8),
Agent_Id => Agent2,
The_Other_Agent => Agent1,
Set_Position => Qualit_Visual_System.Set_Position,
Get_Position => Qualit_Visual_System.Get_Position,
Set_Position_Variation =>
Qualit_Visual_System.Set_Position_Variation,
Job_Terminated => Qualit_Visual_System.Terminated);
package body Qualit_Visual_System is
type Status is (Working, Terminated);
Agent_Positions : array (The_Agent_Ids) of Slot.Object :=
(others => Slot.Value (0));
The_Pos_Variations : array (The_Agent_Ids) of Slot.Object :=
(others => Slot.Value (1));
Agent_Status : array (The_Agent_Ids) of Status := (others => Working);
task Visual_System is
entry Set_Pos (The_Agent_Id : The_Agent_Ids;
The_Position : Slot.Object);
entry Get_Pos (The_Agent_Id : The_Agent_Ids;
The_Position : out Slot.Object);
entry Set_Pos_Variation (The_Agent_Id : The_Agent_Ids;
The_Variation : Slot.Object);
entry Terminated (The_Agent_Id : The_Agent_Ids);
end Visual_System;
procedure Update_Agent_Positions (The_Time : in out Duration) is
use Slot.Operators;
Delta_Time : Slot.Object;
Current_Time : Duration;
The_Interval : Time_Utilities.Interval;
Int_Time : Integer;
begin
Current_Time := System_Utilities.Elapsed;
The_Interval := Time_Utilities.Convert (Current_Time - The_Time);
Int_Time := Integer (The_Interval.Elapsed_Seconds);
-- if delta_time is less than one second then time should not be modified
if Int_Time > 0 then
Delta_Time := Slot.Value (Int_Time);
The_Time := Current_Time;
for The_Id in The_Agent_Ids'First .. The_Agent_Ids'Last loop
Agent_Positions (The_Id) :=
Agent_Positions (The_Id) +
(The_Pos_Variations (The_Id) * (Delta_Time));
end loop;
end if;
end Update_Agent_Positions;
task body Visual_System is
use Slot;
The_Id, Id : The_Agent_Ids;
The_Pos, The_Var : Slot.Object;
Done, No_Agent_Working : Boolean := False;
Time : Duration;
begin
The_Var := Null_Object;
Time := System_Utilities.Elapsed;
while (not Done) loop
select
accept Set_Pos (The_Agent_Id : The_Agent_Ids;
The_Position : Slot.Object) do
Agent_Positions (The_Agent_Id) := The_Position;
end Set_Pos;
or
accept Get_Pos (The_Agent_Id : The_Agent_Ids;
The_Position : out Slot.Object) do
The_Position := Agent_Positions (The_Agent_Id);
end Get_Pos;
or
accept
Set_Pos_Variation (The_Agent_Id : The_Agent_Ids;
The_Variation : Slot.Object) do
The_Id := The_Agent_Id;
The_Var := The_Variation;
end Set_Pos_Variation;
The_Pos_Variations (The_Id) := The_Var;
or
accept Terminated (The_Agent_Id : The_Agent_Ids) do
The_Id := The_Agent_Id;
end Terminated;
Agent_Status (The_Id) := Terminated;
Id := The_Agent_Ids'First;
No_Agent_Working := True;
while (No_Agent_Working) loop
if Agent_Status (Id) /= Terminated then
No_Agent_Working := False;
end if;
exit when Id = The_Agent_Ids'Last;
Id := The_Agent_Ids'Succ (Id);
end loop;
if No_Agent_Working then
Done := True;
The_First_Agent.Stop;
The_Second_Agent.Stop;
end if;
else
Update_Agent_Positions (Time);
end select;
end loop;
end Visual_System;
procedure Set_Position (The_Agent : The_Agent_Ids;
The_Pos_Value : Slot.Object) is
begin
Visual_System.Set_Pos (The_Agent, The_Pos_Value);
end Set_Position;
function Get_Position (The_Agent : The_Agent_Ids) return Slot.Object is
The_Pos : Slot.Object;
begin
Visual_System.Get_Pos (The_Agent, The_Pos);
return The_Pos;
end Get_Position;
procedure Set_Position_Variation
(The_Agent : The_Agent_Ids; The_Variation : Slot.Object) is
begin
Visual_System.Set_Pos_Variation (The_Agent, The_Variation);
end Set_Position_Variation;
procedure Terminated (The_Agent : The_Agent_Ids) is
begin
Visual_System.Terminated (The_Agent);
end Terminated;
end Qualit_Visual_System;
procedure Go (Position_To_Reach : Integer) is
begin
The_First_Agent.Go (Position_To_Reach);
The_Second_Agent.Go (Position_To_Reach);
end Go;
end Qualit_Environement;
nblk1=e
nid=5
hdr6=16
[0x00] rec0=21 rec1=00 rec2=01 rec3=040
[0x01] rec0=13 rec1=00 rec2=09 rec3=042
[0x02] rec0=16 rec1=00 rec2=04 rec3=050
[0x03] rec0=00 rec1=00 rec2=0e rec3=028
[0x04] rec0=16 rec1=00 rec2=07 rec3=020
[0x05] rec0=1a rec1=00 rec2=0d rec3=026
[0x06] rec0=14 rec1=00 rec2=03 rec3=028
[0x07] rec0=1c rec1=00 rec2=0c rec3=01c
[0x08] rec0=00 rec1=00 rec2=02 rec3=012
[0x09] rec0=20 rec1=00 rec2=06 rec3=03c
[0x0a] rec0=05 rec1=00 rec2=08 rec3=000
[0x0b] rec0=05 rec1=00 rec2=08 rec3=000
[0x0c] rec0=05 rec1=00 rec2=08 rec3=000
[0x0d] rec0=05 rec1=00 rec2=08 rec3=000
tail 0x217534b3e86dc3963f8a5 0x42a00088462063c03
Free Block Chain:
0x5: 0000 00 0a 00 31 80 2e 20 20 20 20 20 20 20 20 20 20 ┆ 1 . ┆
0xa: 0000 00 0b 00 04 80 01 20 01 00 23 20 20 20 20 20 20 ┆ # ┆
0xb: 0000 00 00 00 31 80 0a 4f 62 6a 65 63 74 29 20 64 6f ┆ 1 Object) do┆