|
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: 23552 (0x5c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Pen_Class, seg_039305, seg_03940c, seg_03955e
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦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 Errors;
with Integer_Class;
with String_Class;
package body Pen_Class is
type Unary_Message is (Nul, En_Texte, Ton_X, Ton_Y, Ta_Taille, Fin, Moyen,
Epais, Rentre_Chez_Toi, Va_Au_Centre, Duplique_Toi);
type Keyword_Message is (Nul, Ton_X, Ton_Y, Va_En_X_Y, Ecris, Ton_X_Ton_Y,
En_Haut, En_Bas, A_Gauche, A_Droite);
Iterator : Natural := 0;
function Convert_To_Unary
(The_Message : Scanner.Lexeme) return Unary_Message is
begin
if Bounded_String.Image (The_Message) = "TON_X" then
return Ton_X;
elsif Bounded_String.Image (The_Message) = "TON_Y" then
return Ton_Y;
elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
return En_Texte;
elsif Bounded_String.Image (The_Message) = "FIN" then
return Fin;
elsif Bounded_String.Image (The_Message) = "MOYEN" then
return Moyen;
elsif Bounded_String.Image (The_Message) = "EPAIS" then
return Epais;
elsif Bounded_String.Image (The_Message) = "TA_TAILLE" then
return Ta_Taille;
elsif Bounded_String.Image (The_Message) = "RENTRE_CHEZ_TOI" then
return Rentre_Chez_Toi;
elsif Bounded_String.Image (The_Message) = "VA_AU_CENTRE" then
return Va_Au_Centre;
elsif Bounded_String.Image (The_Message) = "DUPLIQUE_TOI" then
return Duplique_Toi;
else
return Nul;
end if;
end Convert_To_Unary;
procedure Convert_To_List (The_Message : in out Message.Selector;
Back : out Keyword_Message) is
begin
Back := Nul;
case Message.Arg_Number (The_Message) is
when 1 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"TON_X:" then
Back := Ton_X;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"TON_Y:" then
Back := Ton_Y;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"ECRIS:" then
Back := Ecris;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"EN_HAUT:" then
Back := En_Haut;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"EN_BAS:" then
Back := En_Bas;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"A_GAUCHE:" then
Back := A_Gauche;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"A_DROITE:" then
Back := A_Droite;
end if;
when 2 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"VA_EN_X:" then
Message.Next (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"Y:" then
Back := Va_En_X_Y;
end if;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"TON_X:" then
Message.Next (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"TON_Y:" then
Back := Ton_X_Ton_Y;
end if;
end if;
when others =>
null;
end case;
end Convert_To_List;
function Create return Object.Reference is
begin
Iterator := Iterator + 1;
if Iterator <= Custom.Pen_Max_Number then
return Object.Create (Object.Stylo, Iterator);
else
raise Errors.Max_Pen_Number_Exceeded;
end if;
end Create;
function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
return Object.Reference is
Current_Message : Unary_Message := Nul;
Index : Integer := Object.Get_Id (To_Object);
Current_Entexte : Scanner.Lexeme;
New_Pen : Object.Reference;
begin
Current_Message := Convert_To_Unary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Pen;
when Ton_X =>
return Integer_Class.Create (Pen_Table
(Object.Get_Id (To_Object)).X);
when Ton_Y =>
return Integer_Class.Create (Pen_Table
(Object.Get_Id (To_Object)).Y);
when Fin =>
Pen_Table (Index).Width := Easy_X.Small_Font;
return Object.Void_Reference;
when Moyen =>
Pen_Table (Index).Width := Easy_X.Medium_Font;
return Object.Void_Reference;
when Epais =>
Pen_Table (Index).Width := Easy_X.Large_Font;
return Object.Void_Reference;
when Ta_Taille =>
case Pen_Table (Object.Get_Id (To_Object)).Width is
when Easy_X.Small_Font =>
return String_Class.Create ("Fin");
when Easy_X.Medium_Font =>
return String_Class.Create ("Moyen");
when Easy_X.Large_Font =>
return String_Class.Create ("Epais");
end case;
when Rentre_Chez_Toi =>
Pen_Table (Object.Get_Id (To_Object)).X := 0;
Pen_Table (Object.Get_Id (To_Object)).Y := 0;
Easy_X.Move_To (Easy_X.Coordinate (Pen_Table (Index).X),
Easy_X.Coordinate (Pen_Table (Index).Y));
return Object.Void_Reference;
when Va_Au_Centre =>
Pen_Table (Object.Get_Id (To_Object)).X :=
Natural (Custom.Width) / 2;
Pen_Table (Object.Get_Id (To_Object)).Y :=
Natural (Custom.Height) / 2;
Easy_X.Move_To (Easy_X.Coordinate (Pen_Table (Index).X),
Easy_X.Coordinate (Pen_Table (Index).Y));
return Object.Void_Reference;
when Duplique_Toi =>
New_Pen := Create;
Pen_Table (Object.Get_Id (New_Pen)).X :=
Pen_Table (Object.Get_Id (To_Object)).X;
Pen_Table (Object.Get_Id (New_Pen)).Y :=
Pen_Table (Object.Get_Id (To_Object)).Y;
Pen_Table (Object.Get_Id (New_Pen)).Width :=
Pen_Table (Object.Get_Id (To_Object)).Width;
return New_Pen;
when En_Texte =>
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
("Stylo no", Custom.String_Max_Length));
Bounded_String.Append
(Current_Entexte, Integer'Image (Object.Get_Id (To_Object)));
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(". X:", Custom.String_Max_Length));
Bounded_String.Append
(Current_Entexte,
Integer'Image (Pen_Table (Object.Get_Id (To_Object)).X));
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(". Y:", Custom.String_Max_Length));
Bounded_String.Append
(Current_Entexte,
Integer'Image (Pen_Table (Object.Get_Id (To_Object)).Y));
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(". Font: ", Custom.String_Max_Length));
case Pen_Table (Object.Get_Id (To_Object)).Width is
when Easy_X.Small_Font =>
Bounded_String.Append
(Current_Entexte,
Bounded_String.Value
("Fin", Custom.String_Max_Length));
when Easy_X.Medium_Font =>
Bounded_String.Append
(Current_Entexte,
Bounded_String.Value
("Moyen", Custom.String_Max_Length));
when Easy_X.Large_Font =>
Bounded_String.Append
(Current_Entexte,
Bounded_String.Value
("Epais", Custom.String_Max_Length));
end case;
return String_Class.Create (Current_Entexte);
end case;
end Send;
procedure Send (To_Object : Object.Reference;
The_Message : in out Message.Selector;
With_Arguments : in out Parameters.List;
Back_Object : out Object.Reference) is
Current_Message : Keyword_Message;
Index : Integer := Object.Get_Id (To_Object);
Current_Number : Integer;
Current_Object : Object.Reference;
use Object; -- erreur sur egalite entre classes d'objets si absent
begin
Message.Init (The_Message);
Parameters.Init (With_Arguments);
while not Message.Done (The_Message) loop
Current_Object := Parameters.Value (With_Arguments);
case Object.Get_Class (Current_Object) is
when Object.Entier =>
Convert_To_List (The_Message, Current_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Pen;
when Ton_X =>
Pen_Table (Index).X :=
Object.Get_Id (Current_Object);
when Ton_Y =>
Pen_Table (Index).Y :=
Object.Get_Id (Current_Object);
when En_Haut =>
Current_Number := Pen_Table (Index).Y -
Object.Get_Id (Current_Object);
if Current_Number < 0 then
Current_Number := 0;
end if;
Pen_Table (Index).Y := Natural (Current_Number);
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
when En_Bas =>
Current_Number := Pen_Table (Index).Y +
Object.Get_Id (Current_Object);
if Current_Number > Integer (Custom.Height) then
Current_Number := Integer (Custom.Height);
end if;
Pen_Table (Index).Y := Natural (Current_Number);
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
when A_Gauche =>
Current_Number := Pen_Table (Index).X -
Object.Get_Id (Current_Object);
if Current_Number < 0 then
Current_Number := 0;
end if;
Pen_Table (Index).X := Natural (Current_Number);
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
when A_Droite =>
Current_Number := Pen_Table (Index).X +
Object.Get_Id (Current_Object);
if Current_Number > Integer (Custom.Width) then
Current_Number := Integer (Custom.Width);
end if;
Pen_Table (Index).X := Natural (Current_Number);
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
when Va_En_X_Y =>
Pen_Table (Index).X :=
Object.Get_Id (Current_Object);
Parameters.Next (With_Arguments);
if Object.Get_Class
(Parameters.Value (With_Arguments)) =
Object.Entier then
Pen_Table (Index).Y :=
Object.Get_Id (Parameters.Value
(With_Arguments));
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
else
raise Errors.
Integer_Required_As_Argument_For_Pen;
end if;
when Ton_X_Ton_Y =>
Pen_Table (Index).X :=
Object.Get_Id (Current_Object);
Parameters.Next (With_Arguments);
if Object.Get_Class
(Parameters.Value (With_Arguments)) =
Object.Entier then
Pen_Table (Index).Y :=
Object.Get_Id (Parameters.Value
(With_Arguments));
else
raise Errors.
Integer_Required_As_Argument_For_Pen;
end if;
when Ecris =>
raise Errors.String_Required_As_Argument_For_Pen;
end case;
when Object.Chaine =>
Convert_To_List (The_Message, Current_Message);
case Current_Message is
when Ecris =>
Easy_X.Move_To (Easy_X.Coordinate
(Pen_Table (Index).X),
Easy_X.Coordinate
(Pen_Table (Index).Y));
Easy_X.Set_Font (Pen_Table (Index).Width);
Easy_X.Draw_String (Bounded_String.Image
(String_Class.Get_Value
(Current_Object)));
when others =>
raise Errors.String_Required_As_Argument_For_Pen;
end case;
when others =>
raise Errors.Integer_Required_As_Argument_For_Pen;
end case;
Message.Next (The_Message);
Parameters.Next (With_Arguments);
end loop;
Back_Object := Object.Void_Reference;
end Send;
function Get_For_Error return Object.Reference is
begin
return Object.Create (Object.Stylo, 1);
end Get_For_Error;
end Pen_Class;
nblk1=16
nid=11
hdr6=24
[0x00] rec0=1a rec1=00 rec2=01 rec3=026
[0x01] rec0=18 rec1=00 rec2=09 rec3=044
[0x02] rec0=14 rec1=00 rec2=16 rec3=01e
[0x03] rec0=19 rec1=00 rec2=08 rec3=012
[0x04] rec0=19 rec1=00 rec2=0e rec3=00a
[0x05] rec0=14 rec1=00 rec2=15 rec3=01c
[0x06] rec0=11 rec1=00 rec2=0d rec3=070
[0x07] rec0=14 rec1=00 rec2=04 rec3=01c
[0x08] rec0=13 rec1=00 rec2=14 rec3=010
[0x09] rec0=16 rec1=00 rec2=0b rec3=04a
[0x0a] rec0=01 rec1=00 rec2=03 rec3=024
[0x0b] rec0=12 rec1=00 rec2=07 rec3=036
[0x0c] rec0=0f rec1=00 rec2=06 rec3=062
[0x0d] rec0=10 rec1=00 rec2=0f rec3=046
[0x0e] rec0=0f rec1=00 rec2=0c rec3=06c
[0x0f] rec0=11 rec1=00 rec2=10 rec3=03e
[0x10] rec0=12 rec1=00 rec2=02 rec3=05c
[0x11] rec0=18 rec1=00 rec2=05 rec3=000
[0x12] rec0=02 rec1=00 rec2=11 rec3=000
[0x13] rec0=00 rec1=00 rec2=00 rec3=000
[0x14] rec0=00 rec1=00 rec2=00 rec3=000
[0x15] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21532347884ec4c56f312 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 0a 00 13 80 0a 50 65 6e 5f 43 6c 61 73 73 3b ┆ Pen_Class;┆
0xa: 0000 00 13 03 fc 80 1f 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0x13: 0000 00 12 00 29 80 22 67 65 20 28 4d 65 73 73 61 67 ┆ ) "ge (Messag┆
0x12: 0000 00 00 03 fc 80 29 53 74 72 69 6e 67 2e 49 6d 61 ┆ )String.Ima┆