|
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 - download
Length: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Displays, seg_0491ad
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Bounded_String, Lists;
with Symbols, Models, Erreur, Comps_Dictionary, Interprete;
package body Displays is
use Displays_List;
type Display_Index is
record
Node : Displays_List.Listiter;
end record;
function Create_Display
(N, A : String; T : Kind_Of_Display) return Display is
D : Display;
begin
Bounded_String.Free (D.Display_Value);
Bounded_String.Copy (D.Display_Value, N);
Bounded_String.Free (D.Display_Attribute);
Bounded_String.Copy (D.Display_Attribute, A);
D.Display_Type := T;
return D;
end Create_Display;
function Isequal (X, Y : in Display) return Boolean is
begin
declare
use Bounded_String;
begin
if (Image (X.Display_Value) = Image (Y.Display_Value)) and
(X.Display_Type = Y.Display_Type) then
return True;
else
return False;
end if;
end;
end Isequal;
procedure Dispose_Display (The_Display : in out Display) is
begin
Bounded_String.Free (The_Display.Display_Value);
Bounded_String.Free (The_Display.Display_Attribute);
end Dispose_Display;
procedure Destroy_Object is new Destroydeep (Dispose => Dispose_Display);
--Creation
procedure Create (D : in out Object) is
begin
D.Node := Create;
end Create;
function Image (S : Symbols.Object;
M : Models.Object;
C : Comps_Dictionary.Object;
D : Display) return String is
I : Display;
begin
I := Create_Display (Bounded_String.Image (D.Display_Value),
Bounded_String.Image (D.Display_Attribute), Var);
if Bounded_String.Image (I.Display_Value) = "COMP" then
Bounded_String.Free (I.Display_Value);
Bounded_String.Copy (I.Display_Value,
Interprete.First_Comp_Value (C));
if not Symbols.Has_Symbol
(S, Bounded_String.Image (I.Display_Value)) then
return ("???");
end if;
end if;
if Symbols.Get_Symbol_Type
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)) = "ENTIER" then
return Integer'Image
(Symbols.Get_Symbol_Value
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)));
elsif Symbols.Get_Symbol_Type
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)) = "CHAINE" then
return Symbols.Get_Symbol_Value (S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute));
elsif
Symbols.Get_Symbol_Type
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)) =
"BOOLEEN" then
if Symbols.Get_Symbol_Value
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)) then
return "VRAI";
else
return "FAUX";
end if;
elsif Symbols.Get_Symbol_Type
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)) = "ENUMERE" then
if Symbols.Is_Pointer (S,
Bounded_String.Image (I.Display_Value)) then
return Models.Enum_Image
(M, Models.Get_Field_Type_By_Name
(M, Symbols.Get_Symbol_Type_By_Name
(S, Symbols.Get_Pointer_Reference
(S, Bounded_String.Image
(I.Display_Value))),
Bounded_String.Image (I.Display_Attribute)),
Symbols.Get_Symbol_Value
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)));
else
return Models.Enum_Image
(M, Models.Get_Field_Type_By_Name
(M, Symbols.Get_Symbol_Type_By_Name
(S, Bounded_String.Image
(I.Display_Value)),
Bounded_String.Image (I.Display_Attribute)),
Symbols.Get_Symbol_Value
(S, M, Bounded_String.Image (I.Display_Value),
Bounded_String.Image (I.Display_Attribute)));
end if;
else
Erreur.Execution ("Elements d affichage incoherent");
end if;
end Image;
procedure Write (D : in Object;
S : Symbols.Object;
M : Models.Object;
C : Comps_Dictionary.Object
) is
Index : Display_Index;
Info : Display;
begin
if not Isempty (D.Node) then
declare
use Bounded_String;
begin
Index.Node := Makelistiter (D.Node);
while (More (Index.Node)) loop
Next (Index.Node, Info);
case Info.Display_Type is
when Str =>
Text_Io.Put (Bounded_String.Image
(Info.Display_Value));
when Var =>
Text_Io.Put (Displays.Image (S, M, C, Info));
end case;
end loop;
Text_Io.New_Line;
end;
else
raise Error_Display_Empty;
end if;
end Write;
--Modification
procedure Store (D : in out Object; A_String : String) is
begin
if not Isempty (D.Node) then
Attach (D.Node, Create_Display (A_String, A_String, Str));
else
Attach (Create_Display (A_String, A_String, Str), D.Node);
end if;
end Store;
procedure Store (D : in out Object;
Symbol_Name : String;
Attribute_Name : String) is
begin if not Isempty (D.Node) then
Attach (D.Node, Create_Display (Symbol_Name, Attribute_Name, Var));
else
Attach (Create_Display (Symbol_Name, Attribute_Name, Var), D.Node);
end if;
end Store;
--Liberation
procedure Dispose (D : in out Object) is
begin
if not Isempty (D.Node) then
Destroy_Object (D.Node);
end if;
end Dispose;
end Displays;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=25 rec1=00 rec2=01 rec3=036
[0x01] rec0=24 rec1=00 rec2=02 rec3=01a
[0x02] rec0=1b rec1=00 rec2=03 rec3=002
[0x03] rec0=1a rec1=00 rec2=04 rec3=044
[0x04] rec0=14 rec1=00 rec2=05 rec3=018
[0x05] rec0=24 rec1=00 rec2=06 rec3=01e
[0x06] rec0=1f rec1=00 rec2=07 rec3=002
[0x07] rec0=12 rec1=00 rec2=08 rec3=000
tail 0x2174d68d2865b464c7a88 0x42a00088462060003