|
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: 16487 (0x4067)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦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;