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

121
4-high/gel/source/dolly/gel-dolly-following.adb Normal file
View File

@@ -0,0 +1,121 @@
package body gel.Dolly.following
is
overriding
procedure define (Self : in out Item)
is
begin
null;
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
null;
end destroy;
--------------
--- Attributes
--
procedure follow (Self : in out Item; the_Sprite : in gel.Sprite.view)
is
begin
Self.Sprite := the_Sprite;
end follow;
overriding
procedure allow_linear_Motion (Self : in out Item; Allow : in Boolean := True)
is
begin
Self.allow_linear_Motion := Allow;
end allow_linear_Motion;
overriding
procedure allow_orbital_Motion (Self : in out Item; Allow : in Boolean := True)
is
begin
Self.allow_orbital_Motion := Allow;
end allow_orbital_Motion;
function Offset (Self : in Item) return math.Vector_3
is
begin
return Self.sprite_Offset;
end Offset;
procedure Offset_is (Self : in out Item; Now : in math.Vector_3)
is
begin
Self.sprite_Offset := Now;
end Offset_is;
--------------
--- Operations
--
overriding
procedure freshen (Self : in out Item)
is
use Math,
linear_Algebra_3D;
Speed : math.Real renames Self.Speed;
the_sprite_Site : constant math.Vector_3 := Self.Sprite.Site;
the_Camera : constant gel.Camera.view := Self.Cameras.first_Element;
begin
-- Linear motion.
--
if Self.allow_linear_Motion
then
if Self.Motion (Forward) then Self.sprite_Offset := Self.sprite_Offset - the_Camera.Spin * [0.0, 0.0, 0.1 * Speed]; end if;
if Self.Motion (Backward) then Self.sprite_Offset := Self.sprite_Offset + the_Camera.Spin * [0.0, 0.0, 0.1 * Speed]; end if;
if Self.Motion (Up) then Self.sprite_Offset := Self.sprite_Offset + the_Camera.Spin * [0.0, 0.1 * Speed, 0.0]; end if;
if Self.Motion (Down) then Self.sprite_Offset := Self.sprite_Offset - the_Camera.Spin * [0.0, 0.1 * Speed, 0.0]; end if;
end if;
-- Orbit.
--
if Self.allow_orbital_Motion
then
if Self.Motion (Left)
then
Self.camera_y_Spin := Self.camera_y_Spin - 0.01 * Speed;
Self.sprite_Offset := y_Rotation_from (-0.01 * Speed) * Self.sprite_Offset;
the_Camera.Spin_is (xyz_Rotation (Self.camera_x_Spin,
Self.camera_y_Spin,
Self.camera_z_Spin));
end if;
if Self.Motion (Right)
then
Self.camera_y_Spin := Self.camera_y_Spin + 0.01 * Speed;
Self.sprite_Offset := y_Rotation_from (0.01 * Speed) * Self.sprite_Offset;
the_Camera.Spin_is (xyz_Rotation (Self.camera_x_Spin,
Self.camera_y_Spin,
Self.camera_z_Spin));
end if;
end if;
the_Camera.Site_is (the_sprite_Site + Self.sprite_Offset);
end freshen;
end gel.Dolly.following;

62
4-high/gel/source/dolly/gel-dolly-following.ads Normal file
View File

@@ -0,0 +1,62 @@
with
gel.Sprite;
package gel.Dolly.following
--
-- Provides a camera dolly which follows a sprite.
--
is
type Item is new gel.Dolly.item with private;
type View is access all Item'Class;
---------
--- Forge
--
overriding
procedure define (Self : in out Item);
overriding
procedure destroy (Self : in out Item);
--------------
--- Attributes
--
overriding
procedure allow_linear_Motion (Self : in out Item; Allow : in Boolean := True);
overriding
procedure allow_orbital_Motion (Self : in out Item; Allow : in Boolean := True);
procedure Offset_is (Self : in out Item; Now : in math.Vector_3);
function Offset (Self : in Item) return math.Vector_3;
--------------
--- Operations
--
overriding
procedure freshen (Self : in out Item);
procedure follow (Self : in out Item; the_Sprite : in gel.Sprite.view);
private
type Item is new gel.Dolly.item with
record
Sprite : gel.Sprite.view;
sprite_Offset : math.Vector_3 := [0.0, 30.0, 0.0];
allow_linear_Motion : Boolean := True;
allow_orbital_Motion : Boolean := True;
camera_x_Spin : math.Real := 0.0;
camera_y_Spin : math.Real := 0.0;
camera_z_Spin : math.Real := 0.0;
end record;
end gel.Dolly.following;

