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

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
4-high/gel/applet/test/add_rid/add_rid.gpr Normal file
View File

@@ -0,0 +1,17 @@
with
"gel",
"lace_shared";
project add_rid
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_add_rid.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 add_rid;

191
4-high/gel/applet/test/add_rid/launch_add_rid.adb Normal file
View File

@@ -0,0 +1,191 @@
with
gel.Window.sdl,
gel.Applet.gui_world,
gel.Forge,
gel.Sprite,
gel.Joint,
physics.Forge,
opengl.Palette,
float_math.Algebra.linear.d3,
ada.Text_IO,
ada.Exceptions;
pragma Unreferenced (gel.Window.sdl);
procedure launch_add_rid
--
-- Creates a chain of balls in a 2d space.
--
is
package Math renames float_Math;
use GEL,
gel.Forge,
gel.Applet,
opengl.Palette,
gel.Math,
gel.linear_Algebra_2D,
ada.Text_IO;
use type openGL.Real;
type Tests is (None,
add_rid_Joint,
add_rid_Object,
destroy_Object);
-- my_Test : Tests := None;
my_Test : Tests := add_rid_Joint;
-- my_Test : Tests := add_rid_Object;
-- my_Test : Tests := destroy_Object;
the_Applet : gel.Applet.gui_World.view := new_gui_Applet ("Add/Rid Test",
1536, 864,
space_Kind => physics.Box2D);
the_Ground : gel.Sprite .view := new_rectangle_Sprite (the_Applet.gui_World,
mass => 0.0,
width => 100.0,
height => 1.0,
color => apple_Green);
begin
the_Applet.gui_World .Gravity_is ((0.0, -10.0, 0.0));
the_Applet.gui_Camera.Site_is ((0.0, -30.0, 100.0));
the_Applet.Renderer .Background_is (Grey);
the_Applet.enable_simple_Dolly (in_world => gui_world.gui_world_Id);
the_Ground.Site_is ((0.0, -40.0, 0.0));
the_Applet.gui_World.add (the_Ground, and_Children => False);
-- Add joints.
--
declare
use Math, math.Algebra.linear.d3, math.Vectors;
ball_Count : constant := 39; -- 256;
the_root_Ball : constant gel.Sprite.view := new_circle_Sprite (the_Applet.gui_World, mass => 0.0);
the_Balls : constant gel.Sprite.views := (1 .. ball_Count - 1 => new_circle_Sprite (the_Applet.gui_World, mass => 1.0),
ball_Count => new_circle_Sprite (the_Applet.gui_World, mass => 10.0));
mid_Ball_Id : constant Index := Index (the_Balls'First + the_Balls'Last) / 2;
mid_Ball : gel.Sprite.view renames the_Balls (mid_Ball_Id);
mid_Ball_initial_Offset
: Vector_3;
begin
-- the_root_Ball.Site_is ((0.0, 0.0, 0.0));
declare
Frame_A : constant math.Matrix_4x4 := math.Identity_4x4;
Frame_B : constant math.Matrix_4x4 := math.Identity_4x4;
Parent : gel.Sprite.view := the_root_Ball;
new_Joint : gel.Joint .view;
begin
for i in the_Balls'Range
loop
the_Balls (i).Site_is ((Real (-i), 0.0, 0.0));
-- Parent.attach_via_Hinge (the_Child => the_Balls (i),
-- Frame_in_parent => Frame_A,
-- Frame_in_child => Frame_B,
-- Limits => (to_Radians (-180.0),
-- to_Radians ( 180.0)),
-- collide_Connected => False,
-- new_joint => new_Joint);
Parent.attach_via_Hinge (the_Child => the_Balls (i),
pivot_Axis => (0.0, 0.0, 1.0),
low_Limit => to_Radians (-180.0),
high_Limit => to_Radians ( 180.0),
new_joint => new_Joint);
if i = mid_Ball_Id then
mid_Ball_initial_Offset := the_Balls (i).Site - Parent.Site;
end if;
Parent := the_Balls (i);
end loop;
end;
the_Applet.gui_World.add (the_root_Ball, and_Children => True);
declare
Counter : Natural := 0;
Added : Boolean := True;
begin
while the_Applet.is_open
loop
Counter := Counter + 1;
if false -- Counter mod (2 * 60) = 0
then
if Added then
case my_Test
is
when None =>
null;
when add_rid_Joint =>
the_Applet.gui_World.rid (mid_Ball.parent_Joint);
when add_rid_Object =>
-- the_Applet.gui_World.rid (mid_Ball.parent_Joint);
the_Applet.gui_World.rid (mid_Ball, and_children => False);
when destroy_Object =>
the_Applet.gui_World.rid (mid_Ball, and_children => False);
the_Applet.gui_World.destroy (mid_Ball);
my_Test := None;
end case;
Added := False;
else
case my_Test
is
when None =>
null;
when add_rid_Joint =>
mid_Ball.move (to_site => mid_Ball.parent_Joint.Sprite_A.Site
+ mid_Ball_initial_Offset);
the_Applet.gui_World.add (mid_Ball.parent_Joint);
when add_rid_Object =>
-- mid_Ball.move (to_site => mid_Ball.parent_Joint.Sprite_A.Site
-- + mid_Ball_initial_Offset);
the_Applet.gui_World.add (mid_Ball, and_children => False);
-- the_Applet.gui_World.add (mid_Ball.parent_Joint);
when destroy_Object =>
null;
end case;
Added := True;
end if;
end if;
the_Applet.freshen; -- Handle any new events and update the screen.
end loop;
end;
end;
gel.Applet.gui_world.free (the_Applet);
exception
when E : others =>
new_Line;
put_Line ("Unhandled exception in main thread !");
put_Line (Ada.Exceptions.Exception_Information (E));
new_Line;
end launch_add_rid;

