DataMuseum.dk

top - download

    Length: 6422 (0x1916)
    Types: TextFile
    Names: »B«

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Tiny_Error;
with Integer_Classe;
package body Turtle_Classe is

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

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

    function Free_Index return Index_Table is
        Index : Index_Table := 1;
        Found : Boolean := False;
        Turtle_Table_Full : exception;
    begin
        while Index <= Max_Table loop
            if Turtle_Table (Index) = Void_Turtle then
                Found := True;
            else
                Index := Index + 1;
            end if;
        end loop;  
        if Found then
            return (Index);
        else
            raise Turtle_Table_Full;
        end if;
--    exception
--        when Turtle_Table_Full =>
--            Tiny_Error.Turtle_Table_Ful;
    end Free_Index;

    function Get_Turtle (The_Object : Object.Reference) return Object_Turtle is
    begin
        return Turtle_Table (Object.Get_Value (The_Object));
    end Get_Turtle;

    function Create 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 (Object.Turtle_Classe, Index);
        return New_Object;
    end Create;

    procedure Remove (The_Object : Object.Reference) is
    begin
        Turtle_Table (Object.Get_Value (The_Object)) := Void_Turtle;
    end Remove;

    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 (The_Object);
        New_Index := Free_Index;
        Turtle_Table (New_Index) := The_New_Turtle;
        New_Object := Object.Create (Object.Turtle_Classe, New_Index);
        return New_Object;
    end Clone;

    function The_X (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        The_X_Value : Integer;
    begin  
        The_Turtle := Get_Turtle (The_Object);
        The_X_Value := Integer (The_Turtle.X);
        return Integer_Classe.Create (The_X_Value);
    end The_X;

    function The_Y (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        The_Y_Value : Integer;
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Y_Value := Integer (The_Turtle.Y);
        return Integer_Classe.Create (The_Y_Value);
    end The_Y;

    function The_Direction (The_Object : Object.Reference)
                           return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;  
        The_Direction_Value : Integer;
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Direction_Value := Integer (The_Turtle.Angle);
        return Integer_Classe.Create (The_Direction_Value);
    end The_Direction;

    function Head_Up (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Turtle.Head_State := False;  
        return The_Object;
    end Head_Up;

    function Head_Down (The_Object : Object.Reference)
                       return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Turtle.Head_State := True;
        return The_Object;
    end Head_Down;

    function Reset (The_Object : Object.Reference) return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Turtle := Void_Turtle;
        return The_Object;
    end Reset;

    function Goto_X (The_Object, The_X : Object.Reference)
                    return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        X_Position : Integer := Object.Get_Value (The_X);
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Turtle.X := Easy_X.Coordinate (X_Position);
        return Move (The_Object);
    end Goto_X;

    function Goto_Y (The_Object, The_Y : Object.Reference)
                    return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        Y_Position : Integer := Object.Get_Value (The_Y);
    begin
        The_Turtle := Get_Turtle (The_Object);
        The_Turtle.Y := Easy_X.Coordinate (Y_Position);
        return Move (The_Object);
    end Goto_Y;

    function Put_Direction (The_Object, The_Direction : Object.Reference)
                           return Object.Reference is
        The_Turtle : Object_Turtle := Void_Turtle;
        The_Direction_Value : Integer := Object.Get_Value (The_Direction);
    begin
        The_Turtle := Get_Turtle (The_Object);  
        The_Turtle.Angle := Direction (The_Direction_Value);
        return The_Object;
    end Put_Direction;

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


    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
    begin
        [statement]
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.List;
                   With_Arguments : Argument.List) return Object.Reference is
    begin
        [statement]
    end Send;



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

end Turtle_Classe;