⟦92bc2a5d5⟧

E3 Source Code



separate (Decision_System_2.Fruit_Rule_Bundle)

package body Put_Block_On_New_Tower_Rule is

    function Premiss return Fact_Queries is
        use Fruit_Frames;
    begin
        return (Markers.Exist ((Name => Is_Equal (Top_Block_Marker_Name))),
                Markers.Exist ((Name => Is_Equal (Selected_Block_Marker_Name))),
                Markers.Exist ((Name => Is_Equal
                                           (Top_Copied_Model_Marker_Name))),
                Markers.Exist ((Name => Is_Equal (Model_Marker_Name))));
    end Premiss;


    procedure Action (Objects : Fact_Collection) is  
        use Visual_System_2;
        use Fruit_Frames;
        Top_Block_Marker        : Fact_Name renames Objects (1);
        Selected_Marker         : Fact_Name renames Objects (2);
        Top_Copied_Model_Marker : Fact_Name renames Objects (3);  
        Model_Marker            : Fact_Name renames Objects (4);
        Moving_Possible         : Boolean := True; 
        The_Label               : Labels;

        procedure Search_Next_Block_In_Model is
        begin
            Moving_Possible := True;
            Moving_Possible := Move (Model_Marker_Id, Up);

            if (Get_Label (Model_Marker_Id) = Null_Label) or
               (not Moving_Possible) then
                -- the model has been copied
                Markers.Delete (Model_Marker);
            end if;
        end Search_Next_Block_In_Model;


        procedure Place_On_Table_Marker_On_The_Bottom_Right is
        begin
            Moving_Possible := True;
            while Moving_Possible loop
                Moving_Possible := Move (On_Table_Marker_Id, Down);
            end loop;
            Moving_Possible := True;
            while Moving_Possible loop
                Moving_Possible := Move (On_Table_Marker_Id, Right);
            end loop;
        end Place_On_Table_Marker_On_The_Bottom_Right;

        procedure Move_Top_Block_On_Free_Place is  
            Moving_Down : Boolean := True;
        begin  
            Moving_Possible := True;
            while (Get_Label (On_Table_Marker_Id) /= Null_Label) and
                     Moving_Possible loop  
                Moving_Possible := Move (On_Table_Marker_Id, Left);
            end loop;

            if not Moving_Possible then
                --if no free place available then search on next level
                -- search from right to left
                Moving_Possible := Move (On_Table_Marker_Id, Up);
                Moving_Possible := True;
                while Moving_Possible loop
                    Moving_Possible := Move (On_Table_Marker_Id, Right);
                end loop;

                --recursive search: possible only if there is a free place
                --available in the environment
                Move_Top_Block_On_Free_Place;
            else
                -- is the free block in the column where the selected_block is ?
                -- or in the copied_model column?
                Moving_Down := True;
                Moving_Down := Move (On_Table_Marker_Id, Down);
                if Is_Same (Top_Block_Marker_Id, On_Table_Marker_Id) or
                   Is_Same (Top_Copied_Model_Marker_Id, On_Table_Marker_Id) then

                    --search another free place
                    if Moving_Down then
                        Moving_Possible := Move (On_Table_Marker_Id, Up);
                    end if;
                    Move_Top_Block_On_Free_Place;
                else
                    -- have found a free place
                    if Moving_Down then
                        Moving_Possible := Move (On_Table_Marker_Id, Up);
                    end if;
                    Put_Block (Block_Marked_With_Id    => Top_Block_Marker_Id,
                               On_Marked_Place_With_Id => On_Table_Marker_Id);
                    Markers.Delete (Top_Block_Marker);
                end if;
            end if;
        end Move_Top_Block_On_Free_Place;

    begin

        if Is_Same (Selected_Block_Marker_Id, Top_Block_Marker_Id) then
            -- when the selected block is on the top of a stack

            Moving_Possible := Move (Top_Copied_Model_Marker_Id, Up);
            Put_Block (Block_Marked_With_Id    => Selected_Block_Marker_Id,
                       On_Marked_Place_With_Id => Top_Copied_Model_Marker_Id);

            Markers.Delete (Selected_Marker);
            Markers.Delete (Top_Block_Marker);

            Search_Next_Block_In_Model;

        else
            -- first the top of the stack must be moved away until the
            -- selected block is on the top

            -- to search a free place:place first table_marker on bottom right
            -- of the table
            Place_On_Table_Marker_On_The_Bottom_Right;

            -- move top block on free place (because selected block is not on top)
            Move_Top_Block_On_Free_Place;

        end if;
    end Action;


end Put_Block_On_New_Tower_Rule;
DataMuseum.dk

Rational R1000/400

⟦92bc2a5d5⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
