|
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: 21504 (0x5400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Turtle_Class, seg_036e7e
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Integer_Class;
with String_Class;
with Elementary_Functions;
use Elementary_Functions;
with Bounded_String;
with Symbol;
with Counter;
with Bug;
with Text_Io;
package body Turtle_Class is
type Turtle_Unary_Message is (Petit, Moyen, Large, Entexte,
Tonx, Tony, Tonangle, Levetaplume,
Baissetaplume, Rentrecheztoi, Clone);
type Turtle_Keyword_Message is (Adroite, Agauche, Avance, Recule,
Vaenx, Y, Tonx, Tony, Tonangle);
Max_Table : constant := 10;
Void_Turtle : constant Object_Turtle := (State => False,
X => 0,
Y => 0,
Head_State => False,
Angle => 0,
Size => 1);
subtype Index_Table is Positive range 1 .. Max_Table;
Turtle_Table : array (Index_Table) of Object_Turtle;
package Bs renames Bounded_String;
function Id (From : Object.Reference) return Integer is
use Object;
begin
return Object.Get_Value (From_Object => From);
end Id;
function Convert (I : Direction) return Float is
The_Value : Float;
Pi : constant Float := 3.14159;
begin
The_Value := Float (I);
return ((Pi * The_Value) / 180.0);
end Convert;
function Free_Index return Index_Table is
Index : Index_Table := 1;
begin
loop
exit when (Turtle_Table (Index) = Void_Turtle);
if Index = Max_Table then
raise Bug.Too_Many_Turtles;
end if;
Index := Index + 1;
end loop;
return (Index);
end Free_Index;
function Get_Turtle (From : Object.Reference) return Object_Turtle is
begin
return Turtle_Table (Id (From => From));
end Get_Turtle;
procedure Refresh (The_Object : Object.Reference) is
The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
begin
Easy_X.Move_To (X => The_Turtle.X, Y => The_Turtle.Y);
end Refresh;
function Move (The_Object : Object.Reference) return Object.Reference is
The_Turtle : Object_Turtle;
begin
The_Turtle := Get_Turtle (From => The_Object);
Easy_X.Set_Pen (Size => The_Turtle.Size);
if The_Turtle.Head_State then
Easy_X.Line_To (X => The_Turtle.X, Y => The_Turtle.Y);
else
Easy_X.Move_To (X => The_Turtle.X, Y => The_Turtle.Y);
end if;
return The_Object;
end Move;
procedure Reset is
begin
for I in Turtle_Table'Range loop
Turtle_Table (I) := Void_Turtle;
end loop;
end Reset;
function Create (The_Name : Message.Tiny_String) return Object.Reference is
New_Object : Object.Reference;
New_Turtle : Object_Turtle := Void_Turtle;
Index : Index_Table;
begin
Index := Free_Index;
New_Turtle.State := True;
Turtle_Table (Index) := New_Turtle;
New_Object := Object.Create (Ident_Class => Object.Turtle_Class,
Ident_Object => Index);
Symbol.Insert (Name => The_Name, New_Reference => New_Object);
return New_Object;
end Create;
procedure Create_Default is
The_Name : Message.Tiny_String;
The_Turtle : Object.Reference;
begin
Bs.Free (V => The_Name);
Bs.Append (The_Name, "Tortue");
The_Turtle := Create (The_Name);
end Create_Default;
function Clone (The_Object : Object.Reference) return Object.Reference is
The_New_Turtle : Object_Turtle;
New_Index : Index_Table;
New_Object : Object.Reference;
begin
The_New_Turtle := Get_Turtle (From => The_Object);
New_Index := Free_Index;
Turtle_Table (New_Index) := The_New_Turtle;
New_Object := Object.Create (Ident_Class => Object.Turtle_Class,
Ident_Object => New_Index);
return New_Object;
end Clone;
function Get_X (The_Object : Object.Reference) return Object.Reference is
The_Turtle : Object_Turtle := Void_Turtle;
Get_X_Value : Integer;
begin
The_Turtle := Get_Turtle (From => The_Object);
Get_X_Value := Integer (The_Turtle.X);
return Integer_Class.Create (Value => Get_X_Value);
end Get_X;
function Get_Y (The_Object : Object.Reference) return Object.Reference is
The_Turtle : Object_Turtle := Void_Turtle;
Get_Y_Value : Integer;
begin
The_Turtle := Get_Turtle (From => The_Object);
Get_Y_Value := Integer (The_Turtle.Y);
return Integer_Class.Create (Value => Get_Y_Value);
end Get_Y;
function Get_Direction (The_Object : Object.Reference)
return Object.Reference is
The_Turtle : Object_Turtle := Void_Turtle;
Get_Direction_Value : Integer;
begin
The_Turtle := Get_Turtle (From => The_Object);
Get_Direction_Value := Integer (The_Turtle.Angle);
return Integer_Class.Create (Value => Get_Direction_Value);
end Get_Direction;
function Head_Up (The_Object : Object.Reference) return Object.Reference is
Index : Integer := Id (From => The_Object);
begin
Turtle_Table (Index).Head_State := False;
return The_Object;
end Head_Up;
function Head_Down (The_Object : Object.Reference)
return Object.Reference is
Index : Integer := Id (From => The_Object);
begin
Turtle_Table (Index).Head_State := True;
return The_Object;
end Head_Down;
procedure In_Text (The_Object : Object.Reference) is
The_Turtle : Object_Turtle := Get_Turtle (The_Object);
The_String, Pas, N : Message.Tiny_String;
begin
if not The_Turtle.State then
Bs.Copy (Pas, " pas ");
Bs.Copy (N, " n' ");
end if;
Object.In_Text (The_Object);
Bs.Copy (The_String, " Voici mon X: " &
Easy_X.Coordinate'Image (The_Turtle.X));
Bs.Append (The_String, " ,mon Y: " &
Easy_X.Coordinate'Image (The_Turtle.Y));
Bs.Append (The_String, " ,mon Angle: " &
Direction'Image (The_Turtle.Angle));
Bs.Append (The_String, "; Ma Tete ");
Bs.Append (The_String, N);
Bs.Append (The_String, "est");
Bs.Append (The_String, Pas);
Bs.Append (The_String, " levee .");
Text_Io.Put_Line (Bs.Image (The_String));
end In_Text;
function Go_Home (The_Object : Object.Reference) return Object.Reference is
The_Turtle : Object_Turtle := Void_Turtle;
Index : Integer := Id (From => The_Object);
begin
The_Turtle := Get_Turtle (From => The_Object);
The_Turtle := Void_Turtle;
Turtle_Table (Index) := The_Turtle;
return Move (The_Object);
end Go_Home;
function Set_X (The_Object, X : Object.Reference) return Object.Reference is
X_Position : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if (Object.Get_Class (X) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
X_Position := Object.Get_Value (X);
Turtle_Table (Index).X := Easy_X.Coordinate (X_Position);
return The_Object;
end Set_X;
function Set_Y (The_Object, Y : Object.Reference) return Object.Reference is
Y_Position : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if Object.Get_Class (Y) /= Object.Integer_Class then
raise Bug.Mismatch_Type;
end if;
Y_Position := Object.Get_Value (Y);
Turtle_Table (Index).Y := Easy_X.Coordinate (Y_Position);
return The_Object;
end Set_Y;
function Goto_Xy (The_Object, X, Y : Object.Reference)
return Object.Reference is
Y_Position : Integer;
X_Position : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if (Object.Get_Class (X) /= Object.Integer_Class) or
(Object.Get_Class (Y) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Y_Position := Object.Get_Value (Y);
X_Position := Object.Get_Value (X);
Turtle_Table (Index).X := Easy_X.Coordinate (X_Position);
Turtle_Table (Index).Y := Easy_X.Coordinate (Y_Position);
return Move (The_Object => The_Object);
end Goto_Xy;
function Set_Direction (The_Object, Get_Direction : Object.Reference)
return Object.Reference is
Get_Direction_Value : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if (Object.Get_Class (Get_Direction) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Get_Direction_Value := Object.Get_Value (Get_Direction);
if Get_Direction_Value < 0 then
Get_Direction_Value := (Get_Direction_Value + 360);
end if;
Turtle_Table (Index).Angle := (Direction (Get_Direction_Value)) mod 360;
return The_Object;
end Set_Direction;
function Set_Size (The_Object : Object.Reference;
The_Size : Turtle_Unary_Message)
return Object.Reference is
Index : Integer := Id (From => The_Object);
begin
case The_Size is
when Petit =>
Turtle_Table (Index).Size := 1;
when Moyen =>
Turtle_Table (Index).Size := 2;
when Large =>
Turtle_Table (Index).Size := 3;
when others =>
null;
end case;
return The_Object;
end Set_Size;
function Go (The_Object, The_Movement : Object.Reference; Go_Back : Boolean)
return Object.Reference is
use Easy_X.Arithmetic;
The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
Movement : Integer;
Current_X : Easy_X.Coordinate := The_Turtle.X;
Current_Y : Easy_X.Coordinate := The_Turtle.Y;
Current_Angle : Direction := The_Turtle.Angle;
Index : Integer := Id (From => The_Object);
Result_X : Float;
Result_Y : Float;
X, Y : Integer;
use Object;
begin
if (Object.Get_Class (The_Movement) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Movement := Object.Get_Value (The_Movement);
Refresh (The_Object);
if Go_Back then
Current_Angle := (Current_Angle + 180) mod 360;
end if;
Result_X := Cos (Convert (I => Current_Angle)) * Float (Movement);
Result_Y := Sin (Convert (I => Current_Angle)) * Float (Movement);
X := Integer (Current_X) + Integer (Result_X);
Y := Integer (Current_Y) + Integer (Result_Y);
The_Turtle.X := Easy_X.Coordinate (X);
The_Turtle.Y := Easy_X.Coordinate (Y);
Turtle_Table (Index) := The_Turtle;
return Move (The_Object => The_Object);
end Go;
function To_Left (The_Object, The_Angle : Object.Reference)
return Object.Reference is
The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
Get_Direction : Integer;
Next_Angle : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if (Object.Get_Class (The_Angle) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Get_Direction := Object.Get_Value (The_Angle);
Next_Angle := (Integer (The_Turtle.Angle) - Get_Direction) mod 360;
if Next_Angle < 0 then
Next_Angle := Next_Angle + 360;
end if;
The_Turtle.Angle := Direction (Next_Angle);
Turtle_Table (Index) := The_Turtle;
return The_Object;
end To_Left;
function To_Right (The_Object, The_Angle : Object.Reference)
return Object.Reference is
The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
Get_Direction : Integer;
Next_Angle : Integer;
Index : Integer := Id (From => The_Object);
use Object;
begin
if (Object.Get_Class (The_Angle) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Get_Direction := Object.Get_Value (The_Angle);
Next_Angle := (Integer (The_Turtle.Angle) + Get_Direction) mod 360;
The_Turtle.Angle := Direction (Next_Angle);
Turtle_Table (Index) := The_Turtle;
return The_Object;
end To_Right;
function Send (To_Object : Object.Reference;
The_Messages : Message.List;
With_Arguments : Argument.List) return Object.Reference is
Result, Arg1, Arg2 : Object.Reference := Object.Void_Reference;
Args : Argument.List;
Message_List : Message.List;
Message_Receive : Message.Tiny_String;
Nb_Message : Natural;
Message_To_Turtle : Turtle_Keyword_Message;
First_Coordinate : Boolean := False;
begin
Args := With_Arguments;
Message_List := The_Messages;
Nb_Message := Message.How_Many (L => Message_List); for I in 1 .. Nb_Message loop
Counter.Increase (Object.Turtle_Class);
Arg1 := Argument.Get (L => Args);
Message_Receive := Message.Get (L => Message_List);
Message_To_Turtle := Turtle_Keyword_Message'Value
(Bs.Image (Message_Receive));
case Message_To_Turtle is
when Tonx =>
Result := Set_X (The_Object => To_Object, X => Arg1);
when Tony =>
Result := Set_Y (The_Object => To_Object, Y => Arg1);
when Avance =>
Result := Go (The_Object => To_Object,
The_Movement => Arg1,
Go_Back => False);
when Recule =>
Result := Go (The_Object => To_Object,
The_Movement => Arg1,
Go_Back => True);
when Agauche =>
Result := To_Left (The_Object => To_Object,
The_Angle => Arg1);
when Adroite =>
Result := To_Right (The_Object => To_Object,
The_Angle => Arg1);
when Tonangle =>
Result := Set_Direction (The_Object => To_Object,
Get_Direction => Arg1);
when Y =>
Arg2 := Arg1;
First_Coordinate := True;
Result := Object.Void_Reference;
when Vaenx =>
if First_Coordinate then
Result := Goto_Xy (The_Object => To_Object,
X => Arg1,
Y => Arg2);
First_Coordinate := False;
else
raise Bug.Unknown_Turtle_Message;
end if;
end case;
Message.Next (L => Message_List, Mess => Message_Receive);
Argument.Next (L => Args, Obj => Arg1);
Counter.Stop_Time (Object.Turtle_Class);
end loop;
return Result;
exception
when Constraint_Error =>
raise Bug.Unknown_Turtle_Message;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Message.Tiny_String) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
Message_To_Turtle : Turtle_Unary_Message;
begin
Message_To_Turtle := Turtle_Unary_Message'Value
(Bs.Image (The_Message));
Counter.Increase (Object.Turtle_Class);
case Message_To_Turtle is
when Levetaplume =>
Result := Head_Up (The_Object => To_Object);
when Baissetaplume =>
Result := Head_Down (The_Object => To_Object);
when Rentrecheztoi =>
Result := Go_Home (The_Object => To_Object);
when Tonx =>
Result := Get_X (The_Object => To_Object);
when Tony =>
Result := Get_Y (The_Object => To_Object);
when Tonangle =>
Result := Get_Direction (The_Object => To_Object);
when Clone =>
Result := Clone (The_Object => To_Object);
when Entexte =>
In_Text (The_Object => To_Object);
Result := To_Object;
when Petit | Moyen | Large =>
Result := Set_Size (The_Object => To_Object,
The_Size => Message_To_Turtle);
end case;
Counter.Stop_Time (Class => Object.Turtle_Class); return Result;
exception
when Constraint_Error =>
raise Bug.Unknown_Turtle_Message;
end Send;
begin
Reset;
end Turtle_Class;
nblk1=14
nid=0
hdr6=28
[0x00] rec0=1c rec1=00 rec2=01 rec3=04c
[0x01] rec0=21 rec1=00 rec2=02 rec3=006
[0x02] rec0=1d rec1=00 rec2=03 rec3=062
[0x03] rec0=1b rec1=00 rec2=04 rec3=03e
[0x04] rec0=18 rec1=00 rec2=05 rec3=05c
[0x05] rec0=1b rec1=00 rec2=06 rec3=018
[0x06] rec0=17 rec1=00 rec2=07 rec3=03a
[0x07] rec0=1a rec1=00 rec2=08 rec3=0a0
[0x08] rec0=1b rec1=00 rec2=09 rec3=082
[0x09] rec0=18 rec1=00 rec2=0a rec3=042
[0x0a] rec0=06 rec1=00 rec2=14 rec3=00e
[0x0b] rec0=1b rec1=00 rec2=0b rec3=066
[0x0c] rec0=17 rec1=00 rec2=0c rec3=00a
[0x0d] rec0=18 rec1=00 rec2=0d rec3=086
[0x0e] rec0=1a rec1=00 rec2=0e rec3=002
[0x0f] rec0=17 rec1=00 rec2=0f rec3=060
[0x10] rec0=1a rec1=00 rec2=10 rec3=012
[0x11] rec0=1e rec1=00 rec2=11 rec3=028
[0x12] rec0=1e rec1=00 rec2=12 rec3=002
[0x13] rec0=0c rec1=00 rec2=13 rec3=000
tail 0x2173408e284e158dae3b3 0x42a00088462060003