|
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: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Pen_Y, seg_034b97
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bounded_String;
with Class_Integer;
with Class_String;
with Message;
with String_Utilities;
with Text_Io;
package body Class_Pen_Y is
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Rentre_Chez_Toi, Ligne_Suivante, Ton_X, Ton_Y,
Ta_Fonte, Duplique, Detruit, En_Texte);
Token : E_Message;
package Bs renames Bounded_String;
An_Object : Object.Reference;
begin
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => This_Message)));
case Token is
when Rentre_Chez_Toi =>
Table (Object.Get (To)).X := 0;
Table (Object.Get (To)).Y := 0;
return To;
when Ligne_Suivante =>
Table (Object.Get (To)).X := 0;
Table (Object.Get (To)).Y :=
Table (Object.Get (To)).Y +
16 * Easy_Y.Fonts'Pos (Table (Object.Get (To)).Taille);
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).Y));
when Ton_X =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).X));
when Ton_Y =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).Y));
when Ta_Fonte =>
return Class_String.Create
(Easy_Y.Fonts'Image (Table (Object.Get (To)).Taille));
when Duplique =>
An_Object := Class_Pen_Y.Create;
Table (Object.Get (An_Object)).X := Table (Object.Get (To)).X;
Table (Object.Get (An_Object)).Y := Table (Object.Get (To)).Y;
return An_Object;
when Detruit =>
return Object.Void_Reference;
when En_Texte =>
Text_Io.Put ("Objet Pen (");
Text_Io.New_Line;
Text_Io.Put (" Classe =>");
Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" Objet =>");
Text_Io.Put (Object.Index'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" X =>");
Text_Io.Put (Integer'Image (Table (Object.Get (To)).X));
Text_Io.New_Line;
Text_Io.Put (" Y =>");
Text_Io.Put (Integer'Image (Table (Object.Get (To)).Y));
Text_Io.New_Line;
Text_Io.Put (" Fonte =>");
Text_Io.Put (Easy_Y.Fonts'Image
(Table (Object.Get (To)).Taille));
Text_Io.New_Line;
Text_Io.Put (" )");
Text_Io.New_Line (2);
return Object.Void_Reference;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end Send;
function Send (This_Message : Message.Binary; To : Object.Reference)
return Object.Reference is
type E_Message is (Avance, Ecrit, Fonte);
An_Object : Object.Reference;
A_Tiny_String : Object.Tiny_String;
The_Message : Message.Binary := This_Message;
Token : E_Message;
package Bs renames Bounded_String;
use Object;
Pas : Object.Index;
begin
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => The_Message)));
case Token is
when Avance =>
An_Object := Message.Get (The_Message);
A_Tiny_String := Message.Get (The_Message);
if Object.Get (An_Object) = E_Class (Integer_Class) then
Pas := Object.Get (An_Object);
Table (Object.Get (To)).X :=
Table (Object.Get (To)).X + Integer (Pas);
else
null;
end if;
return To;
when Ecrit =>
An_Object := Message.Get (The_Message);
A_Tiny_String := Class_String.Get (Object.Get (An_Object));
if Object.Get (An_Object) = Object.E_Class (String_Class) then
Easy_Y.Move_To (X => Easy_Y.Coordinate
(Table (Object.Get (To)).X),
Y => Easy_Y.Coordinate
(Table (Object.Get (To)).Y));
Easy_Y.Set_Font (To => Table (Object.Get (To)).Taille);
Easy_Y.Draw_String (The_String => Bs.Image (A_Tiny_String));
else
null;
end if;
return Object.Void_Reference;
when Fonte =>
An_Object := Message.Get (The_Message);
A_Tiny_String := Message.Get (The_Message);
if Object.Get (An_Object) = E_Class (Integer_Class) then
Table (Object.Get (To)).Taille :=
Easy_Y.Fonts'Val (Object.Get (An_Object));
else
null;
end if;
return To;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end Send;
function Send (This_Message : Message.Keyword; To : Object.Reference)
return Object.Reference is
type E_Message is (Va_En_X, Y);
An_Object : Object.Reference;
A_Tiny_String : Object.Tiny_String;
The_Message : Message.Keyword := This_Message;
Token : E_Message;
package Bs renames Bounded_String;
use Object;
Pas : Object.Index;
begin
Token := E_Message'Value (Bs.Image (Message.Get (The_Message)));
case Token is
when Va_En_X =>
An_Object := Message.Get (The_Message);
A_Tiny_String := Message.Get (The_Message);
if Object.Get (An_Object) = E_Class (Integer_Class) then
Pas := Object.Get (An_Object);
Table (Object.Get (To)).X := Integer (Pas);
Message.Next (The_Message);
if not Message.Is_Done (The_Message) then
An_Object := Message.Get (The_Message);
A_Tiny_String := Message.Get (The_Message);
if Bs.Image (A_Tiny_String) = "Y" then
if Object.Get (An_Object) =
E_Class (Integer_Class) then
Pas := Object.Get (An_Object);
Table (Object.Get (To)).Y := Integer (Pas);
else
null;
end if;
end if;
else
null;
end if;
end if;
return To;
when Y =>
An_Object := Message.Get (The_Message);
A_Tiny_String := Message.Get (The_Message);
if Object.Get (An_Object) = E_Class (Integer_Class) then
Pas := Object.Get (An_Object);
Table (Object.Get (To)).X := Integer (Pas);
Message.Next (The_Message);
if not Message.Is_Done (The_Message) then
An_Object := Message.Get (Argument_From => The_Message);
A_Tiny_String := Message.Get (Name_From => The_Message);
if Bs.Image (A_Tiny_String) = "Va_En_X" then
if Object.Get (An_Object) =
E_Class (Integer_Class) then
Pas := Object.Get (An_Object);
Table (Object.Get (To)).Y := Integer (Pas);
else
null;
end if;
end if;
else
null;
end if;
end if;
return To;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end Send;
function Create return Object.Reference is
use Object;
begin
Last := Last + 1;
return Object.Create (Class => Object.Pen_Class, Object => Last);
end Create;
function Image (An_Object : Object.Reference) return Object.Tiny_String is
use Object;
Chaine : Object.Tiny_String;
Valeur : Object.Index;
begin
Valeur := Object.Get (An_Object);
Bounded_String.Copy (Chaine, String_Utilities.Number_To_String
(Integer (Valeur)));
return Chaine;
end Image;
function Value (Chaine : Object.Tiny_String) return Object.Reference is
An_Object : Object.Reference;
Bool : Boolean;
Entier : Integer;
begin
String_Utilities.String_To_Number
(Source => Bounded_String.Image (V => Chaine),
Target => Entier,
Worked => Bool);
Object.Put (Object.Integer_Class, An_Object);
Object.Put (Object.Index (Entier), An_Object);
return An_Object;
end Value;
function How_Many return Object.Index is
begin
return Last;
end How_Many;
end Class_Pen_Y;
nblk1=f
nid=9
hdr6=1a
[0x00] rec0=1f rec1=00 rec2=01 rec3=058
[0x01] rec0=15 rec1=00 rec2=0d rec3=098
[0x02] rec0=1c rec1=00 rec2=08 rec3=040
[0x03] rec0=23 rec1=00 rec2=07 rec3=02e
[0x04] rec0=15 rec1=00 rec2=05 rec3=050
[0x05] rec0=1f rec1=00 rec2=0e rec3=002
[0x06] rec0=1d rec1=00 rec2=02 rec3=022
[0x07] rec0=00 rec1=00 rec2=0f rec3=002
[0x08] rec0=18 rec1=00 rec2=0b rec3=026
[0x09] rec0=1c rec1=00 rec2=04 rec3=040
[0x0a] rec0=01 rec1=00 rec2=0a rec3=01e
[0x0b] rec0=1d rec1=00 rec2=06 rec3=060
[0x0c] rec0=0c rec1=00 rec2=03 rec3=000
[0x0d] rec0=0f rec1=00 rec2=0f rec3=000
[0x0e] rec0=22 rec1=00 rec2=03 rec3=001
tail 0x21731148484d6975ddf2e 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 0c 01 7c 80 18 20 20 20 20 20 20 20 20 20 20 ┆ | ┆
0xc: 0000 00 00 00 17 80 14 20 20 20 20 20 20 20 20 20 20 ┆ ┆