|
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: 20048 (0x4e50)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Boolean_Class;
with Bounded_String;
with Easy_X;
with Elementary_Functions;
with Errors;
with Integer_Class;
with String_Class;
package body Turtle_Class is
type Unary_Message is (Nul, En_Texte, Ton_X, Ton_Y, Ton_Angle, Ta_Plume,
Ta_Taille, Leve_Ta_Plume, Baisse_Ta_Plume,
Rentre_Chez_Toi, Va_Au_Centre, Duplique_Toi);
type Keyword_Message is (Nul, Ton_X, Ton_Y, Ton_Angle, Va_En_X_Y, Ta_Taille,
Avance, Recule, A_Droite, A_Gauche, Ton_X_Ton_Y);
Pi : constant Float := 3.1416;
subtype Radian is Float range 0.0 .. 2.0 * Pi;
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) = "TON_ANGLE" then
return Ton_Angle;
elsif Bounded_String.Image (The_Message) = "TA_PLUME" then
return Ta_Plume;
elsif Bounded_String.Image (The_Message) = "TA_TAILLE" then
return Ta_Taille;
elsif Bounded_String.Image (The_Message) = "BAISSE_TA_PLUME" then
return Baisse_Ta_Plume;
elsif Bounded_String.Image (The_Message) = "LEVE_TA_PLUME" then
return Leve_Ta_Plume;
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)) =
"TON_ANGLE:" then
Back := Ton_Angle;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"TA_TAILLE:" then
Back := Ta_Taille;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"A_DROITE:" then
Back := A_Droite;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"A_GAUCHE:" then
Back := A_Gauche;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"AVANCE:" then
Back := Avance;
elsif Bounded_String.Image (Message.Value (The_Message)) =
"RECULE:" then
Back := Recule;
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 Radians (This_Angle : Degre) return Radian is
begin
return Float (This_Angle) * Pi / 180.0;
end Radians;
function Create return Object.Reference is
begin
Iterator := Iterator + 1;
if Iterator <= Custom.Turtle_Max_Number then
return Object.Create (Object.Tortue, Iterator);
else
raise Errors.Max_Turtle_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_Turtle : Object.Reference;
begin
Current_Message := Convert_To_Unary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Turtle;
when Ton_X =>
return Integer_Class.Create (Turtle_Table
(Object.Get_Id (To_Object)).X);
when Ton_Y =>
return Integer_Class.Create (Turtle_Table
(Object.Get_Id (To_Object)).Y);
when Ton_Angle =>
return Integer_Class.Create
(Turtle_Table (Object.Get_Id (To_Object)).Angle);
when Ta_Plume =>
return Boolean_Class.Create
(Turtle_Table (Object.Get_Id (To_Object)).Marker);
when Ta_Taille =>
return Integer_Class.Create
(Turtle_Table (Object.Get_Id (To_Object)).Size);
when Leve_Ta_Plume =>
Turtle_Table (Object.Get_Id (To_Object)).Marker := False;
return Object.Void_Reference;
when Baisse_Ta_Plume =>
Turtle_Table (Object.Get_Id (To_Object)).Marker := True;
return Object.Void_Reference;
when Rentre_Chez_Toi =>
Turtle_Table (Object.Get_Id (To_Object)).X := 0;
Turtle_Table (Object.Get_Id (To_Object)).Y := 0;
Turtle_Table (Object.Get_Id (To_Object)).Angle := 0;
Easy_X.Move_To (Easy_X.Coordinate (Turtle_Table (Index).X),
Easy_X.Coordinate (Turtle_Table (Index).Y));
return Object.Void_Reference;
when Va_Au_Centre =>
Turtle_Table (Object.Get_Id (To_Object)).X :=
Natural (Custom.Width) / 2;
Turtle_Table (Object.Get_Id (To_Object)).Y :=
Natural (Custom.Height) / 2;
Easy_X.Move_To (Easy_X.Coordinate (Turtle_Table (Index).X),
Easy_X.Coordinate (Turtle_Table (Index).Y));
return Object.Void_Reference;
when Duplique_Toi =>
New_Turtle := Create;
Turtle_Table (Object.Get_Id (New_Turtle)).X :=
Turtle_Table (Object.Get_Id (To_Object)).X;
Turtle_Table (Object.Get_Id (New_Turtle)).Y :=
Turtle_Table (Object.Get_Id (To_Object)).Y;
Turtle_Table (Object.Get_Id (New_Turtle)).Angle :=
Turtle_Table (Object.Get_Id (To_Object)).Angle;
Turtle_Table (Object.Get_Id (New_Turtle)).Marker :=
Turtle_Table (Object.Get_Id (To_Object)).Marker;
Turtle_Table (Object.Get_Id (New_Turtle)).Size :=
Turtle_Table (Object.Get_Id (To_Object)).Size;
return New_Turtle;
when En_Texte =>
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
("Tortue no", Custom.
String_Max_Length));
Bounded_String.Append
(Current_Entexte, Integer'Image (Object.Get_Id (To_Object)));
if Turtle_Table (Object.Get_Id (To_Object)).Marker then
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(" baissee", Custom.
String_Max_Length));
else
Bounded_String.Append
(Current_Entexte,
Bounded_String.Value
(" levee", Custom.String_Max_Length));
end if;
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(". X:", Custom.String_Max_Length));
Bounded_String.Append
(Current_Entexte,
Integer'Image (Turtle_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 (Turtle_Table (Object.Get_Id (To_Object)).Y));
Bounded_String.Append
(Current_Entexte, Bounded_String.Value
(". Taille:", Custom.
String_Max_Length));
Bounded_String.Append
(Current_Entexte,
Integer'Image
(Turtle_Table (Object.Get_Id (To_Object)).Size));
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_Object : Object.Reference;
Current_Angle : Degre;
use Object; -- erreur sur egalite entre classe 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_Turtle;
when Ton_X =>
Turtle_Table (Index).X :=
Object.Get_Id (Current_Object);
when Ton_Y =>
Turtle_Table (Index).Y :=
Object.Get_Id (Current_Object);
when Ton_Angle =>
Turtle_Table (Index).Angle :=
Object.Get_Id (Current_Object);
when Ta_Taille =>
Turtle_Table (Index).Size :=
Object.Get_Id (Current_Object);
when A_Droite =>
Current_Angle :=
(Turtle_Table (Index).Angle +
Object.Get_Id (Current_Object)) mod 360;
Turtle_Table (Index).Angle := Current_Angle;
when A_Gauche =>
Current_Angle :=
(Turtle_Table (Index).Angle + 360 -
Object.Get_Id (Current_Object)) mod 360;
Turtle_Table (Index).Angle := Current_Angle;
when Avance =>
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
Turtle_Table (Index).X :=
Turtle_Table (Index).X +
Integer (Float
(Object.Get_Id (Current_Object)) *
Elementary_Functions.Cos
(Radians (Turtle_Table (Index).
Angle)));
Turtle_Table (Index).Y :=
Turtle_Table (Index).Y +
Integer (Float
(Object.Get_Id (Current_Object)) *
Elementary_Functions.Sin
(Radians (Turtle_Table (Index).
Angle)));
if Turtle_Table (Index).Marker then
Easy_X.Set_Pen (Easy_X.Dimension
(Turtle_Table (Index).Size));
Easy_X.Line_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
else
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
end if;
when Recule =>
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
Current_Angle :=
(Turtle_Table (Index).Angle + 180) mod 360;
Turtle_Table (Index).X :=
Turtle_Table (Index).X +
Integer (Float (Object.Get_Id
(Current_Object)) *
Elementary_Functions.Cos
(Radians (Current_Angle)));
Turtle_Table (Index).Y :=
Turtle_Table (Index).Y +
Integer (Float (Object.Get_Id
(Current_Object)) *
Elementary_Functions.Sin
(Radians (Current_Angle)));
if Turtle_Table (Index).Marker then
Easy_X.Set_Pen (Easy_X.Dimension
(Turtle_Table (Index).Size));
Easy_X.Line_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
else
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
end if;
when Va_En_X_Y =>
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
Turtle_Table (Index).X :=
Object.Get_Id (Current_Object);
Parameters.Next (With_Arguments);
case Object.Get_Class
(Parameters.Value (With_Arguments)) is
when Object.Entier =>
Turtle_Table (Index).Y :=
Object.Get_Id (Parameters.Value
(With_Arguments));
if Turtle_Table (Index).Marker then
Easy_X.Set_Pen
(Easy_X.Dimension
(Turtle_Table (Index).Size));
Easy_X.Line_To
(Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
else
Easy_X.Move_To
(Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
end if;
when others =>
raise
Errors.
Integer_Required_As_Argument_For_Turtle;
end case;
Easy_X.Move_To (Easy_X.Coordinate
(Turtle_Table (Index).X),
Easy_X.Coordinate
(Turtle_Table (Index).Y));
when Ton_X_Ton_Y =>
Turtle_Table (Index).X :=
Object.Get_Id (Current_Object);
Parameters.Next (With_Arguments);
case Object.Get_Class
(Parameters.Value (With_Arguments)) is
when Object.Entier =>
Turtle_Table (Index).Y :=
Object.Get_Id (Parameters.Value
(With_Arguments));
when others =>
raise
Errors.
Integer_Required_As_Argument_For_Turtle;
end case;
end case;
when others =>
raise Errors.Integer_Required_As_Argument_For_Turtle;
end case;
Message.Next (The_Message);
Parameters.Next (With_Arguments);
end loop;
Back_Object := Object.Void_Reference;
end Send;
end Turtle_Class;