|
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: 29696 (0x7400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Turtle, seg_03819a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Class_Integer;
with Class_Printer;
with Class_Window;
with Block;
with Bounded_String;
with Easy_Y;
with Elementary_Functions;
with Message;
with String_Utilities;
with Bug_Report;
package body Class_Turtle is
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Tafenetre, Rentrecheztoi, Levetaplume,
Baissetaplume, Tonx, Tony, Tonangle,
Tonepaisseur, Dupliquetoi, Detruistoi, Entexte);
Token : E_Message;
package Bs renames Bounded_String;
begin
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => This_Message)));
case Token is
when Tafenetre =>
return Object.Create
(Object.Window_Class,
Table (Object.Get (Index_From => To)).Fenetre);
when Rentrecheztoi =>
Table (Object.Get (To)).X := 0;
Table (Object.Get (To)).Y := 0;
Table (Object.Get (To)).Angle := 0;
Table (Object.Get (To)).Epaisseur := 1;
Table (Object.Get (To)).Plume := Etat'(Baissee);
return To;
when Levetaplume =>
Table (Object.Get (To)).Plume := Etat'(Levee);
return To;
when Baissetaplume =>
Table (Object.Get (To)).Plume := Etat'(Baissee);
return To;
when Tonx =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).X));
when Tony =>
return Class_Integer.Create (Object.Index
(Table (Object.Get (To)).Y));
when Tonangle =>
return Class_Integer.Create
(Object.Index (Table (Object.Get (To)).Angle));
when Tonepaisseur =>
return Class_Integer.Create
(Object.Index (Table (Object.Get (To)).Epaisseur));
when Dupliquetoi =>
return Create (To);
when Detruistoi =>
return Object.Void_Reference;
when Entexte =>
Put (To);
return To;
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Unary_Message;
end Send;
function Send (This_Message : Message.Binary; To : Object.Reference)
return Object.Reference is
begin
raise Bug_Report.Unknown_Binary_Message;
return Object.Void_Reference;
end Send;
function Send (This_Message : Message.Keyword; To : Object.Reference)
return Object.Reference is
type E_Message is (Tonx, Tony, Tafenetre, Avance, Recule, Tonepaisseur,
Tonangle, Agauche, Adroite, Vaenx, Y);
Token : E_Message;
package Bs renames Bounded_String;
use Elementary_Functions;
use Object;
Pi : Float := 3.141592654;
Mess : Message.Keyword := This_Message;
Dx, Dy : Object.Index;
begin
Message.Init (This => Mess);
while not Message.Is_Done_Name (Mess) loop
Token := E_Message'Value (Bs.Image
(Message.Get (Name_From => Mess)));
case Token is
when Tafenetre =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Window_Class then
Table (Object.Get (Index_From => To)).Fenetre :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Tonx =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Tony =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Avance =>
Easy_Y.Set_Display
(Class_Window.Get
(Index => Table (Object.Get (Index_From => To)).
Fenetre));
Dx := Object.Index
(Table (Object.Get (Index_From => To)).X);
Dy := Object.Index
(Table (Object.Get (Index_From => To)).Y);
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Table (Object.Get (Index_From => To)).X +
Object.Index
(Float (Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess))) *
Elementary_Functions.Cos
(Float (Table
(Object.Get (Index_From => To)).
Angle) /
180.0 * Pi));
Table (Object.Get (Index_From => To)).Y :=
Table (Object.Get (Index_From => To)).Y +
Object.Index
(Float (Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess))) *
Elementary_Functions.Sin
(Float (Table
(Object.Get (Index_From => To)).
Angle) /
180.0 * Pi));
if Table (Object.Get (Index_From => To)).Plume =
Etat'(Baissee) then
Easy_Y.Put_Size
(Size => Table (Object.Get (Index_From => To)).
Epaisseur);
Easy_Y.Line (Dx, Dy,
Object.Index
(Table (Object.Get
(Index_From => To)).X),
Object.Index
(Table (Object.Get
(Index_From => To)).Y));
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Recule =>
Easy_Y.Set_Display
(Class_Window.Get
(Index => Table (Object.Get (Index_From => To)).
Fenetre));
Dx := Object.Index
(Table (Object.Get (Index_From => To)).X);
Dy := Object.Index
(Table (Object.Get (Index_From => To)).Y);
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Table (Object.Get (Index_From => To)).X -
Object.Index
(Float (Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess))) *
Elementary_Functions.Cos
(Float (Table
(Object.Get (Index_From => To)).
Angle) /
180.0 * Pi));
Table (Object.Get (Index_From => To)).Y :=
Table (Object.Get (Index_From => To)).Y -
Object.Index
(Float (Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess))) *
Elementary_Functions.Sin
(Float (Table
(Object.Get (Index_From => To)).
Angle) /
180.0 * Pi));
if Table (Object.Get (Index_From => To)).Plume =
Etat'(Baissee) then
Easy_Y.Put_Size
(Size => Table (Object.Get (Index_From => To)).
Epaisseur);
Easy_Y.Line (Dx, Dy,
Object.Index
(Table (Object.Get
(Index_From => To)).X),
Object.Index
(Table (Object.Get
(Index_From => To)).Y));
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Tonepaisseur =>
if Object.Get
(Class_From => Message.Get (Argument_From => Mess)) =
Object.Integer_Class and then
Object.Get
(Index_From => Message.Get (Argument_From => Mess)) >
0 then
Table (Object.Get (Index_From => To)).Epaisseur :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Tonangle =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Angle :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Adroite =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Angle :=
Table (Object.Get (Index_From => To)).Angle +
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Agauche =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Angle :=
Table (Object.Get (Index_From => To)).Angle -
Object.Get (Index_From =>
Message.Get
(Argument_From => Mess));
else
raise Bug_Report.Turtle_Bad_Type;
end if;
when Vaenx =>
Easy_Y.Set_Display
(Class_Window.Get
(Index => Table (Object.Get (Index_From => To)).
Fenetre));
Dx := Object.Index
(Table (Object.Get (Index_From => To)).X);
Dy := Object.Index
(Table (Object.Get (Index_From => To)).Y);
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
Message.Next (Mess);
if not Message.Is_Done (Mess) then
if Bs.Image (Message.Get (Name_From => Mess)) =
"Y" then
if Object.Get
(Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess));
if Table (Object.Get (Index_From => To)).
Plume = Etat'(Baissee) then
Easy_Y.Line
(Dx, Dy,
Object.Index
(Table (Object.Get
(Index_From => To)).
X),
Object.Index
(Table (Object.Get
(Index_From => To)).
Y));
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
end if;
when Y =>
Easy_Y.Set_Display
(Class_Window.Get
(Index => Table (Object.Get (Index_From => To)).
Fenetre));
Dx := Object.Index
(Table (Object.Get (Index_From => To)).X);
Dy := Object.Index
(Table (Object.Get (Index_From => To)).Y);
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).Y :=
Object.Get (Index_From =>
Message.Get (Argument_From => Mess));
Message.Next (Mess);
if not Message.Is_Done (Mess) then
if Bs.Image (Message.Get (Name_From => Mess)) =
"VaEnX" then
if Object.Get
(Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
Table (Object.Get (Index_From => To)).X :=
Object.Get
(Index_From =>
Message.Get
(Argument_From => Mess));
if Table (Object.Get (Index_From => To)).
Plume = Etat'(Baissee) then
Easy_Y.Line
(Dx, Dy,
Object.Index
(Table (Object.Get
(Index_From => To)).
X),
Object.Index
(Table (Object.Get
(Index_From => To)).
Y));
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
end if;
else
raise Bug_Report.Turtle_Bad_Type;
end if;
end if;
end case;
Message.Next (Mess);
end loop;
return To;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Keyword_Message;
end Send;
function Create (From : Object.Reference) return Object.Reference is
use Object;
begin
Last := Last + 1;
Table (Last) := Table (Object.Get (From));
return Object.Create (Class => Object.Turtle_Class, Object => Last);
exception
when Constraint_Error =>
raise Bug_Report.Full_Turtle_Table;
end Create;
procedure Create is
use Object;
Node : Block.Node := Block.Get_Current_Node;
begin
Last := Last + 1;
Block.Put_Into_Table
(This_Object => Object.Create
(Class => Object.Turtle_Class, Object => Last),
Named => Bounded_String.Value ("tortue", 80),
Into_Block => Node);
exception
when Constraint_Error =>
raise Bug_Report.Full_Turtle_Table;
end Create;
procedure Put (An_Object : Object.Reference) is
begin
Class_Printer.Put ("Objet Tortue {");
Class_Printer.Forward (4);
Class_Printer.New_Line;
Class_Printer.Put ("Numero => " &
Object.Index'Image (Object.Get (An_Object)));
Class_Printer.New_Line;
Class_Printer.Put ("X => " & Object.Index'Image
(Table (Object.Get (An_Object)).X));
Class_Printer.New_Line;
Class_Printer.Put ("Y => " & Object.Index'Image
(Table (Object.Get (An_Object)).Y));
Class_Printer.New_Line;
Class_Printer.Put ("Angle => " &
Object.Index'Image
(Table (Object.Get (An_Object)).Angle));
Class_Printer.New_Line;
Class_Printer.Put ("Plume => " &
Class_Turtle.Etat'Image
(Table (Object.Get (An_Object)).Plume));
Class_Printer.New_Line;
Class_Printer.Put ("Fenetre => ");
Class_Printer.New_Line;
Class_Printer.Forward (4);
Class_Window.Put (Object.Create
(Object.Window_Class,
Table (Object.Get (An_Object)).Fenetre));
Class_Printer.Backward (8);
Class_Printer.Put ("}");
Class_Printer.New_Line (2);
end Put;
function How_Many return Object.Index is
begin
return Last;
end How_Many;
end Class_Turtle;
nblk1=1c
nid=1c
hdr6=36
[0x00] rec0=1d rec1=00 rec2=01 rec3=058
[0x01] rec0=19 rec1=00 rec2=02 rec3=07a
[0x02] rec0=22 rec1=00 rec2=0e rec3=046
[0x03] rec0=1a rec1=00 rec2=0a rec3=04c
[0x04] rec0=15 rec1=00 rec2=03 rec3=032
[0x05] rec0=15 rec1=00 rec2=15 rec3=006
[0x06] rec0=01 rec1=00 rec2=0f rec3=01c
[0x07] rec0=12 rec1=00 rec2=06 rec3=04e
[0x08] rec0=13 rec1=00 rec2=10 rec3=00a
[0x09] rec0=15 rec1=00 rec2=18 rec3=05a
[0x0a] rec0=06 rec1=00 rec2=11 rec3=00c
[0x0b] rec0=11 rec1=00 rec2=09 rec3=018
[0x0c] rec0=13 rec1=00 rec2=0c rec3=03e
[0x0d] rec0=16 rec1=00 rec2=08 rec3=03c
[0x0e] rec0=00 rec1=00 rec2=12 rec3=028
[0x0f] rec0=13 rec1=00 rec2=19 rec3=030
[0x10] rec0=00 rec1=00 rec2=07 rec3=020
[0x11] rec0=15 rec1=00 rec2=13 rec3=04c
[0x12] rec0=14 rec1=00 rec2=17 rec3=024
[0x13] rec0=03 rec1=00 rec2=16 rec3=034
[0x14] rec0=11 rec1=00 rec2=04 rec3=014
[0x15] rec0=17 rec1=00 rec2=05 rec3=026
[0x16] rec0=14 rec1=00 rec2=1b rec3=044
[0x17] rec0=11 rec1=00 rec2=0b rec3=040
[0x18] rec0=20 rec1=00 rec2=0d rec3=022
[0x19] rec0=17 rec1=00 rec2=1a rec3=01c
[0x1a] rec0=1a rec1=00 rec2=14 rec3=000
[0x1b] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21735babe84e67cd6e512 0x42a00088462060003
Free Block Chain:
0x1c: 0000 00 00 00 a6 80 31 20 20 20 20 20 20 20 20 20 20 ┆ 1 ┆