diff --git a/4-high/gel/applet/demo/mouse/mouse_selection_2d/launch_mouse_selection_2d.adb b/4-high/gel/applet/demo/mouse/mouse_selection_2d/launch_mouse_selection_2d.adb new file mode 100644 index 0000000..c1e9b63 --- /dev/null +++ b/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; diff --git a/4-high/gel/applet/demo/mouse/mouse_selection_2d/mouse_selection_2d.gpr b/4-high/gel/applet/demo/mouse/mouse_selection_2d/mouse_selection_2d.gpr new file mode 100644 index 0000000..5e769c2 --- /dev/null +++ b/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;