DataMuseum.dk

top - metrics - download

    Length: 17637 (0x44e5)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Integer_Class;  
with String_Class;
with Elementary_Functions;
use Elementary_Functions;
with Bounded_String;
with Symbol;
with Counter;
with Bug;
with Text_Io;
package body Turtle_Class is

    type Turtle_Unary_Message is (Petit, Moyen, Large, Entexte,
                                  Tonx, Tony, Tonangle, Levetaplume,
                                  Baissetaplume, Rentrecheztoi, Clone);

    type Turtle_Keyword_Message is (Adroite, Agauche, Avance, Recule,
                                    Vaenx, Y, Tonx, Tony, Tonangle);

    Max_Table : constant := 10;  
    Void_Turtle : constant Object_Turtle := (State => False,
                                             X => 0,
                                             Y => 0,
                                             Head_State => False,
                                             Angle => 0,
                                             Size => 1);

    subtype Index_Table is Positive range 1 .. Max_Table;
    Turtle_Table : array (Index_Table) of Object_Turtle;
    package Bs renames Bounded_String;

    function Id (From : Object.Reference) return Integer is
        use Object;
    begin  
        return Object.Get_Value (From_Object => From);
    end Id;

    function Convert (I : Direction) return Float is
        The_Value : Float;  
        Pi : constant Float := 3.14159;
    begin
        The_Value := Float (I);
        return ((Pi * The_Value) / 180.0);
    end Convert;

    function Free_Index return Index_Table is
        Index : Index_Table := 1;
    begin  
        loop
            exit when (Turtle_Table (Index) = Void_Turtle);
            if Index = Max_Table then
                raise Bug.Too_Many_Turtles;
            end if;
            Index := Index + 1;
        end loop;
        return (Index);
    end Free_Index;

    function Get_Turtle (From : Object.Reference) return Object_Turtle is
    begin
        return Turtle_Table (Id (From => From));
    end Get_Turtle;

    procedure Refresh (The_Object : Object.Reference) is
        The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
    begin
        Easy_X.Move_To (X => The_Turtle.X, Y => The_Turtle.Y);
    end Refresh;

    function Move (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle;
    begin
        The_Turtle := Get_Turtle (From => The_Object);
        Easy_X.Set_Pen (Size => The_Turtle.Size);
        if The_Turtle.Head_State then
            Easy_X.Line_To (X => The_Turtle.X, Y => The_Turtle.Y);
        else
            Easy_X.Move_To (X => The_Turtle.X, Y => The_Turtle.Y);
        end if;
        return The_Object;
    end Move;

    procedure Reset is
    begin
        for I in Turtle_Table'Range loop
            Turtle_Table (I) := Void_Turtle;
        end loop;
    end Reset;

    function Create (The_Name : Message.Tiny_String) return Object.Reference is
        New_Object : Object.Reference;  
        New_Turtle : Object_Turtle := Void_Turtle;
        Index : Index_Table;
    begin
        Index := Free_Index;
        New_Turtle.State := True;
        Turtle_Table (Index) := New_Turtle;
        New_Object := Object.Create (Ident_Class => Object.Turtle_Class,
                                     Ident_Object => Index);
        Symbol.Insert (Name => The_Name, New_Reference => New_Object);
        return New_Object;
    end Create;

    procedure Create_Default is
        The_Name : Message.Tiny_String;
        The_Turtle : Object.Reference;

    begin  
        Bs.Free (V => The_Name);
        Bs.Append (The_Name, "Tortue");
        The_Turtle := Create (The_Name);
    end Create_Default;

    function Clone (The_Object : Object.Reference) return Object.Reference is
        The_New_Turtle : Object_Turtle;
        New_Index : Index_Table;
        New_Object : Object.Reference;
    begin
        The_New_Turtle := Get_Turtle (From => The_Object);
        New_Index := Free_Index;  
        Turtle_Table (New_Index) := The_New_Turtle;
        New_Object := Object.Create (Ident_Class => Object.Turtle_Class,
                                     Ident_Object => New_Index);
        return New_Object;
    end Clone;

    function Get_X (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        Get_X_Value : Integer;
    begin  
        The_Turtle := Get_Turtle (From => The_Object);
        Get_X_Value := Integer (The_Turtle.X);
        return Integer_Class.Create (Value => Get_X_Value);
    end Get_X;

    function Get_Y (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        Get_Y_Value : Integer;
    begin
        The_Turtle := Get_Turtle (From => The_Object);
        Get_Y_Value := Integer (The_Turtle.Y);
        return Integer_Class.Create (Value => Get_Y_Value);
    end Get_Y;

    function Get_Direction (The_Object : Object.Reference)
                           return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;  
        Get_Direction_Value : Integer;
    begin
        The_Turtle := Get_Turtle (From => The_Object);
        Get_Direction_Value := Integer (The_Turtle.Angle);
        return Integer_Class.Create (Value => Get_Direction_Value);
    end Get_Direction;

    function Head_Up (The_Object : Object.Reference) return Object.Reference is
        Index : Integer := Id (From => The_Object);
    begin
        Turtle_Table (Index).Head_State := False;
        return The_Object;
    end Head_Up;

    function Head_Down (The_Object : Object.Reference)
                       return Object.Reference is

        Index : Integer := Id (From => The_Object);
    begin
        Turtle_Table (Index).Head_State := True;  
        return The_Object;
    end Head_Down;

    procedure In_Text (The_Object : Object.Reference) is
        The_Turtle : Object_Turtle := Get_Turtle (The_Object);
        The_String, Pas, N : Message.Tiny_String;
    begin  
        if not The_Turtle.State then
            Bs.Copy (Pas, " pas ");
            Bs.Copy (N, " n' ");
        end if;
        Object.In_Text (The_Object);
        Bs.Copy (The_String, " Voici mon X: " &
                                Easy_X.Coordinate'Image (The_Turtle.X));
        Bs.Append (The_String, " ,mon Y: " &
                                  Easy_X.Coordinate'Image (The_Turtle.Y));
        Bs.Append (The_String, " ,mon Angle: " &
                                  Direction'Image (The_Turtle.Angle));
        Bs.Append (The_String, "; Ma Tete ");
        Bs.Append (The_String, N);
        Bs.Append (The_String, "est");
        Bs.Append (The_String, Pas);  
        Bs.Append (The_String, " levee .");  
        Text_Io.Put_Line (Bs.Image (The_String));
    end In_Text;

    function Go_Home (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        Index : Integer := Id (From => The_Object);
    begin
        The_Turtle := Get_Turtle (From => The_Object);
        The_Turtle := Void_Turtle;
        Turtle_Table (Index) := The_Turtle;
        return Move (The_Object);
    end Go_Home;

    function Set_X (The_Object, X : Object.Reference) return Object.Reference is
        X_Position : Integer;
        Index : Integer := Id (From => The_Object);
        use Object;
    begin
        if (Object.Get_Class (X) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;  
        X_Position := Object.Get_Value (X);
        Turtle_Table (Index).X := Easy_X.Coordinate (X_Position);
        return The_Object;
    end Set_X;

    function Set_Y (The_Object, Y : Object.Reference) return Object.Reference is
        Y_Position : Integer;
        Index : Integer := Id (From => The_Object);
        use Object;
    begin  
        if Object.Get_Class (Y) /= Object.Integer_Class then
            raise Bug.Mismatch_Type;
        end if;  
        Y_Position := Object.Get_Value (Y);
        Turtle_Table (Index).Y := Easy_X.Coordinate (Y_Position);
        return The_Object;
    end Set_Y;

    function Goto_Xy (The_Object, X, Y : Object.Reference)
                     return Object.Reference is

        Y_Position : Integer;
        X_Position : Integer;
        Index : Integer := Id (From => The_Object);
        use Object;
    begin
        if (Object.Get_Class (X) /= Object.Integer_Class) or
           (Object.Get_Class (Y) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;  
        Y_Position := Object.Get_Value (Y);
        X_Position := Object.Get_Value (X);
        Turtle_Table (Index).X := Easy_X.Coordinate (X_Position);
        Turtle_Table (Index).Y := Easy_X.Coordinate (Y_Position);
        return Move (The_Object => The_Object);
    end Goto_Xy;

    function Set_Direction (The_Object, Get_Direction : Object.Reference)
                           return Object.Reference is
        Get_Direction_Value : Integer;
        Index : Integer := Id (From => The_Object);
        use Object;
    begin
        if (Object.Get_Class (Get_Direction) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;  
        Get_Direction_Value := Object.Get_Value (Get_Direction);
        if Get_Direction_Value < 0 then
            Get_Direction_Value := (Get_Direction_Value + 360);
        end if;
        Turtle_Table (Index).Angle := (Direction (Get_Direction_Value)) mod 360;
        return The_Object;
    end Set_Direction;

    function Set_Size (The_Object : Object.Reference;
                       The_Size : Turtle_Unary_Message)
                      return Object.Reference is

        Index : Integer := Id (From => The_Object);
    begin  
        case The_Size is

            when Petit =>
                Turtle_Table (Index).Size := 1;
            when Moyen =>
                Turtle_Table (Index).Size := 2;
            when Large =>
                Turtle_Table (Index).Size := 3;
            when others =>
                null;
        end case;
        return The_Object;  
    end Set_Size;


    function Go (The_Object, The_Movement : Object.Reference; Go_Back : Boolean)
                return Object.Reference is
        use Easy_X.Arithmetic;
        The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
        Movement : Integer;
        Current_X : Easy_X.Coordinate := The_Turtle.X;
        Current_Y : Easy_X.Coordinate := The_Turtle.Y;
        Current_Angle : Direction := The_Turtle.Angle;
        Index : Integer := Id (From => The_Object);
        Result_X : Float;
        Result_Y : Float;
        X, Y : Integer;  
        use Object;
    begin  
        if (Object.Get_Class (The_Movement) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;  
        Movement := Object.Get_Value (The_Movement);
        Refresh (The_Object);
        if Go_Back then
            Current_Angle := (Current_Angle + 180) mod 360;
        end if;
        Result_X := Cos (Convert (I => Current_Angle)) * Float (Movement);
        Result_Y := Sin (Convert (I => Current_Angle)) * Float (Movement);
        X := Integer (Current_X) + Integer (Result_X);
        Y := Integer (Current_Y) + Integer (Result_Y);
        The_Turtle.X := Easy_X.Coordinate (X);
        The_Turtle.Y := Easy_X.Coordinate (Y);
        Turtle_Table (Index) := The_Turtle;
        return Move (The_Object => The_Object);
    end Go;

    function To_Left (The_Object, The_Angle : Object.Reference)
                     return Object.Reference is
        The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
        Get_Direction : Integer;
        Next_Angle : Integer;
        Index : Integer := Id (From => The_Object);  
        use Object;
    begin  
        if (Object.Get_Class (The_Angle) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;  
        Get_Direction := Object.Get_Value (The_Angle);
        Next_Angle := (Integer (The_Turtle.Angle) - Get_Direction) mod 360;
        if Next_Angle < 0 then
            Next_Angle := Next_Angle + 360;
        end if;
        The_Turtle.Angle := Direction (Next_Angle);
        Turtle_Table (Index) := The_Turtle;
        return The_Object;
    end To_Left;

    function To_Right (The_Object, The_Angle : Object.Reference)
                      return Object.Reference is
        The_Turtle : Object_Turtle := Get_Turtle (From => The_Object);
        Get_Direction : Integer;
        Next_Angle : Integer;
        Index : Integer := Id (From => The_Object);
        use Object;
    begin  
        if (Object.Get_Class (The_Angle) /= Object.Integer_Class) then
            raise Bug.Mismatch_Type;
        end if;
        Get_Direction := Object.Get_Value (The_Angle);
        Next_Angle := (Integer (The_Turtle.Angle) + Get_Direction) mod 360;
        The_Turtle.Angle := Direction (Next_Angle);  
        Turtle_Table (Index) := The_Turtle;
        return The_Object;
    end To_Right;


    function Send (To_Object : Object.Reference;
                   The_Messages : Message.List;
                   With_Arguments : Argument.List) return Object.Reference is
        Result, Arg1, Arg2 : Object.Reference := Object.Void_Reference;
        Args : Argument.List;
        Message_List : Message.List;
        Message_Receive : Message.Tiny_String;
        Nb_Message : Natural;  
        Message_To_Turtle : Turtle_Keyword_Message;
        First_Coordinate : Boolean := False;

    begin
        Args := With_Arguments;
        Message_List := The_Messages;
        Nb_Message := Message.How_Many (L => Message_List);
        for I in 1 .. Nb_Message loop
            Counter.Increase (Object.Turtle_Class);
            Arg1 := Argument.Get (L => Args);  
            Message_Receive := Message.Get (L => Message_List);
            Message_To_Turtle := Turtle_Keyword_Message'Value
                                    (Bs.Image (Message_Receive));
            case Message_To_Turtle is

                when Tonx =>
                    Result := Set_X (The_Object => To_Object, X => Arg1);

                when Tony =>
                    Result := Set_Y (The_Object => To_Object, Y => Arg1);

                when Avance =>

                    Result := Go (The_Object => To_Object,
                                  The_Movement => Arg1,
                                  Go_Back => False);

                when Recule =>
                    Result := Go (The_Object => To_Object,
                                  The_Movement => Arg1,
                                  Go_Back => True);

                when Agauche =>
                    Result := To_Left (The_Object => To_Object,
                                       The_Angle => Arg1);

                when Adroite =>
                    Result := To_Right (The_Object => To_Object,
                                        The_Angle => Arg1);

                when Tonangle =>
                    Result := Set_Direction (The_Object => To_Object,
                                             Get_Direction => Arg1);


                when Y =>
                    Arg2 := Arg1;
                    First_Coordinate := True;
                    Result := Object.Void_Reference;

                when Vaenx =>
                    if First_Coordinate then
                        Result := Goto_Xy (The_Object => To_Object,
                                           X => Arg1,
                                           Y => Arg2);
                        First_Coordinate := False;
                    else
                        raise Bug.Unknown_Turtle_Message;
                    end if;

            end case;

            Message.Next (L => Message_List, Mess => Message_Receive);
            Argument.Next (L => Args, Obj => Arg1);
            Counter.Stop_Time (Object.Turtle_Class);
        end loop;
        return Result;
    exception
        when Constraint_Error =>  
            raise Bug.Unknown_Turtle_Message;

    end Send;


    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
        Message_To_Turtle : Turtle_Unary_Message;
    begin

        Message_To_Turtle := Turtle_Unary_Message'Value
                                (Bs.Image (The_Message));
        Counter.Increase (Object.Turtle_Class);
        case Message_To_Turtle is

            when Levetaplume =>  
                Result := Head_Up (The_Object => To_Object);

            when Baissetaplume =>
                Result := Head_Down (The_Object => To_Object);

            when Rentrecheztoi =>  
                Result := Go_Home (The_Object => To_Object);

            when Tonx =>
                Result := Get_X (The_Object => To_Object);

            when Tony =>
                Result := Get_Y (The_Object => To_Object);

            when Tonangle =>
                Result := Get_Direction (The_Object => To_Object);

            when Clone =>
                Result := Clone (The_Object => To_Object);

            when Entexte =>
                In_Text (The_Object => To_Object);
                Result := To_Object;

            when Petit | Moyen | Large =>
                Result := Set_Size (The_Object => To_Object,
                                    The_Size => Message_To_Turtle);

        end case;
        Counter.Stop_Time (Class => Object.Turtle_Class);
        return Result;

    exception
        when Constraint_Error =>
            raise Bug.Unknown_Turtle_Message;
    end Send;

begin

    Reset;

end Turtle_Class;