|
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: 9760 (0x2620)
Types: TextFile
Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Lex2;
with Queue_Generic;
with Text_Io;
with Token;
use Token;
package body Abstract_Tree is
Max_Character : constant Natural := 80;
subtype My_String is String (1 .. Max_Character);
package List is new Queue_Generic (Element => P_Node);
type Instruction_List is
record
The_List : List.Queue;
The_Iterator : List.Iterator;
end record;
type Bloc_Instruction is
record
The_Name : My_String;
A_List : P_Instruction_List;
end record;
type Rep_Dans_Call_Effet is
record
The_Name : My_String;
Left : P_Node;
Right : P_Instruction_List;
end record;
type Wait_Call_Scene is
record
The_Name : My_String;
The_Id : P_Node;
end record;
type Expression is
record
The_Operation : My_String;
Left : P_Node;
Right : P_Node;
end record;
type Tantque is
record
The_Name : My_String;
First_Condition : P_Node;
Relation : P_Node;
Second_Condition : P_Node;
A_List : P_Instruction_List;
end record;
type Action is
record
The_Name : My_String;
The_Class : P_Node;
The_Actor : P_Node;
end record;
type Change is
record
The_Name : My_String;
The_Class : P_Node;
The_Actor : P_Node;
Value : P_Node;
end record;
type Evolution is
record
The_Name : My_String;
The_Class : P_Node;
The_Actor : P_Node;
First_Value : P_Node;
Second_Value : P_Node;
end record;
type Node (A_Kind : Kind_Node) is
record
case A_Kind is
when Debut | Puis =>
Node_Instruction : Bloc_Instruction;
when Dans | Repeter | Lancereffet =>
Node_Rep_Dans_Call_Effet : Rep_Dans_Call_Effet;
when Attendre | Lancerscene =>
Node_Wait_Call_Scene : Wait_Call_Scene;
when Tant_Que =>
Node_While : Tantque;
when Plus | Moins | Mult | Div =>
Node_Expression : Expression;
when Activer | Desact =>
Node_Action : Action;
when Changer =>
Node_Change : Change;
when Evoluer =>
Node_Evolution : Evolution;
when Id =>
The_Name : My_String;
when Nbr =>
The_Value : Natural;
end case;
end record;
function Normaliser (S : String; Length : Natural) return String is
begin
if S'Length >= Length then
return S (S'First .. S'First + Length - 1);
else
return S & (1 .. Length - S'Length => ' ');
end if;
end Normaliser;
function Make_Node (The_Left, The_Right : in P_Node) return P_Node is
The_Action : Action;
The_Expression : Expression;
begin
case Lex2.Get_Token is
when L_Activer | L_Desact =>
The_Action.The_Name := Normaliser
(Lex2.Get_Value, Max_Character);
The_Action.The_Class := The_Left;
The_Action.The_Actor := The_Right;
return new Node'(Activer, Node_Action => The_Action);
when L_Plus | L_Moins | L_Div | L_Mult =>
The_Expression.The_Operation := Normaliser ("+", Max_Character);
The_Expression.Left := The_Left;
The_Expression.Right := The_Right;
return new Node'(Plus, Node_Expression => The_Expression);
when others =>
return null;
end case;
end Make_Node;
function Make_Node (The_Left : in P_Node; The_Right : in P_Instruction_List)
return P_Node is
The_Rep_Dans_Call_Effet : Rep_Dans_Call_Effet;
begin
The_Rep_Dans_Call_Effet.The_Name :=
Normaliser (Lex2.Get_Value, Max_Character);
The_Rep_Dans_Call_Effet.Left := The_Left;
The_Rep_Dans_Call_Effet.Right := The_Right;
return new Node'(Repeter,
Node_Rep_Dans_Call_Effet => The_Rep_Dans_Call_Effet);
end Make_Node;
function Make_Node (The_Time : in P_Node) return P_Node is
The_Wait_Call_Scene : Wait_Call_Scene;
begin
The_Wait_Call_Scene.The_Name := Normaliser
(Lex2.Get_Value, Max_Character);
The_Wait_Call_Scene.The_Id := The_Time;
return new Node'(Attendre, Node_Wait_Call_Scene => The_Wait_Call_Scene);
end Make_Node;
function Make_Node (The_List : in P_Instruction_List) return P_Node is
The_Bloc_Instruction : Bloc_Instruction;
begin
The_Bloc_Instruction.The_Name :=
Normaliser (Lex2.Get_Value, Max_Character);
The_Bloc_Instruction.A_List := The_List;
return new Node'(Debut, Node_Instruction => The_Bloc_Instruction);
end Make_Node;
function Make_Node (First_Term, The_Relation, Second_Term : in P_Node;
The_List : in P_Instruction_List) return P_Node is
The_Tantque : Tantque;
begin
The_Tantque.The_Name := Normaliser (Lex2.Get_Value, Max_Character);
The_Tantque.First_Condition := First_Term;
The_Tantque.Relation := The_Relation;
The_Tantque.Second_Condition := Second_Term;
The_Tantque.A_List := The_List;
return new Node'(Tant_Que, Node_While => The_Tantque);
end Make_Node;
function Make_Node
(The_Class, The_Actor, The_Value : in P_Node) return P_Node is
The_Change : Change;
begin
The_Change.The_Name := Normaliser (Lex2.Get_Value, Max_Character);
The_Change.The_Class := The_Class;
The_Change.The_Actor := The_Actor;
The_Change.Value := The_Value;
return new Node'(Changer, Node_Change => The_Change);
end Make_Node;
function Make_Node
(The_Class, The_Actor, Initial_Value, Final_Value : in P_Node)
return P_Node is
The_Evolution : Evolution;
begin
The_Evolution.The_Name := Normaliser (Lex2.Get_Value, Max_Character);
The_Evolution.The_Class := The_Class;
The_Evolution.The_Actor := The_Actor;
The_Evolution.First_Value := Initial_Value;
The_Evolution.Second_Value := Final_Value;
return new Node'(Evoluer, Node_Evolution => The_Evolution);
end Make_Node;
function Make_Foliage return P_Node is
begin
if Lex2.Get_Token = L_Id then
return
new Node'
(Id,
The_Name => Normaliser (Lex2.Get_Value, Max_Character));
else
return new Node'(Nbr, The_Value => Natural'Value (Lex2.Get_Value));
end if;
end Make_Foliage;
procedure Create_List (A_P_List : out P_Instruction_List) is
Tmp_List : P_Instruction_List;
begin
Tmp_List := new Instruction_List;
List.Initialize (Tmp_List.The_List);
A_P_List := Tmp_List;
end Create_List;
procedure Next_List (A_P_List : in out P_Instruction_List) is
begin
List.Next (List.Iterator (A_P_List.The_Iterator));
end Next_List;
procedure Add_The_List
(A_P_List : in out P_Instruction_List; A_Node : in P_Node) is
begin
if List.Is_Empty (A_P_List.The_List) then
List.Add (A_P_List.The_List, A_Node);
List.Init (A_P_List.The_Iterator, A_P_List.The_List);
else
List.Add (A_P_List.The_List, A_Node);
end if;
end Add_The_List;
function List_Value (A_P_List : P_Instruction_List) return P_Node is
begin
return List.Value (A_P_List.The_Iterator);
end List_Value;
procedure Node_Identification (A_P_List : P_Instruction_List) is
A_Node : P_Node;
begin
A_Node := List_Value (A_P_List);
case A_Node.A_Kind is
when Activer | Desact =>
Text_Io.Put_Line (A_Node.Node_Action.The_Name);
A_Node := A_Node.Node_Action.The_Class;
case A_Node.A_Kind is
when Id =>
Text_Io.Put_Line (A_Node.The_Name);
when Nbr =>
Text_Io.Put_Line (Natural'Image (A_Node.The_Value));
when others =>
Text_Io.Put_Line ("ok");
end case;
when Debut | Puis =>
Text_Io.Put_Line (A_Node.Node_Instruction.The_Name);
when Dans | Repeter | Lancereffet =>
Text_Io.Put_Line (A_Node.Node_Rep_Dans_Call_Effet.The_Name);
when Attendre | Lancerscene =>
Text_Io.Put_Line (A_Node.Node_Wait_Call_Scene.The_Name);
when Tant_Que =>
Text_Io.Put_Line (A_Node.Node_While.The_Name);
when Plus | Moins | Mult | Div =>
Text_Io.Put_Line (A_Node.Node_Expression.The_Operation);
when Changer =>
Text_Io.Put_Line (A_Node.Node_Change.The_Name);
when Evoluer =>
Text_Io.Put_Line (A_Node.Node_Evolution.The_Name);
when Id =>
Text_Io.Put_Line (A_Node.The_Name);
when Nbr =>
Text_Io.Put_Line (Natural'Image (A_Node.The_Value));
end case;
end Node_Identification;
end Abstract_Tree;