154
4-high/gel/source/dolly/gel-dolly-simple.adb Normal file
View File

@@ -0,0 +1,154 @@
package body gel.Dolly.simple
is
overriding
procedure define (Self : in out Item)
is
begin
null;
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
null;
end destroy;
--------------
-- Operations
--
overriding
procedure freshen (Self : in out Item)
is
use Math,
linear_Algebra_3D;
Speed : constant Real := Self.Speed * Self.Multiplier;
rotate_Factor : constant Real := 0.04;
orbit_Factor : constant Real := 0.08;
initial_Site : constant Vector_3 := Self.Cameras.first_Element.Site;
initial_Spin : constant Matrix_3x3 := Self.Cameras.first_Element.Spin;
new_Site : Vector_3;
new_Spin : Matrix_3x3;
site_Updated : Boolean := False;
spin_Updated : Boolean := False;
procedure update_Site (To : in Vector_3)
is
begin
new_Site := To;
site_Updated := True;
end update_Site;
procedure update_Spin (To : in math.Matrix_3x3)
is
begin
new_Spin := To;
spin_Updated := True;
end update_Spin;
begin
-- Linear Motion
--
if Self.Motion (Forward) then update_Site (initial_Site - forward_Direction (initial_Spin) * Speed); end if;
if Self.Motion (Backward) then update_Site (initial_Site + forward_Direction (initial_Spin) * Speed); end if;
if Self.Motion (Left) then update_Site (initial_Site - right_Direction (initial_Spin) * Speed); end if;
if Self.Motion (Right) then update_Site (initial_Site + right_Direction (initial_Spin) * Speed); end if;
if Self.Motion (Up) then update_Site (initial_Site + up_Direction (initial_Spin) * Speed); end if;
if Self.Motion (Down) then update_Site (initial_Site - up_Direction (initial_Spin) * Speed); end if;
-- Angular Spin
--
if Self.Spin (Left) then update_Spin (y_Rotation_from (-rotate_Factor) * initial_Spin); end if;
if Self.Spin (Right) then update_Spin (y_Rotation_from ( rotate_Factor) * initial_Spin); end if;
if Self.Spin (Forward) then update_Spin (x_Rotation_from ( rotate_Factor) * initial_Spin); end if;
if Self.Spin (Backward) then update_Spin (x_Rotation_from (-rotate_Factor) * initial_Spin); end if;
if Self.Spin (Up) then update_Spin (z_Rotation_from (-rotate_Factor) * initial_Spin); end if;
if Self.Spin (Down) then update_Spin (z_Rotation_from ( rotate_Factor) * initial_Spin); end if;
-- Orbit
--
if Self.Orbit (Left)
then
update_Site (initial_Site * y_Rotation_from (orbit_Factor * Speed));
update_Spin (initial_Spin * y_Rotation_from (orbit_Factor * Speed));
end if;
if Self.Orbit (Right)
then
update_Site (initial_Site * y_Rotation_from (-orbit_Factor * Speed));
update_Spin (initial_Spin * y_Rotation_from (-orbit_Factor * Speed));
end if;
if Self.Orbit (Forward)
then
update_Site (initial_Site * x_Rotation_from (-orbit_Factor * Speed));
update_Spin (initial_Spin * x_Rotation_from (-orbit_Factor * Speed));
end if;
if Self.Orbit (Backward)
then
update_Site (initial_Site * x_Rotation_from (orbit_Factor * Speed));
update_Spin (initial_Spin * x_Rotation_from (orbit_Factor * Speed));
end if;
if Self.Orbit (Up)
then
update_Site (initial_Site * z_Rotation_from (-orbit_Factor * Speed));
update_Spin (initial_Spin * z_Rotation_from (-orbit_Factor * Speed));
end if;
if Self.Orbit (Down)
then
update_Site (initial_Site * z_Rotation_from (orbit_Factor * Speed));
update_Spin (initial_Spin * z_Rotation_from (orbit_Factor * Speed));
end if;
-- Update each camera with new site and spin.
--
declare
use camera_Vectors;
the_Camera : gel.Camera.view;
Cursor : camera_Vectors.Cursor := Self.Cameras.First;
begin
while has_Element (Cursor)
loop
the_Camera := Element (Cursor);
if site_Updated
then
the_Camera.Site_is (new_Site);
end if;
if spin_Updated
then
the_Camera.Spin_is (new_Spin);
end if;
next (Cursor);
end loop;
end;
end freshen;
end gel.Dolly.simple;

