⟦c07bc4570⟧

TextFile

with Text_Io;
use Text_Io;

package body Motor_Role is
    Time_Value : Integer := 0;
    function Time_System return Time is
    begin
        return Time_Value;
    end Time_System;

    procedure Step_Time is
    begin
        delay (0.1);
        Time_Value := Time_Value + 1;
    end Step_Time;

    procedure Reset_Time is
    begin
        Time_Value := 0;
    end Reset_Time;

    procedure Execute (A : Actor; Ac : Action) is
    begin
        [statement]
    end Execute;



    function Create_A_Role (An_Actor : Actor) return Role is
        Result : Role;
    begin
        Result := new Cell_Role;
        Result.In_Process := False;
        Result.The_Actor := An_Actor;
        Result.The_Step := Empty_Step;
        Result.The_Time := 0;
        return Result;
    end Create_A_Role;


    function Read_A_Role (F : File_Type) return Role is
        An_Actor : Actor;
        A_Time : Time;
        An_Action : Action;
        N, I : Integer;
        A_Role : Role;
    begin
        An_Actor := Read_An_Actor (F);
        A_Role := Create_A_Role (An_Actor => An_Actor);
        N := Read_Nb_Of_Step (F);
        for I in 1 .. N loop
            A_Time := Read_A_Time (F);
            An_Action := Read_An_Action (F);
            Put_Action_In_Role (A_Role, A_Time, An_Action);
        end loop;
        return A_Role;
    end Read_A_Role;


    function Number_Of_Actions_Of_Role (R : Role) return Integer is
        A_Step : P_Step;
        N : Integer;
    begin
        N := 0;
        A_Step := Step_Of_Role (R);
        while A_Step /= Empty_Step loop
            N := N + 1;
            A_Step := Step_Next (A_Step);
        end loop;
        return N;
    end Number_Of_Actions_Of_Role;


    function Role_Empty (R : Role) return Boolean is
    begin
        return (Step_Of_Role (R) = Empty_Step);
    end Role_Empty;


    function Time_Of_Role (R : Role) return Time is
    begin
        return R.The_Time;
    end Time_Of_Role;

    function Actor_Of_Role (R : Role) return Actor is
    begin
        return R.The_Actor;
    end Actor_Of_Role;


    function Role_In_Process (R : Role) return Boolean is
    begin
        return R.In_Process;
    end Role_In_Process;


    function Step_Of_Role (The_Role : Role) return P_Step is
    begin
        return The_Role.The_Step;
    end Step_Of_Role;


    procedure Witch_Action_In_Role (R : Role;
                                    T : Time;
                                    A : in out Action;
                                    Existe : out Boolean) is
        A_Step : P_Step;
        Finish : Boolean;
    begin
        Existe := False;
        Finish := False;
        A_Step := Step_Of_Role (R);
        while ((A_Step /= Empty_Step) and not Finish) loop
            if Step_Time (A_Step) = T then
                Finish := True;
                Existe := True;
                A := Step_Action (A_Step);
            else
                if Step_Time (A_Step) > T then
                    Finish := True;
                else
                    A_Step := Step_Next (A_Step);
                end if;
            end if;
        end loop;
    end Witch_Action_In_Role;


    procedure Put_Action_In_Role (R : in out Role; T : Time; A : Action) is
        Tmp_Step : P_Step;
    begin  
        Tmp_Step := Step_Of_Role (R);
        Input_Action_In_Step (Tmp_Step, T, A);
        if T > R.The_Time then
            R.The_Time := T;
        end if;
    end Put_Action_In_Role;


    procedure Extract_Action_Of_Role (R : in out Role; T : Time) is
        A_Step : P_Step;
        A_Time : Time;

    begin
        A_Step := Step_Of_Role (R);
        Extract_Action_Of_Step (A_Step, T);  
        if T = R.The_Time then
            R.The_Time := 0;
            A_Step := Step_Of_Role (R);
            while (A_Step /= Empty_Step) loop
                A_Time := Step_Time (A_Step);
                if A_Time > R.The_Time then
                    R.The_Time := A_Time;
                end if;
                A_Step := Step_Next (A_Step);
            end loop;
        end if;
    end Extract_Action_Of_Role;


    procedure Delay_Action_Of_Role (R : in out Role; T : Time; D : Delai) is
        New_Time : Time;
    begin
        New_Time := T + D;
        if New_Time >= 0 then
            Move_Action_Of_Role (R, T, New_Time);
        else
            Text_Io.Put_Line ("danger !!!!   decalage dans le temps interdit");
        end if;
    end Delay_Action_Of_Role;


    procedure Move_Action_Of_Role
                 (R : in out Role; Old_Time : Time; New_Time : Time) is
        An_Action : Action;
        Exist : Boolean;
    begin
        Witch_Action_In_Role (R, Old_Time, An_Action, Exist);
        if Exist then
            Extract_Action_Of_Role (R, Old_Time);
            Put_Action_In_Role (R, New_Time, An_Action);
        end if;
    end Move_Action_Of_Role;


    procedure Delay_Role (R : in out Role; D : Delai) is
        A_Step : P_Step;
        A_Time : Time;
    begin
        if not Role_Empty (R) then
            A_Step := Step_Of_Role (R);
            if (Step_Time (A_Step) + D) >= 0 then
                while (A_Step /= Empty_Step) loop
                    A_Time := Step_Time (A_Step) + D;
                    Change_Time_Of_Step (A_Step, A_Time);
                    A_Step := Step_Next (A_Step);
                end loop;
                R.The_Time := R.The_Time + D;
            else
                Put_Line (" attention delai beaucoup trop negatif");
            end if;
        end if;
    end Delay_Role;


    procedure Empty_Role (R : in out Role) is
        Kill_Step : P_Step;
    begin
        while R.The_Step /= Empty_Step loop
            Kill_Step := R.The_Step;
            R.The_Step := Step_Next (Kill_Step);
            Destruct_Step (Kill_Step);
        end loop;
    end Empty_Role;


    procedure Run_Role (R : in out Role) is
    begin
        R.The_Index := Step_Of_Role (R);
        if R.The_Index /= Empty_Step then
            begin
                R.In_Process := True;
                R.The_Begining := Time_System;
            end;
        end if;
    end Run_Role;


    procedure Stop_Role (R : in out Role) is
    begin
        R.In_Process := False;
    end Stop_Role;


    procedure Sollicit_Role (R : in out Role) is
        Who : Actor;
        What : Action;
    begin
        if Role_In_Process (R) then
            if (Step_Time (R.The_Index) <= (Time_System - R.The_Begining)) then
                Who := Actor_Of_Role (R);
                What := Step_Action (R.The_Index);
                Execute (Who, What);
                R.The_Index := Step_Next (R.The_Index);
                if R.The_Index = Empty_Step then
                    Stop_Role (R);
                end if;
            end if;
        else
            Put_Line
               (" on ne peut pas solliciter un role qui n'est pas en cours !!!");
        end if;
    end Sollicit_Role;


    procedure Play_Role (R : in out Role) is
    begin
        Run_Role (R);
        while Role_In_Process (R) loop
            Sollicit_Role (R);
        end loop;
    end Play_Role;


    procedure Save_Role (R : Role; F : File_Type) is
        A_Step : P_Step;
        An_Actor : Actor;
        An_Action : Action;
        A_Time : Time;
        N : Integer;

    begin  
        An_Actor := Actor_Of_Role (R);
        Save_Actor (F, An_Actor);
        N := Number_Of_Actions_Of_Role (R);
        Save_Nb_Action_Of_Role (F, N);
        A_Step := Step_Of_Role (R);
        while A_Step /= Empty_Step loop
            A_Time := Step_Time (A_Step);
            Save_Time (F, A_Time);
            An_Action := Step_Action (A_Step);
            Save_Action (F, An_Action);
            A_Step := Step_Next (A_Step);
        end loop;
    end Save_Role;
end Motor_Role;
DataMuseum.dk

Rational R1000/400 Tapes

⟦c07bc4570⟧ TextFile

Derivation

TextFile
