|
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 - download
Length: 25600 (0x6400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Turtle_Class, seg_039302
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
Parameters.Free (With_Arguments);
Back_Object := Object.Void_Reference;
end Send;
end Turtle_Class;
nblk1=18
nid=3
hdr6=2e
[0x00] rec0=1c rec1=00 rec2=01 rec3=01a
[0x01] rec0=15 rec1=00 rec2=07 rec3=01a
[0x02] rec0=03 rec1=00 rec2=0e rec3=032
[0x03] rec0=15 rec1=00 rec2=0d rec3=05c
[0x04] rec0=15 rec1=00 rec2=16 rec3=04a
[0x05] rec0=1e rec1=00 rec2=11 rec3=040
[0x06] rec0=0d rec1=00 rec2=02 rec3=024
[0x07] rec0=12 rec1=00 rec2=18 rec3=078
[0x08] rec0=12 rec1=00 rec2=12 rec3=076
[0x09] rec0=12 rec1=00 rec2=05 rec3=028
[0x0a] rec0=15 rec1=00 rec2=0a rec3=004
[0x0b] rec0=16 rec1=00 rec2=13 rec3=040
[0x0c] rec0=11 rec1=00 rec2=14 rec3=046
[0x0d] rec0=12 rec1=00 rec2=0f rec3=036
[0x0e] rec0=0e rec1=00 rec2=0b rec3=068
[0x0f] rec0=0f rec1=00 rec2=09 rec3=072
[0x10] rec0=10 rec1=00 rec2=10 rec3=034
[0x11] rec0=0e rec1=00 rec2=06 rec3=082
[0x12] rec0=10 rec1=00 rec2=04 rec3=094
[0x13] rec0=10 rec1=00 rec2=15 rec3=04a
[0x14] rec0=0c rec1=00 rec2=17 rec3=058
[0x15] rec0=11 rec1=00 rec2=0c rec3=02e
[0x16] rec0=0c rec1=00 rec2=08 rec3=000
[0x17] rec0=0a rec1=00 rec2=0c rec3=000
tail 0x21532344084ec4c2eaf6a 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 00 02 41 80 12 65 74 5f 49 64 20 28 54 6f 5f ┆ A et_Id (To_┆