nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Re-enable mouse selection of sprites.

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

49
4-high/gel/source/world/gel-world.adb
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

34
4-high/gel/source/world/gel-world.ads
View File

@@ -14,6 +14,7 @@ with
lace.Subject_and_deferred_Observer,
lace.Any,
ada.Streams,
ada.Tags.generic_dispatching_Constructor,
ada.unchecked_Conversion,
ada.Containers.hashed_Maps;
@@ -38,6 +39,10 @@ is
use Math;
type Any_limited_view is access all lace.Any.limited_item'Class;
---------
-- Forge
--
@@ -215,36 +220,9 @@ is
Site_world : Vector_3;
end record;
type Any_limited_view is access all lace.Any.limited_item'Class;
type raycast_collision_Event is new lace.Event.item with
record
near_Sprite : gel.Sprite.view;
Context : Any_limited_view;
Site_world : Vector_3;
end record;
overriding
procedure destruct (Self : in out raycast_collision_Event);
function cast_Ray (Self : in Item; From, To : in Vector_3) return ray_Collision;
type no_Parameters is null record;
function to_raycast_collision_Event (Params : not null access no_Parameters) return raycast_collision_Event;
function raycast_collision_Event_dispatching_Constructor is new ada.Tags.generic_dispatching_Constructor (raycast_collision_Event,
Parameters => no_Parameters,
Constructor => to_raycast_collision_Event);
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);
--
-- Casts a ray between From and To.
-- The Observer is informed of the 1st collision with a Sprite via a raycast_collision_Event.
-- Context is optional and is passed back to the Observer within the Context field of the raycast_collision_Event
-- for use by the raycast_collision_Event response.
--------------------