with openGL.texture_Set, openGL.Palette, openGL.Font, openGL.IO, openGL.Model.arrow .colored, openGL.Model.billboard.textured, openGL.Model.box .colored, openGL.Model.box .textured, openGL.Model.box .lit_textured, openGL.Model.capsule .lit_textured, openGL.Model.circle .lit_textured, openGL.Model.grid, openGL.Model.hexagon .lit_colored, openGL.Model.hexagon .lit_textured, openGL.Model.hexagon_Column.lit_colored_faceted, openGL.Model.hexagon_Column.lit_colored_rounded, openGL.Model.line .colored, openGL.Model.any, openGL.Model.polygon .lit_colored, openGL.Model.polygon .lit_textured, openGL.Model.segment_line, openGL.Model.sphere .colored, openGL.Model.sphere .lit_colored, openGL.Model.sphere .lit_textured, openGL.Model.sphere .lit_colored_textured, openGL.Model.Text .lit_colored, openGL.Model.terrain, openGL.Light, SDL.Video.Windows.Makers, ada.Text_IO; package body openGL.Demo is -- package std_SDL renames standard.SDL; procedure my_context_Setter is begin sdl.Video.gl.set_Current (GL_Context, To => Window); end my_context_Setter; procedure my_Swapper is use sdl.Video.GL; begin swap (Window); end my_Swapper; procedure define (Name : in String; Width : in Positive := 1366; Height : in Positive := 768) is use Palette, linear_Algebra_3d, SDL; use type sdl.Video.Windows.Window_Flags; null_Context : SDL.Video.GL.Contexts; begin if not sdl.initialise then raise Error with "Unable to initialise SDL."; end if; Video.Windows.Makers.create (Win => Window, Title => Name, X => 100, Y => 100, Width => C.int (Width), Height => C.int (Height), Flags => Video.Windows.openGL or Video.Windows.Resizable); Video.GL.create (GL_Context, From => Window); Renderer.define; Renderer.Background_is (Grey); Renderer.Swapper_is (my_Swapper'unrestricted_Access); sdl.Video.gl.set_Current (null_Context, To => Window); Renderer.Context_Setter_is (my_context_Setter'unrestricted_Access); Renderer.start_Engine; Camera.define; Camera.Renderer_is (Renderer'unchecked_Access); Camera.Position_is ([0.0, 0.0, 5.0], y_Rotation_from (to_Radians (0.0))); Camera.Viewport_is (width => Width, height => Height); declare use openGL.Light; the_Light : openGL.Light.item := Demo.Renderer.new_Light; begin the_Light. Site_is ([5_000.0, 2_000.0, 5_000.0]); the_Light.Color_is (Grey); -- the_Light.Color_is (Black); Demo.Renderer.set (the_Light); end; end define; procedure destroy is begin Camera .destroy; Renderer.stop_Engine; ada.Text_IO.new_Line; end destroy; function Models return openGL.Model.views is use Model, Palette; the_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/Face1.bmp"); the_font_Id : constant Font.font_Id := (to_Asset ("assets/opengl/font/LiberationMono-Regular.ttf"), Size => 12); the_arrow_Model : constant Model.arrow.colored.view := Model.arrow.colored.new_Arrow (End_2 => [0.0, 1.0, 0.0]); the_ball_1_Model : constant Model.sphere.colored.view := Model.sphere.colored.new_Sphere (Radius => 0.5, Color => (Red, Opaque)); the_ball_2_Model : constant Model.sphere.lit_colored.view := Model.sphere.lit_colored.new_Sphere (Radius => 1.0, Color => (Green, Opaque)); the_ball_3_Model : constant Model.sphere.lit_textured.view := Model.sphere.lit_textured.new_Sphere (Radius => 1.0, texture_Details => texture_Set.to_Set ([1 => the_Texture]), Image => the_Texture); the_ball_4_Model : constant Model.sphere.lit_colored_textured.view := Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, texture_Details => texture_Set.to_Set ([1 => the_Texture]), Image => the_Texture); the_billboard_Model : constant Model.billboard.textured.view := Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0), Plane => Billboard.xy, texture_Details => texture_Set.to_Set ([1 => the_Texture]), Texture => the_Texture); the_colored_billboard_Model : constant Model.billboard.textured.view -- TODO: Add color. := Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0), Plane => Billboard.xy, Texture => the_Texture, texture_Details => texture_Set.to_Set ([1 => the_Texture])); use Model.box; the_box_1_Model : constant Model.box.colored.view := Model.box.colored.new_Box (Size => [1.0, 2.0, 3.0], Faces => [Front => (Colors => [others => (Blue, 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)])]); the_box_2_Model : constant Model.box.lit_textured.view := Model.box.lit_textured.new_Box (Size => [1.0, 2.0, 1.0], Faces => [others => (texture_Name => the_Texture)], texture_Details => texture_Set.to_Set ([1 => the_Texture])); the_box_3_Model : constant Model.box.textured.view := Model.box.textured.new_Box (Size => [1.0, 2.0, 3.0], Faces => [others => (texture_Name => the_Texture)], texture_Details => texture_Set.to_Set ([1 => the_Texture])); the_capsule_Model : constant Model.capsule.lit_textured.view := Model.capsule.lit_textured.new_Capsule (Radius => 0.5, Height => 2.0, texture_Details => texture_Set.to_Set ([1 => the_Texture]), Image => the_Texture); the_lit_textured_circle_Model : constant Model.circle.lit_textured.view := Model.circle.lit_textured.new_Circle (Radius => 1.5, Texture_Details => (openGL.texture_Set.to_Set ([1 => the_Texture])), Sides => 24); the_grid_Model : constant Model.grid.view := Model.grid.new_grid_Model (Color => Red, Width => 3, Height => 3); the_hexagon_Model : constant Model.hexagon.lit_colored.view := Model.hexagon.lit_colored.new_Hexagon (Radius => 0.25, Face => (center_Color => (Green, Opaque), Colors => [others => (Red, Opaque)])); the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view := Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5, texture_Details => texture_Set.to_Set ([1 => the_Texture])); the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view := Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column (Radius => 0.25, Height => 1.0, Upper => (center_Color => (Green, Opaque), Colors => [others => (Red, Opaque)]), Lower => (center_Color => (Green, Opaque), Colors => [others => (Red, Opaque)]), Shaft => (Color => (Green, Opaque))); the_rounded_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_rounded.view := Model.hexagon_Column.lit_colored_rounded.new_hexagon_Column (Radius => 0.25, Height => 1.0, Upper => (center_Color => (Green, Opaque), Colors => [others => (Red, Opaque)]), Lower => (center_Color => (Green, Opaque), Colors => [others => (Red, Opaque)]), Shaft => (Color => (White, Opaque))); the_line_Model : constant Model.line.colored.view := Model.line.colored.new_line_Model (Color => Red, End_1 => [0.0, 0.0, 0.0], End_2 => [5.0, 5.0, 0.0]); -- The collada model requires 'Desktop' openGL build mode. -- -- the_collada_Model : constant Model.any.view -- := Model.any.new_Model (--Scale => (1.0, 1.0, 1.0), -- Model => to_Asset ("assets/opengl/model/human.dae"), -- Texture => the_Texture, -- Texture_is_lucid => False); the_wavefront_Model : constant Model.any.view := Model.any.new_Model (--Scale => (1.0, 1.0, 1.0), Model => to_Asset ("assets/opengl/model/human.obj"), Texture => the_Texture, texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]), Texture_is_lucid => False); the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view := Model.polygon.lit_colored.new_Polygon (Vertices => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]], Color => (Red, Opaque)); the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view := Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]], texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture])); the_text_Model : constant Model.Text.lit_colored.view := Model.Text.lit_colored.new_Text (Text => "Once upon a midnight dreary ...", Font => the_font_Id, Color => (Green, Opaque), texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]), Centered => True); the_segment_line_Model : constant Model.segment_line.view := Model.segment_line.new_segment_line_Model (Color => Green); -- Terrain -- heights_File : constant asset_Name := to_Asset ("assets/opengl/terrain/kidwelly-terrain.png"); texture_File : constant asset_Name := to_Asset ("assets/opengl/terrain/kidwelly-terrain-texture.png"); the_Region : constant IO.height_Map_view := IO.to_height_Map (heights_File, Scale => 10.0); Tiling : constant texture_Transform_2d := (S => (0.0, 1.0), T => (0.0, 1.0)); the_ground_Model : constant Model.terrain.view := Model.Terrain.new_Terrain (heights_Asset => heights_File, Row => 1, Col => 1, Heights => the_Region.all'Access, Color_Map => texture_File, texture_Details => openGL.texture_Set.to_Set ([1 => texture_File]), Tiling => Tiling); begin Demo.Renderer.add_Font (the_font_Id); the_segment_line_Model.add_1st_Segment (start_Site => [0.0, 0.0, 0.0], end_Site => [1.0, 1.0, 0.0]); the_segment_line_Model.add_Segment (end_Site => [0.0, 1.0, 0.0]); the_segment_line_Model.add_Segment (end_Site => [2.0, 2.0, 0.0]); the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]); return [ the_text_Model.all'Access, the_ground_Model.all'Access, the_lit_textured_polygon_Model.all'Access, the_lit_colored_polygon_Model.all'Access, the_arrow_Model.all'Access, the_ball_1_Model.all'Access, the_ball_2_Model.all'Access, the_ball_3_Model.all'Access, the_ball_4_Model.all'Access, the_billboard_Model.all'Access, the_colored_billboard_Model.all'Access, the_box_1_Model.all'Access, the_box_2_Model.all'Access, the_box_3_Model.all'Access, the_capsule_Model.all'Access, the_lit_textured_circle_Model.all'Access, the_grid_Model.all'Access, the_hexagon_Model.all'Access, the_textured_hexagon_Model.all'Access, the_faceted_hexagon_column_Model.all'Access, the_rounded_hexagon_column_Model.all'Access, the_line_Model.all'Access, -- the_collada_Model.all'Access, the_wavefront_Model.all'Access, the_segment_line_Model.all'Access]; end Models; procedure layout (the_Visuals : in Visual.views) is initial_X : constant openGL.Real := -6.0; initial_Y : constant openGL.Real := 6.0; X : openGL.Real := initial_X; Y : openGL.Real := initial_Y; Pad : constant openGL.Real := 3.0; i : Positive := 1; procedure set_next_Visual_Site is begin the_Visuals (i).Site_is ([X, Y, 0.0]); i := i + 1; X := X + Pad; end set_next_Visual_Site; procedure new_Line is begin X := initial_X; Y := Y - Pad; end new_Line; begin set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; set_next_Visual_Site; set_next_Visual_Site; new_Line; set_next_Visual_Site; end layout; procedure print_Usage (append_Message : in String := "") is use ada.Text_IO; begin put_Line ("Camera controls: 'w' => Move forward"); put_Line (" 'z' => Move backward"); put_Line (" 'a' => Move left"); put_Line (" 's' => Move right"); put_Line (" 'e' => Move up"); put_Line (" 'd' => Move down"); put_Line (" 'W' => Rotate clockwise about Z-axis"); put_Line (" 'Z' => Rotate counter-clockwise about Z-axis"); put_Line (" 'A' => Orbit clockwise about Y-Axis"); put_Line (" 'S' => Orbit counter clockwise about Y-axis"); put_Line (" 'E' => Rotate clockwise about X-axis"); put_Line (" 'D' => Rotate counter clockwise about X-axis"); put_Line (" 'q' => Quit"); new_Line; if append_Message /= "" then put_Line (append_Message); new_Line; end if; end print_Usage; end openGL.Demo;