diff --git a/4-high/gel/source/world/gel-world.adb b/4-high/gel/source/world/gel-world.adb index e630814..39d6784 100644 --- a/4-high/gel/source/world/gel-world.adb +++ b/4-high/gel/source/world/gel-world.adb @@ -461,6 +461,7 @@ is + procedure Gravity_is (Self : in out Item; Now : in Vector_3) is begin @@ -469,6 +470,7 @@ is + function cast_Ray (Self : in Item; From, To : in Vector_3) return ray_Collision is use type physics.Object.view; @@ -491,6 +493,25 @@ is + function cast_Point (Self : in Item; Point : in Vector_3) return point_Collision + is + use type physics.Object.view; + + physics_Collision : constant physics.Space.point_Collision := Self.physics_Space.cast_Point (Point); + + begin + if physics_Collision.near_Object = null + then + return point_Collision' (near_Sprite => null, + others => <>); + else + return point_Collision' (to_GEL (physics_Collision.near_Object), + physics_Collision.Site_world); + end if; + end cast_Point; + + + -------------- --- Collisions diff --git a/4-high/gel/source/world/gel-world.ads b/4-high/gel/source/world/gel-world.ads index ff1dbdf..6b8f2fd 100644 --- a/4-high/gel/source/world/gel-world.ads +++ b/4-high/gel/source/world/gel-world.ads @@ -227,6 +227,20 @@ is + ----------------- + --- Point Casting + -- + + type point_Collision is + record + near_Sprite : gel.Sprite.view; + Site_world : Vector_3; + end record; + + function cast_Point (Self : in Item; Point : in Vector_3) return point_Collision; + + + -------------------- --- World Mirroring