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

opengl.model.box: Add a lit, colored and single textured box.

Browse Source
This commit is contained in:
Rod Kay
2023-05-08 11:40:37 +10:00
parent 0cbd97b7a1
commit d3e4119172
6 changed files with 277 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@@ -54,6 +54,7 @@ bin
box2d_HelloWorld
launch_box_rig_1_bone_demo
launch_diffuse_light
launch_many_boxes_textured_x1_demo
launch_simple_instant_events_demo
launch_simple_deferred_events_demo
launch_simple_chat_client

BIN
3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/assets/Face1.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.1 KiB

99
3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb Normal file
View File

@@ -0,0 +1,99 @@
with
openGL.Palette,
openGL.Model.Box.lit_colored_textured_x1,
openGL.Visual,
openGL.Light,
openGL.Demo;
procedure launch_many_Boxes_textured_x1_Demo
--
-- Exercise the culler with many lit, colored and single textured boxes.
--
is
use openGL,
openGL.Model,
openGL.Model.box,
openGL.Palette,
openGL.Math,
openGL.linear_Algebra_3d;
begin
Demo.print_Usage;
Demo.define ("openGL 'many Boxes' Demo");
-- Setup the camera.
--
Demo.Camera.Position_is ([0.0, 0.0, 5.0],
y_Rotation_from (to_Radians (0.0)));
declare
-- Create the box sprites.
--
face_Texture : constant asset_Name := to_Asset ("assets/Face1.bmp");
the_box_Model : constant Box.lit_colored_textured_x1.view
:= Box.lit_colored_textured_x1.new_Box
(size => [0.5, 0.5, 0.5],
faces => [front => (colors => [others => (White, Opaque)]),
rear => (colors => [others => (Blue, Opaque)]),
upper => (colors => [others => (Green, Opaque)]),
lower => (colors => [others => (Green, Opaque)]),
left => (colors => [others => (Dark_Red, Opaque)]),
right => (colors => [others => (Red, Opaque)])],
Texture => face_Texture);
Size : constant Integer := 70;
x : openGL.Real := -openGL.Real (Size) / 2.0;
z : openGL.Real := 0.0;
Sprites : constant Visual.views (1 .. Size * Size) := [others => Visual.Forge.new_Visual (Model.view (the_box_Model))];
begin
-- Position the sprites.
--
for i in Sprites'Range
loop
x := x + 1.0;
if i mod Size = 0
then
z := z - 1.0;
x := -openGL.Real (Size) / 2.0;
end if;
Sprites (i).Site_is ([x, 0.0, z]);
end loop;
-- Set up the light.
--
declare
the_Light : openGL.Light.item := Demo.Renderer.Light (1);
begin
the_Light.Site_is ([0.0, 5_000.0, 5_000.0]); -- TODO: Lighting is incorrect. The site appears to be the exact opposite of where it should be !
Demo.Renderer.set (the_Light);
end;
-- Main loop.
--
while not Demo.Done
loop
Demo.Dolly.evolve;
Demo.Done := Demo.Dolly.quit_Requested;
Demo.Camera.render (Sprites);
while not Demo.Camera.cull_Completed
loop
delay Duration'Small;
end loop;
Demo.Renderer.render;
Demo.FPS_Counter.increment; -- Frames per second display.
end loop;
end;
Demo.destroy;
end launch_many_Boxes_textured_x1_Demo;

17
3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/many_boxes_textured_x1_demo.gpr Normal file
View File

@@ -0,0 +1,17 @@
with
"opengl_demo",
"lace_shared";
project many_Boxes_textured_x1_Demo
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_many_boxes_textured_x1_demo.adb");
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 many_Boxes_textured_x1_Demo;

107
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.adb Normal file
View File

