Re-enable mouse selection of sprites.

This commit is contained in:
Rod Kay
2023-04-21 17:43:18 +10:00
parent ac39003165
commit ac87a2e6ca
6 changed files with 110 additions and 217 deletions

View File

@@ -467,23 +467,29 @@ is
procedure cast_Ray (Self : in Item; From, To : in Vector_3;
Observer : in lace.Observer.view;
Context : access lace.Any.limited_item'Class;
event_Kind : in raycast_collision_Event'Class)
function cast_Ray (Self : in Item; From, To : in Vector_3) return ray_Collision
is
use type physics.Object.view;
physics_Collision : constant physics.Space.ray_Collision := Self.physics_Space.cast_Ray (From, To);
begin
null;
-- Self.Commands.add ((Kind => cast_Ray,
-- Sprite => null,
-- From => From,
-- To => To,
-- Observer => Observer,
-- Context => Context,
-- event_Kind => event_Kind'Tag));
if physics_Collision.near_Object = null
then
return ray_Collision' (near_Sprite => null,
others => <>);
else
return ray_Collision' (to_GEL (physics_Collision.near_Object),
physics_Collision.hit_Fraction,
physics_Collision.Normal_world,
physics_Collision. Site_world);
end if;
end cast_Ray;
--------------
--- Collisions
--
@@ -1102,25 +1108,6 @@ is
end impact_Responder;
----------
--- Events
--
function to_raycast_collision_Event (Params : not null access no_Parameters) return raycast_collision_Event
is
begin
return raycast_collision_Event' (others => <>);
end to_raycast_collision_Event;
overriding
procedure destruct (Self : in out raycast_collision_Event)
is
begin
free (Self.Context);
end destruct;
-----------
-- Testing