|
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: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Window, seg_0381a2
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Class_String;
with Class_Printer;
with Class_Integer;
with Block;
with Bounded_String;
with String_Utilities;
with Bug_Report;
package body Class_Window is
function Send (This_Message : Message.Keyword; To : Object.Reference)
return Object.Reference is
type E_Message is (Tonnom, Tonx, Tony, Talargeur, Tahauteur);
Token : E_Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
Mess : Message.Keyword := This_Message;
use Object;
begin
Message.Init (This => Mess);
while not Message.Is_Done_Name (Mess) loop
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => Mess)));
case Token is
when Tonnom =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.String_Class then
Easy_Y.Put_Title
(Table (Object.Get (Index_From => To)),
Class_String.Get
(Object.Get
(Index_From =>
Message.Get (Argument_From => Mess))));
else
raise Bug_Report.Window_Bad_Type;
end if;
when Tonx =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Easy_Y.Put_Left
(Table (Object.Get (Index_From => To)),
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess)));
else
raise Bug_Report.Window_Bad_Type;
end if;
when Tony =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Easy_Y.Put_Right
(Table (Object.Get (Index_From => To)),
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess)));
else
raise Bug_Report.Window_Bad_Type;
end if;
when Talargeur =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Easy_Y.Put_Width
(Table (Object.Get (Index_From => To)),
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess)));
else
raise Bug_Report.Window_Bad_Type;
end if;
when Tahauteur =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Easy_Y.Put_Height
(Table (Object.Get (Index_From => To)),
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess)));
else
raise Bug_Report.Window_Bad_Type;
end if;
end case;
Message.Next (Mess);
end loop;
return To;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Keyword_Message;
end Send;
function Send (This_Message : Message.Binary; To : Object.Reference)
return Object.Reference is
begin
raise Bug_Report.Unknown_Binary_Message;
return Object.Void_Reference;
end Send;
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Dupliquetoi, Tonnom, Tonx, Tony, Talargeur,
Tahauteur, Affichetoi, Cachetoi, Entexte);
Token : E_Message;
package Bs renames Bounded_String;
begin
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => This_Message)));
case Token is
when Dupliquetoi =>
returnCreate (From => Table (Object.Get (Index_From => To)));
when Tonnom =>
return Class_String.Create
(Easy_Y.Get_Title
(Table (Object.Get (Index_From => To))));
when Tonx =>
return Class_Integer.Create
(Easy_Y.Get_Left
(Table (Object.Get (Index_From => To))));
when Tony =>
return Class_Integer.Create
(Easy_Y.Get_Right
(Table (Object.Get (Index_From => To))));
when Talargeur =>
return Class_Integer.Create
(Easy_Y.Get_Width
(Table (Object.Get (Index_From => To))));
when Tahauteur =>
return Class_Integer.Create
(Easy_Y.Get_Height
(Table (Object.Get (Index_From => To))));
when Affichetoi =>
Easy_Y.Open (Bounded_String.Image (Terminal_Name),
Table (Object.Get (Index_From => To)));
Easy_Y.Update;
return To;
when Cachetoi =>
Easy_Y.Close (Table (Object.Get (Index_From => To)));
return To;
when Entexte =>
Put (To);
return To;
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Unary_Message;
end Send;
function Create (From : Easy_Y.Window_Type) return Object.Reference is
use Object;
begin
Last := Last + 1;
Easy_Y.Put_Title (Table (Last), Easy_Y.Get_Title (From));
Easy_Y.Put_Left (Table (Last), Easy_Y.Get_Left (From));
Easy_Y.Put_Right (Table (Last), Easy_Y.Get_Right (From));
Easy_Y.Put_Width (Table (Last), Easy_Y.Get_Width (From));
Easy_Y.Put_Height (Table (Last), Easy_Y.Get_Height (From));
return Object.Create (Class => Object.Window_Class, Object => Last);
exception
when Constraint_Error =>
raise Bug_Report.Full_Block_Table;
end Create;
procedure Create is
use Object;
Node : Block.Node := Block.Get_Current_Node;
begin
Last := Last + 1;
Block.Put_Into_Table
(This_Object => Object.Create
(Class => Object.Window_Class, Object => Last),
Named => Bounded_String.Value ("fenetre", 80),
Into_Block => Node);
Easy_Y.Put_Title (Table (1), Bounded_String.Value ("Tiny Talk", 80));
Easy_Y.Open (Bounded_String.Image (Terminal_Name), Table (1));
Easy_Y.Update;
end Create;
function Get (Index : Object.Index) return Easy_Y.Window_Type is
begin
return Table (Index);
end Get;
procedure Put (Window : Easy_Y.Window_Type; Index : Object.Index) is
begin
Table (Index) := Window;
end Put;
function Get_Terminal_Name return Object.Tiny_String is
begin
return Terminal_Name;
end Get_Terminal_Name;
procedure Put_Terminal_Name (What : Object.Tiny_String) is
begin
Bounded_String.Copy (Terminal_Name, What);
end Put_Terminal_Name;
procedure Put (An_Object : Object.Reference) is
begin
Class_Printer.Put ("Objet Fenetre {");
Class_Printer.Forward (4);
Class_Printer.New_Line;
Class_Printer.Put ("Numero => " &
Object.Index'Image (Object.Get
(Index_From => An_Object)));
Class_Printer.New_Line;
Class_Printer.Put
("Title => " & '"' &
Bounded_String.Image
(Easy_Y.Get_Title (Table (Object.Get (An_Object)))) & '"');
Class_Printer.New_Line;
Class_Printer.Put ("X => " &
Object.Index'Image
(Easy_Y.Get_Left (Table
(Object.Get (An_Object)))));
Class_Printer.New_Line;
Class_Printer.Put ("Y => " &
Object.Index'Image
(Easy_Y.Get_Right (Table
(Object.Get (An_Object)))));
Class_Printer.New_Line;
Class_Printer.Put ("Largeur => " &
Object.Index'Image
(Easy_Y.Get_Width (Table
(Object.Get (An_Object)))));
Class_Printer.New_Line;
Class_Printer.Put ("Hauteur => " &
Object.Index'Image
(Easy_Y.Get_Height
(Table (Object.Get (An_Object)))));
-- Class_Printer.New_Line;
-- Class_Printer.Put ("Block => ");
-- Class_Printer.Forward (4);
-- Class_Printer.New_Line;
-- Class_Block.Put
-- (Object.Create
-- (Class => Object.Block_Class,
-- Object => Table (Object.Get (Index_From => An_Object)).Block));
-- Class_Printer.Backward (8);
Class_Printer.New_Line;
Class_Printer.Backward (4);
Class_Printer.Put_Tab ("}");
Class_Printer.New_Line (2);
end Put;
end Class_Window;
nblk1=e
nid=d
hdr6=18
[0x00] rec0=22 rec1=00 rec2=01 rec3=098
[0x01] rec0=14 rec1=00 rec2=08 rec3=004
[0x02] rec0=14 rec1=00 rec2=0b rec3=01a
[0x03] rec0=13 rec1=00 rec2=03 rec3=02a
[0x04] rec0=1e rec1=00 rec2=09 rec3=02c
[0x05] rec0=00 rec1=00 rec2=0c rec3=002
[0x06] rec0=14 rec1=00 rec2=07 rec3=072
[0x07] rec0=19 rec1=00 rec2=0a rec3=076
[0x08] rec0=1c rec1=00 rec2=02 rec3=01a
[0x09] rec0=15 rec1=00 rec2=04 rec3=00c
[0x0a] rec0=14 rec1=00 rec2=06 rec3=036
[0x0b] rec0=17 rec1=00 rec2=05 rec3=000
[0x0c] rec0=24 rec1=00 rec2=0d rec3=4d7
[0x0d] rec0=00 rec1=00 rec2=00 rec3=002
tail 0x21531619084e67ce085c9 0x42a00088462060003
Free Block Chain:
0xd: 0000 00 0e 00 24 80 21 54 61 62 6c 65 20 28 4c 61 73 ┆ $ !Table (Las┆
0xe: 0000 00 00 00 05 80 02 65 3b 02 00 00 00 00 00 00 00 ┆ e; ┆