@@ -0,0 +1,107 @@
with
openGL.Geometry.lit_colored_textured,
openGL.Primitive.indexed;
package body openGL.Model.box.lit_colored_textured_x1
is
type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
---------
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in lit_colored_textured_x1.Faces;
Texture : in asset_Name) return View
is
Self : constant View := new Item;
begin
Self.Faces := Faces;
Self.texture_Name := Texture;
Self.Size := Size;
return Self;
end new_Box;
--------------
--- Attributes
--
overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views
is
pragma unreferenced (Fonts);
use Geometry.lit_colored_textured,
Primitive,
Texture;
the_Sites : constant box.Sites := Self.vertex_Sites;
the_Indices : aliased constant Indices := [ 1, 2, 3, 3, 4, 1, -- Front
5, 6, 7, 7, 8, 5, -- Rear
9, 10, 11, 11, 12, 9, -- Upper
13, 14, 15, 15, 16, 13, -- Lower
17, 18, 19, 19, 20, 17, -- Left
21, 22, 23, 23, 24, 21]; -- Right
the_Vertices : aliased constant Geometry.lit_colored_textured.Vertex_array (1 .. 6 * 4)
:= [ -- Front face.
1 => (Site => the_Sites ( Left_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
2 => (Site => the_Sites (Right_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
3 => (Site => the_Sites (right_upper_front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
4 => (Site => the_Sites ( Left_Upper_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
-- Rear face.
5 => (Site => the_Sites (Right_Lower_Rear), Normal => rear_Normal, Color => +Self.Faces (Rear).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
6 => (Site => the_Sites ( Left_Lower_Rear), Normal => rear_Normal, Color => +Self.Faces (Rear).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
7 => (Site => the_Sites ( Left_Upper_Rear), Normal => rear_Normal, Color => +Self.Faces (Rear).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
8 => (Site => the_Sites (Right_Upper_Rear), Normal => rear_Normal, Color => +Self.Faces (Rear).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
-- Upper face.
9 => (Site => the_Sites ( Left_Upper_Front), Normal => upper_Normal, Color => +Self.Faces (Upper).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
10 => (Site => the_Sites (Right_Upper_Front), Normal => upper_Normal, Color => +Self.Faces (Upper).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
11 => (Site => the_Sites (Right_Upper_Rear), Normal => upper_Normal, Color => +Self.Faces (Upper).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
12 => (Site => the_Sites ( Left_Upper_Rear), Normal => upper_Normal, Color => +Self.Faces (Upper).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
-- Lower face.
13 => (Site => the_Sites (Right_Lower_Front), Normal => lower_Normal, Color => +Self.Faces (Lower).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
14 => (Site => the_Sites ( Left_Lower_Front), Normal => lower_Normal, Color => +Self.Faces (Lower).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
15 => (Site => the_Sites ( Left_Lower_Rear), Normal => lower_Normal, Color => +Self.Faces (Lower).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
16 => (Site => the_Sites (Right_Lower_Rear), Normal => lower_Normal, Color => +Self.Faces (Lower).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
-- Left face.
17 => (Site => the_Sites (Left_Lower_Rear), Normal => left_Normal, Color => +Self.Faces (Left).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
18 => (Site => the_Sites (Left_Lower_Front), Normal => left_Normal, Color => +Self.Faces (Left).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
19 => (Site => the_Sites (Left_Upper_Front), Normal => left_Normal, Color => +Self.Faces (Left).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
20 => (Site => the_Sites (Left_Upper_Rear), Normal => left_Normal, Color => +Self.Faces (Left).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
-- Right face.
21 => (Site => the_Sites (Right_Lower_Front), Normal => right_Normal, Color => +Self.Faces (Right).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
22 => (Site => the_Sites (Right_Lower_Rear), Normal => right_Normal, Color => +Self.Faces (Right).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
23 => (Site => the_Sites (Right_Upper_Rear), Normal => right_Normal, Color => +Self.Faces (Right).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
24 => (Site => the_Sites (Right_Upper_Front), Normal => right_Normal, Color => +Self.Faces (Right).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine)];
the_Geometry : constant Geometry_view := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
the_Primitive : constant Primitive.view := Primitive.indexed .new_Primitive (Triangles, the_Indices).all'Access;
begin
the_Geometry.Vertices_are (the_Vertices);
the_Geometry.add (the_Primitive);
if Self.texture_Name /= null_Asset
then
the_Geometry.Texture_is (Textures.fetch (Self.texture_Name));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
end if;
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;
end openGL.Model.box.lit_colored_textured_x1;

53
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads Normal file
View File

@@ -0,0 +1,53 @@
with
openGL.Geometry,
openGL.Font,
openGL.Texture;
package openGL.Model.Box.lit_colored_textured_x1
--
-- Models a lit, colored and textured box.
--
-- Each face may be separately colored via each of its 4 vertices.
-- All faces use the same texture.
--
is
type Item is new Model.box.item with private;
type View is access all Item'Class;
type Face is
record
Colors : lucid_Colors (1 .. 4); -- The color of each faces 4 vertices.
end record;
type Faces is array (Side) of Face;
---------
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in lit_colored_textured_x1.Faces;
Texture : in asset_Name) return View;
--------------
--- Attributes
--
overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
private
type Item is new Model.box.item with
record
Faces : lit_colored_textured_x1.Faces;
texture_Name : asset_Name := null_Asset; -- The texture applied to all faces.
end record;
end openGL.Model.Box.lit_colored_textured_x1;