24
4-high/gel/applet/test/leaks/basic_window/launch_check.sh Executable file
View File

@@ -0,0 +1,24 @@
#!/bin/bash
set -e
gprbuild -XOS=Linux \
-Xrestrictions=xgc \
-Xopengl_platform=glx \
-Xopengl_profile=desk \
-XBuild_Mode=debug \
-XFLORIST_BUILD=default \
-XBUILD_KIND=release \
-XOSTYPE=linux-gnu \
-XLIBRARY_TYPE=static \
-XSDLADA_BUILD=release.static \
-P ../../../demo/hello_mmi/hello_lumen_mmi.gpr
valgrind --suppressions=../suppress-mesa.supp \
--log-file=leak-check.txt \
--leak-check=yes \
../../../demo/hello_mmi/launch_hello_mmi
cat leak-check.txt

7736
4-high/gel/applet/test/leaks/suppress-mesa.supp Normal file
View File

File diff suppressed because it is too large Load Diff

21
4-high/gel/applet/test/single/add_rid_sprite/add_rid_sprite_test.gpr Normal file
View File

@@ -0,0 +1,21 @@
with
"gel",
"lace_shared";
project add_rid_Sprite_Test
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_add_rid_sprite_test.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;
package Linker is
for Default_Switches ("ada") use ("-lGL", "-lX11", "-lexpat", "-g");
end Linker;
end add_rid_Sprite_Test;

77
4-high/gel/applet/test/single/add_rid_sprite/launch_add_rid_sprite_test.adb Normal file
View File

@@ -0,0 +1,77 @@
with
gel.Forge,
gel.Window.setup,
gel.Applet.gui_world,
gel.World,
gel.Camera,
gel.Sprite,
ada.Calendar;
pragma Unreferenced (gel.Window.setup);
procedure launch_add_rid_sprite_Test
--
-- drops a ball onto a box terrain.
--
--
is
use ada.Calendar;
the_Applet : constant gel.Applet.gui_world.view
:= gel.forge.new_gui_Applet ("Add/Rid Sprite Test", 500, 500);
the_Box : constant gel.Sprite.view
:= gel.forge.new_box_Sprite (the_Applet.gui_World, mass => 0.0);
the_Balls : gel.Sprite.views (1 .. 1)
:= [others => gel.forge.new_ball_Sprite (the_Applet.gui_World, mass => 1.0)];
next_render_Time : ada.calendar.Time;
begin
the_Applet.gui_Camera.Site_is ([0.0, 5.0, 15.0]); -- Position the camera
the_Applet.enable_simple_Dolly (1); -- Enable user camera control via keyboards
the_Applet.enable_Mouse (detect_Motion => False); -- Enable mouse events.
the_Applet.gui_World.add (the_Box); -- Add the ground box.
the_Box.Site_is ([0.0, 0.0, 0.0]);
for Each in the_Balls'range
loop
the_Applet.gui_World.add (the_Balls (Each)); -- Add ball.
the_Balls (Each).Site_is ([0.0, 10.0, 0.0]);
end loop;
for Each in 1 .. 100
loop
the_Applet.gui_World.evolve; -- Evolve the world.
the_Applet.freshen; -- Handle any new events and update the screen.
end loop;
for Each in the_Balls'range
loop
the_Applet.gui_World.rid (the_Balls (Each)); -- Rid ball.
gel.Sprite.free (the_Balls (Each));
end loop;
next_render_Time := ada.Calendar.clock;
while the_Applet.is_open
loop
the_Applet.gui_World.evolve; -- Evolve the world.
the_Applet.freshen; -- Handle any new events and update the screen.
next_render_Time := next_render_Time + gel.World.evolve_Period;
delay until next_render_Time;
end loop;
the_Applet.destroy;
end launch_add_rid_sprite_Test;