|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Pen_Class, seg_038f0e, seg_038f68
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Object;
with Bounded_String;
with String_Utilities;
with Error_Broadcaster;
package body Pen_Class is
type Unary_Message is (Tonx, Tony, Large, Moyen, Fin,
Entexte, Detruit, Clone);
-- iterateur de la classe pen_class
procedure Init (Iter : out Iterator; Coll : in Collection) is
begin
Iter := Iterator'First;
end Init;
procedure Next (Iter : in out Iterator) is
begin
Iter := Iter + 1;
end Next;
function Done (Iter : in Iterator) return Boolean is
begin
return (Iterator'Last = Iter);
end Done;
function Value (Iter : in Iterator) return Index is
begin
return Iter;
end Value;
function Clone (To_Object : Object.Reference) return Object.Reference is
begin
Next (Pen_Collection.Iter);
Pen_Collection.Table (Pen_Collection.Iter) :=
Pen_Collection.Table (To_Object.Identity);
return (Object.Tiny_Pen, Pen_Collection.Iter);
end Clone;
function Entexte (To_Object : Object.Reference) return String is
begin
return ("Stylo numero:" &
String_Utilities.Number_To_String (To_Object.Identity, 10, 2) &
" Ma Position:" &
String_Utilities.Number_To_String
(Pen_Collection.Table (To_Object.Identity).X, 10, 4) & "," &
String_Utilities.Number_To_String
(Pen_Collection.Table (To_Object.Identity).Y, 10, 4) &
" Ma Taille:" &
Graphic_Object.Font'Image
((Pen_Collection.Table (To_Object.Identity).Font)));
end Entexte;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return String is
Message : Unary_Message;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
case Message is
when Tonx | Tony | Large | Moyen | Fin | Detruit | Clone =>
return ("");
when Entexte =>
return Entexte (To_Object);
end case;
end Send;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return Object.Reference is
Message : Unary_Message;
Obj : Object.Reference;
My_Pen : Pen;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
Obj := To_Object;
case Message is
when Tonx =>
Obj.Identity := Pen_Collection.Table (To_Object.Identity).X;
Obj.Class := Object.Tiny_Integer;
when Tony =>
Obj.Identity := Pen_Collection.Table (To_Object.Identity).Y;
Obj.Class := Object.Tiny_Integer;
when Large =>
Obj.Identity := To_Object.Identity;
Obj.Class := Object.Tiny_Pen;
Pen_Collection.Table (To_Object.Identity).Font :=
Graphic_Object.Large_Font;
when Moyen =>
Obj.Identity := To_Object.Identity;
Obj.Class := Object.Tiny_Pen;
Pen_Collection.Table (To_Object.Identity).Font :=
Graphic_Object.Medium_Font;
when Fin =>
Obj.Identity := To_Object.Identity;
Obj.Class := Object.Tiny_Pen;
Pen_Collection.Table (To_Object.Identity).Font :=
Graphic_Object.Small_Font;
when Entexte =>
Obj.Identity := To_Object.Identity;
Obj.Class := Object.Tiny_Pen;
when Detruit =>
My_Pen.X := 0;
My_Pen.Y := 0;
Obj.Identity := To_Object.Identity;
Obj.Class := Object.Tiny_Pen;
when Clone =>
Obj := Clone (To_Object);
end case;
return Obj;
exception
when Constraint_Error =>
raise Error_Broadcaster.Unknown_Unary_Message;
end Send;
function Send (To_Object : Object.Reference;
The_Argument : Object.Parameters.List)
return Object.Reference is
Message : Object.Message;
Obj : Object.Reference;
Local_Argument : Object.Parameters.List := The_Argument;
begin
if String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"vaEnX:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
Graphic_Object.Move (Pen_Collection.Table (To_Object.Identity).X,
Pen_Collection.Table (To_Object.Identity).Y);
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"vaEnY:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"tonX:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"tonY:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"tonX:Y:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"vaEnX:Y:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
Object.Parameters.Get (Local_Argument, Obj);
Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;
elsif String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"ecrit:", True) then
Object.Parameters.Get (Local_Argument, Obj);
Bounded_String.Copy (Message, "entexte");
Graphic_Object.Draw_With_Font
(Pen_Collection.Table (To_Object.Identity).X,
Pen_Collection.Table (To_Object.Identity).Y,
Object.Send (Obj, Message),
Pen_Collection.Table (To_Object.Identity).Font);
else
raise Error_Broadcaster.Unknown_Keyword_Message;
end if;
return Obj;
end Send;
end Pen_Class;
nblk1=a
nid=3
hdr6=12
[0x00] rec0=25 rec1=00 rec2=01 rec3=018
[0x01] rec0=00 rec1=00 rec2=0a rec3=014
[0x02] rec0=1d rec1=00 rec2=08 rec3=02e
[0x03] rec0=1d rec1=00 rec2=09 rec3=044
[0x04] rec0=18 rec1=00 rec2=02 rec3=00c
[0x05] rec0=19 rec1=00 rec2=07 rec3=05c
[0x06] rec0=15 rec1=00 rec2=06 rec3=06c
[0x07] rec0=16 rec1=00 rec2=04 rec3=008
[0x08] rec0=13 rec1=00 rec2=05 rec3=000
[0x09] rec0=09 rec1=09 rec2=a0 rec3=4ef
tail 0x21531f91284e874369dd8 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 00 01 da 80 29 6c 65 63 74 69 6f 6e 2e 54 61 ┆ )lection.Ta┆