35
4-high/gel/source/dolly/gel-dolly-simple.ads Normal file
View File

@@ -0,0 +1,35 @@
package gel.Dolly.simple
--
-- Provides a simple camera dolly.
--
is
type Item is new gel.Dolly.item with private;
type View is access all Item'Class;
---------
--- Forge
--
overriding
procedure define (Self : in out Item);
overriding
procedure destroy (Self : in out Item);
--------------
--- Operations
--
overriding
procedure freshen (Self : in out Item);
private
type Direction_Flags is array (Direction) of Boolean;
type Item is new gel.Dolly.item with null record;
end gel.Dolly.simple;

83
4-high/gel/source/dolly/gel-dolly.adb Normal file
View File

@@ -0,0 +1,83 @@
with
ada.unchecked_Deallocation;
package body gel.Dolly
is
use Math;
procedure free (Self : in out View)
is
procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
begin
if Self = null
then
return;
end if;
Self.destroy;
deallocate (Self);
end free;
--------------
--- Attributes
--
procedure add_Camera (Self : in out Item'Class; the_Camera : in Camera.view)
is
begin
Self.Cameras.append (the_Camera);
end add_Camera;
procedure is_moving (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True)
is
begin
Self.Motion (Direction) := Now;
end is_moving;
procedure is_spinning (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True)
is
begin
Self.Spin (Direction) := Now;
end is_spinning;
procedure is_orbiting (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True)
is
begin
Self.Orbit (Direction) := Now;
end is_orbiting;
procedure Speed_is (Self : in out Item; Now : in Real)
is
begin
Self.Speed := Now;
end Speed_is;
function Speed (Self : in Item) return Real
is
begin
return Self.Speed;
end Speed;
procedure speed_Multiplier_is (Self : in out Item; Now : in Real)
is
begin
Self.Multiplier := Now;
end speed_Multiplier_is;
end gel.Dolly;

74
4-high/gel/source/dolly/gel-dolly.ads Normal file
View File

@@ -0,0 +1,74 @@
with
gel.Camera,
ada.Containers.Vectors;
package gel.Dolly
--
-- Models a camera dolly.
--
is
type Item is abstract tagged private;
type View is access all Item'Class;
---------
--- Forge
--
procedure define (Self : in out Item) is abstract;
procedure destroy (Self : in out Item) is abstract;
procedure free (Self : in out View);
--------------
--- Attributes
--
type Direction is (Left, Right, Up, Down, Forward, Backward);
procedure add_Camera (Self : in out Item'Class; the_Camera : in Camera.view);
procedure is_moving (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True);
procedure is_spinning (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True);
procedure is_orbiting (Self : in out Item'Class; Direction : dolly.Direction; Now : in Boolean := True);
function Speed (Self : in Item) return math.Real;
procedure Speed_is (Self : in out Item; Now : in math.Real);
procedure speed_Multiplier_is (Self : in out Item; Now : in math.Real);
procedure allow_linear_Motion (Self : in out Item; Allow : in Boolean) is null;
procedure allow_orbital_Motion (Self : in out Item; Allow : in Boolean) is null;
--------------
--- Operations
--
procedure freshen (Self : in out Item) is abstract;
private
use type gel.Camera.view;
package camera_Vectors is new ada.Containers.Vectors (Positive, gel.Camera.view);
subtype camera_Vector is camera_Vectors.Vector;
type Direction_Flags is array (Direction) of Boolean;
type Item is abstract tagged
record
Cameras : camera_Vector;
Motion : Direction_Flags := [others => False];
Spin : Direction_Flags := [others => False];
Orbit : Direction_Flags := [others => False];
Speed : math.Real := 1.0;
Multiplier : math.Real := 1.0; -- Applied to speed.
end record;
end gel.Dolly;