|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 11818 (0x2e2a)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Bounded_String;
with Class_Integer;
with Class_String;
with Class_Printer;
with Class_Window;
with Block;
with Message;
with String_Utilities;
with Text_Io;
with Bug_Report;
package body Class_Pen is
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Petitetaille, Moyennetaille, Grandetaille,
Tafenetre, Rentrecheztoi, Tonx, Tony,
Tataille, Dupliquetoi, Detruistoi, Entexte);
Token : E_Message;
package Bs renames Bounded_String;
use Object;
begin
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => This_Message)));
case Token is
when Petitetaille =>
Table (Object.Get (Index_From => To)).Taille :=
Easy_Y.Small_Font;
return To;
when Moyennetaille =>
Table (Object.Get (Index_From => To)).Taille :=
Easy_Y.Medium_Font;
return To;
when Grandetaille =>
Table (Object.Get (Index_From => To)).Taille :=
Easy_Y.Large_Font;
return To;
when Tataille =>
return Class_String.Create
(E_Message'Image
(E_Message'Val
((Easy_Y.Fonts'Pos
(Table (Object.Get (To)).Taille)))));
when Tafenetre =>
return Object.Create
(Object.Window_Class,
Table (Object.Get (Index_From => To)).Fenetre);
when Rentrecheztoi =>
Table (Object.Get (To)).X := 0;
Table (Object.Get (To)).Y := 0;
Table (Object.Get (To)).Taille := Easy_Y.Small_Font;
return To;
when Tonx =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).X));
when Tony =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).Y));
when Dupliquetoi =>
return Create (To);
when Detruistoi =>
return Object.Void_Reference;
when Entexte =>
Put (To);
return To;
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Unary_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.Keyword; To : Object.Reference)
return Object.Reference is
type E_Message is (Tonx, Tony, Tafenetre, Vaenx, Y, Ecris);
Token : E_Message;
package Bs renames Bounded_String;
use Object;
Mess : Message.Keyword := This_Message;
begin
Message.Init (This => Mess);
while not Message.Is_Done_Name (Mess) loop
Token := E_Message'Value (Bs.Image (Message.Get (Mess)));
case Token is
when Tafenetre =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Window_Class then
Table (Object.Get (Index_From => To)).Fenetre :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Pen_Bad_Type;
end if;
when Tonx =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Pen_Bad_Type;
end if;
when Tony =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Pen_Bad_Type;
end if;
when Vaenx =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
Message.Next (Mess);
if not Message.Is_Done (Mess) then
if Bs.Image (Message.Get (Name_From => Mess)) =
"Y" then
if Object.Get
(Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess));
else
raise Bug_Report.Pen_Bad_Type;
end if;
end if;
else
raise Bug_Report.Pen_Bad_Type;
end if;
end if;
when Y =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
Message.Next (Mess);
if not Message.Is_Done (Mess) then
if Bs.Image (Message.Get (Name_From => Mess)) =
"VaEnX" then
if Object.Get
(Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess));
else
raise Bug_Report.Pen_Bad_Type;
end if;
end if;
else
raise Bug_Report.Pen_Bad_Type;
end if;
end if;
when Ecris =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.String_Class then
Easy_Y.Set_Display
(Class_Window.Get
(Index => Table (Object.Get (Index_From => To)).
Fenetre));
Easy_Y.Put_Font
(To => Table (Object.Get (Index_From => To)).Taille);
Easy_Y.Print
(X1 => Table (Object.Get (Index_From => To)).X,
Y1 => Table (Object.Get (Index_From => To)).Y,
The_String =>
Class_String.Get
(Object.Get (Index_From =>
Message.Get
(Argument_From => Mess))));
else
raise Bug_Report.Pen_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 Create (From : Object.Reference) return Object.Reference is
use Object;
begin
Last := Last + 1;
Table (Last) := Table (Object.Get (From));
return Object.Create (Class => Object.Pen_Class, Object => Last);
exception
when Constraint_Error =>
raise Bug_Report.Full_Pen_Table;
end Create;
procedure Create is
use Object;
Node : Block.Node := Block.Get_Current_Node;
Str : Object.Tiny_String;
begin
Last := Last + 1;
Block.Put_Into_Table
(This_Object => Object.Create
(Class => Object.Pen_Class, Object => Last),
Named => Bounded_String.Value ("stylo", 80),
Into_Block => Node);
exception
when Constraint_Error =>
raise Bug_Report.Full_Pen_Table;
end Create;
procedure Put (An_Object : Object.Reference) is
begin
Class_Printer.Put ("Objet Stylo {");
Class_Printer.Forward (4);
Class_Printer.New_Line;
Class_Printer.Put ("Numero => " &
Object.Index'Image (Object.Get (An_Object)));
Class_Printer.New_Line;
Class_Printer.Put ("X => " & Object.Index'Image
(Table (Object.Get (An_Object)).X));
Class_Printer.New_Line;
Class_Printer.Put ("Y => " & Object.Index'Image
(Table (Object.Get (An_Object)).Y));
Class_Printer.New_Line;
Class_Printer.Put ("Taille Police => ");
case Table (Object.Get (An_Object)).Taille is
when Easy_Y.Small_Font =>
Class_Printer.Put ("Petite Taille");
when Easy_Y.Medium_Font =>
Class_Printer.Put ("Moyenne Taille");
when Easy_Y.Large_Font =>
Class_Printer.Put ("Grande Taille");
end case;
Class_Printer.New_Line;
Class_Printer.Put ("Fenetre => ");
Class_Printer.New_Line;
Class_Printer.Forward (4);
Class_Window.Put (Object.Create
(Object.Window_Class,
Table (Object.Get (An_Object)).Fenetre));
Class_Printer.Backward (8);
Class_Printer.Put_Tab ("}");
Class_Printer.New_Line (2);
end Put;
function How_Many return Object.Index is
begin
return Last;
end How_Many;
end Class_Pen;