gel.demo.mouse: Add 'launch_mouse_selection_2d'.

4-high/gel/applet/demo/mouse/mouse_selection_2d/launch_mouse_selection_2d.adb

@@ -0,0 +1,130 @@
+with
+     gel.Window.setup,
+     gel.Applet.gui_world,
+     gel.World,
+     gel.Camera,
+     gel.Mouse,
+     gel.Sprite,
+     gel.Events,
+     gel.Forge,
+
+     Physics,
+     float_Math,
+     lace.Response,
+     lace.Event.utility,
+
+     Ada.Calendar,
+     Ada.Text_IO,
+     Ada.Exceptions;
+
+pragma unreferenced (gel.Window.setup);
+
+
+procedure launch_mouse_Selection_2D
+--
+-- Places a sphere sprite in the world and registers an event repsonse to
+-- handle mouse clicks on the sprite.
+--
+is
+   use lace.Event.utility,
+       ada.Text_IO;
+
+   the_Applet : gel.Applet.gui_world.view;
+
+begin
+   lace.Event.utility.use_text_Logger ("events");
+   lace.Event.utility.Logger.ignore (to_Kind (gel.Mouse.motion_Event'Tag));
+
+   the_Applet := gel.Forge.new_gui_Applet ("mouse_Demo",
+                                           space_Kind => physics.Box2D);
+   declare
+      use ada.Calendar;
+
+      the_Ball : constant gel.Sprite.view := gel.Forge.new_circle_Sprite (the_Applet.World (1),
+                                                                          Mass => 1.0);
+
+
+      type retreat_Sprite is new lace.Response.item with
+         record
+            Sprite : gel.Sprite.view;
+         end record;
+
+      overriding
+      procedure respond (Self : in out retreat_Sprite;  to_Event : in lace.Event.Item'Class)
+      is
+         use float_Math;
+      begin
+         put_Line ("*** retreat_Sprite ***");
+         Self.Sprite.Site_is (Self.Sprite.Site - the_Applet.gui_Camera.Spin * [1.0, 0.0, 0.0]);
+      end respond;
+
+      retreat_Sprite_Response : aliased retreat_Sprite := (lace.Response.item with sprite => the_Ball);
+
+
+
+
+      type advance_Sprite is new lace.Response.item with
+         record
+            Sprite : gel.Sprite.view;
+         end record;
+
+      overriding
+      procedure respond (Self : in out advance_Sprite;  to_Event : in lace.Event.Item'Class)
+      is
+         use float_Math;
+      begin
+         put_Line ("*** advance_Sprite ***");
+         Self.Sprite.Site_is (Self.Sprite.Site + the_Applet.gui_Camera.Spin * [1.0, 0.0, 0.0]);
+      end respond;
+
+      advance_Sprite_Response : aliased advance_Sprite := (lace.Response.item with Sprite => the_Ball);
+
+
+
+      use float_Math;
+
+      next_render_Time : ada.calendar.Time;
+
+   begin
+      the_Applet.gui_World.Gravity_is ([0.0, 0.0, 0.0]);
+
+      connect (the_Observer  =>  the_Applet.local_Observer,
+               to_Subject    =>  the_Ball.all'Access,
+               with_Response =>  advance_Sprite_Response'unchecked_Access,
+               to_Event_Kind =>  to_Kind (gel.events.sprite_click_down_Event'Tag));
+
+      connect (the_Observer  =>  the_Applet.local_Observer,
+               to_Subject    =>  the_Ball.all'Access,
+               with_Response =>  retreat_Sprite_Response'unchecked_Access,
+               to_Event_Kind =>  to_Kind (gel.events.sprite_click_up_Event'Tag));
+
+
+      the_Applet.gui_world .add      (the_Ball, and_Children => False);
+      the_Applet.gui_Camera.Site_is  ([0.0, 0.0, 5.0]);
+      the_Applet.enable_simple_Dolly (in_World => 1);
+      the_Applet.enable_Mouse        (detect_Motion => False);
+
+
+      next_render_Time := ada.calendar.Clock;
+
+      while the_Applet.is_open
+      loop
+         the_Applet.freshen;
+         next_render_Time := next_render_Time + gel.World.evolve_Period;
+         delay until next_render_Time;
+      end loop;
+
+      the_Applet.destroy;
+   end;
+
+   lace.Event.utility.close;
+
+
+exception
+   when E : others =>
+      lace.Event.utility.close;
+      the_Applet.destroy;
+
+      put_Line ("Exception detected in 'launch_mouse_Selection' ...");
+      put_Line (ada.Exceptions.Exception_Information (E));
+end launch_mouse_Selection_2D;

4-high/gel/applet/demo/mouse/mouse_selection_2d/mouse_selection_2d.gpr

@@ -0,0 +1,18 @@
+with
+     "gel_sdl",
+     "lace_shared";
+
+
+project Mouse_selection_2D
+is
+   for Object_Dir use "build";
+   for Exec_Dir   use ".";
+   for Main       use ("launch_mouse_selection_2d.adb");
+   for Languages  use ("Ada");
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+end Mouse_selection_2D;