|
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: 11463 (0x2cc7)
Types: TextFile
Names: »B«
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with Class_Behavior;
with Collection;
with Text_Io, Class, Slot, Instance;
package body Frame_Bak is
package Behavior is new Class_Behavior (Values, Name);
function Value_Of (The_Object : Object; Attribute : Attributes)
return Slot.Object is
begin
return Behavior.Get (The_Object) (Attribute);
end Value_Of;
procedure Change (The_Object : Object;
Attribute : Attributes;
To : Slot.Object) is
use Slot.Operators;
Object_Value : Values;
begin
Object_Value := Behavior.Get (The_Reference => The_Object);
if Is_Same_Type (To, Object_Value (Attribute)) then
Object_Value (Attribute) := To;
Behavior.Set (The_Reference => The_Object,
With_Value => Object_Value);
else
Text_Io.Put_Line ("erreur de type dans " &
Name & " -proced. change ");
end if;
end Change;
function Get (The_Object : Object; Attribute : Attributes)
return Slot.Object is
use Slot.Operators;
Object_Value : Values;
begin
Object_Value := Behavior.Get (The_Reference => The_Object);
return Object_Value (Attribute);
end Get;
procedure Add (With_Values : Values) is
A_Object : Frame.Object;
begin
A_Object := Behavior.Allocate (With_Values);
end Add;
procedure Add (With_Values_List : Values_List) is
A_Object : Frame.Object;
begin
for I in With_Values_List'Range loop
A_Object := Behavior.Allocate (With_Values_List (I));
end loop;
end Add;
procedure Delete (The_Object : Object) is
begin
Behavior.Dispose (The_Reference => The_Object);
end Delete;
procedure Clear is
begin
Behavior.Clear;
end Clear;
function Instances return Collection.Object is
begin
return Behavior.Instances;
end Instances;
function Cardinality return Natural is
begin
return Behavior.Cardinality;
end Cardinality;
------------------------------------------------------------
function Predicate_Selector (O : Frame.Object;
Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Boolean is
use Slot.Operators;
begin
case Operator is
when Greater =>
return Value_Of (O, Attribute) > Value;
when Greater_Equal =>
return Value_Of (O, Attribute) >= Value;
when Less =>
return Value_Of (O, Attribute) < Value;
when Less_Equal =>
return Value_Of (O, Attribute) <= Value;
when Equal =>
return Value_Of (O, Attribute) = Value;
when Not_Equal =>
return Value_Of (O, Attribute) /= Value;
end case;
end Predicate_Selector;
------------------------------------------------------------
function Find (With_Conditions : Conditions) return Frame.Object is
Ok : Boolean := False;
O : Object;
O1 : Instance.Reference (Kind => Frame.Const_Class);
function Predicate (O : Object) return Boolean is
begin
for I in With_Conditions'Range loop
if not Predicate_Selector (O, With_Conditions (I).Attribute,
With_Conditions (I).Operator,
With_Conditions (I).Value) then
return False;
end if;
end loop;
return True;
end Predicate;
function One_Selected_Object is new Collection.Find_One (Predicate);
function Exist_One_Selected_Object is new Collection.Exist (Predicate);
begin
Ok := Exist_One_Selected_Object (Frame.Instances);
if Ok then
O := One_Selected_Object (Frame.Instances);
else
Instance.Set (The_Reference => O1, With_Value => 0);
O := Object (O1);
end if;
return O;
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => (1 => (Attribute, Operator, Value)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object) return Frame.Object is
begin
return Find (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2)));
end Find;
------------------------------------------------------------
function Find (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Collection.Object is
function Predicate (O : Object) return Boolean is
begin
return Predicate_Selector (O, Attribute, Operator, Value);
end Predicate;
function All_Selected_Object is new Collection.Restrict (Predicate);
begin
return All_Selected_Object (Frame.Instances);
end Find;
------------------------------------------------------------
function Find (With_Conditions : Conditions) return Collection.Object is
function Predicate (O : Object) return Boolean is
begin
for I in With_Conditions'Range loop
if not Predicate_Selector (O, With_Conditions (I).Attribute,
With_Conditions (I).Operator,
With_Conditions (I).Value) then
return False;
end if;
end loop;
return True;
end Predicate;
function All_Selected_Object is new Collection.Restrict (Predicate);
begin
return All_Selected_Object (Frame.Instances);
end Find;
------------------------------------------------------------
function Null_Ref return Object is
O : Object;
O1 : Instance.Reference (Kind => Frame.Const_Class);
begin
Instance.Set (The_Reference => O1, With_Value => 0);
O := Object (O1);
return O;
end Null_Ref;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Between : Slot.Object;
And_Size : Slot.Object) return Boolean is
function Predicate (O : Object) return Boolean is
use Slot.Operators;
begin
return Value_Of (O, Attribute) > Between and
Value_Of (O, Attribute) < And_Size;
end Predicate;
function Exist_Between is new Collection.Exist (Predicate);
begin
return Exist_Between (Instances);
end Exist;
------------------------------------------------------------
function Exist (With_Conditions : Conditions) return Boolean is
use Slot.Operators;
O : Instance.Reference;
begin
O := Find (With_Conditions);
if Instance."=" (O, Null_Ref) then
return False;
else
return True;
end if;
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((1 => (Attribute, Operator, Value))));
end Exist;
----------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2)));
end Exist;
------------------------------------------------------------
function Exist (Attribute : Attributes;
Operator : Operators;
Value : Slot.Object;
Attribute2 : Attributes;
Operator2 : Operators;
Value2 : Slot.Object;
Attribute3 : Attributes;
Operator3 : Operators;
Value3 : Slot.Object) return Boolean is
use Slot.Operators;
begin
return Exist (With_Conditions => ((Attribute, Operator, Value),
(Attribute2, Operator2, Value2),
(Attribute3, Operator3, Value3)));
end Exist;
------------------------------------------------------------
function Minimize (The_Attribute : Attributes) return Frame.Object is
use Slot.Operators;
function Minimized (O, Any : Frame.Object) return Boolean is
begin
return Value_Of (O, The_Attribute) < Value_Of (Any, The_Attribute);
end Minimized;
function Genered_Minimize is new Collection.The_Most (Minimized);
begin
return (Genered_Minimize (Instances));
end Minimize;
function Maximize (The_Attribute : Attributes) return Frame.Object is
use Slot.Operators;
function Maximized (O, Any : Frame.Object) return Boolean is
begin
return Value_Of (O, The_Attribute) > Value_Of (Any, The_Attribute);
end Maximized;
function Genered_Maximize is new Collection.The_Most (Maximized);
begin
return (Genered_Maximize (Instances));
end Maximize;
------------------------------------------------------------
function Generic_Exist return Boolean is
function Exist_Predicate is new Collection.Exist (Predicate);
begin
return Exist_Predicate (Frame.Instances);
end Generic_Exist;
function Generic_Find return Frame.Object is
function One_Selected_Object is new Collection.Find_One (Predicate);
begin
return One_Selected_Object (Frame.Instances);
end Generic_Find;
end Frame_Bak;