235 lines
7.2 KiB
Ada
235 lines
7.2 KiB
Ada
----------------------------------------------------------------------------
|
|
----------------------------------------------------------------------------
|
|
-- threed.adb - display a 3D rotating cube --
|
|
-- Copyright (c) 25/03/2023 Jason Bou-Samra. [Paragon] --
|
|
-- --
|
|
-- This program is free software: you can redistribute it and/or modify --
|
|
-- it under the terms of the GNU General Public License as published by --
|
|
-- the Free Software Foundation, either version 3 of the License, or --
|
|
-- (at your option) any later version. --
|
|
-- --
|
|
-- This program is distributed in the hope that it will be useful, --
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
|
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
|
|
-- GNU General Public License for more details. --
|
|
-- --
|
|
-- You should have received a copy of the GNU General Public License --
|
|
-- along with this program. If not, see <https://www.gnu.org/licenses/>. --
|
|
----------------------------------------------------------------------------
|
|
|
|
with Ada.Text_IO; use Ada.Text_IO;
|
|
with Ada.Command_Line; use Ada.Command_Line;
|
|
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
|
|
|
|
with SDL.Video.Windows.Makers;
|
|
with SDL.Video.Renderers.Makers;
|
|
with SDL.Video.Surfaces.Makers;
|
|
with SDL.Video.Textures.Makers;
|
|
with SDL.Video.Rectangles;
|
|
|
|
--with SDL.Video.Renderers;
|
|
|
|
with SDL.Images.IO;
|
|
with SDL.Events.Events;
|
|
with SDL.Error;
|
|
use SDL.C;
|
|
procedure threed is
|
|
|
|
-- hidden message
|
|
|
|
S : String := "toto, all the way";
|
|
|
|
-- temporary xyz sets
|
|
|
|
xt, yt, zt : array (1 .. 8) of Float;
|
|
xu, yu, zu : array (1 .. 8) of Float;
|
|
|
|
-- cube model
|
|
|
|
x : array (1 .. 8) of Float :=
|
|
(-80.0, 80.0, 80.0, -80.0, -80.0, 80.0, 80.0, -80.0);
|
|
y : array (1 .. 8) of Float :=
|
|
(80.0, 80.0, -80.0, -80.0, 80.0, 80.0, -80.0, -80.0);
|
|
z : array (1 .. 8) of Float :=
|
|
(80.0, 80.0, 80.0, 80.0, -80.0, -80.0, -80.0, -80.0);
|
|
|
|
angle : Float := 0.0;
|
|
scale : Float := 3.0;
|
|
RAD : Float := 3.14159 / 180.0;
|
|
SPEED : Float := 2.0;
|
|
|
|
Window_Title : constant String := "3DCube demo";
|
|
quit : Boolean := False;
|
|
|
|
use SDL.Video;
|
|
use type Windows.Window_Flags;
|
|
use type Renderers.Renderer_Flags;
|
|
use type SDL.Events.Event_Types;
|
|
|
|
Win : Windows.Window;
|
|
Ren : Renderers.Renderer;
|
|
Bmp : Surfaces.Surface;
|
|
Tex : Textures.Texture;
|
|
|
|
Event : SDL.Events.Events.Events;
|
|
Dummy : Boolean;
|
|
|
|
---------------------------------
|
|
-- poll function
|
|
---------------------------------
|
|
|
|
function Poll_Quit return Boolean is
|
|
use type SDL.Events.Event_Types;
|
|
begin
|
|
while SDL.Events.Events.Poll (Event) loop
|
|
if Event.Common.Event_Type = SDL.Events.Quit then
|
|
return True;
|
|
end if;
|
|
end loop;
|
|
return False;
|
|
end Poll_Quit;
|
|
|
|
--------------------------------
|
|
-- initialise SDL
|
|
--------------------------------
|
|
procedure initSDL is
|
|
|
|
begin
|
|
|
|
-- Initialise SDL
|
|
if not SDL.Initialise or not SDL.Images.Initialise then
|
|
Ada.Text_IO.Put_Line
|
|
(Ada.Text_IO.Standard_Error,
|
|
"SDL.Initialize error: " & SDL.Error.Get);
|
|
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
|
|
return;
|
|
end if;
|
|
|
|
-- Create window
|
|
Windows.Makers.Create
|
|
(Win,
|
|
Title => Window_Title,
|
|
Position =>
|
|
(Windows.Undefined_Window_Position,
|
|
Windows.Undefined_Window_Position),
|
|
Size => (640, 512),
|
|
Flags => Windows.Shown);
|
|
|
|
-- Create renderer
|
|
Renderers.Makers.Create
|
|
(Rend => Ren,
|
|
Window => Win,
|
|
Flags => (Renderers.Accelerated or Renderers.Present_V_Sync));
|
|
|
|
end initSDL;
|
|
|
|
-------------------------------
|
|
-- shutdown routine
|
|
-------------------------------
|
|
procedure shutdownSDL is
|
|
|
|
begin
|
|
-- Not really needed since these will soon go out of scope
|
|
Tex.Finalize; -- texture
|
|
Ren.Finalize; -- renderer
|
|
Win.Finalize; -- window
|
|
SDL.Finalise; -- SDL
|
|
end shutdownSDL;
|
|
|
|
--------------------------------
|
|
-- rotation & projection routine
|
|
--------------------------------
|
|
procedure rotate is
|
|
|
|
begin
|
|
for I in 1 .. 8 loop
|
|
-- x angle (Roll)
|
|
xt (I) := x (I);
|
|
yt (I) := y (I) * Cos (RAD * angle) - z (I) * Sin (RAD * angle);
|
|
zt (I) := y (I) * Sin (RAD * angle) + z (I) * Cos (RAD * angle);
|
|
|
|
-- y angle (Pitch)
|
|
xu (I) := zt (I) * Sin (RAD * angle) + xt (I) * Cos (RAD * angle);
|
|
yu (I) := yt (I);
|
|
zu (I) := xt (I) * (-Sin (RAD * angle)) + zt (I) * Cos (RAD * angle);
|
|
|
|
-- z angle (Yaw)
|
|
xt (I) := xu (I) * Cos (RAD * angle) - yu (I) * Sin (RAD * angle);
|
|
yt (I) := xu (I) * Sin (RAD * angle) + yu (I) * Cos (RAD * angle);
|
|
zt (I) := zu (I);
|
|
|
|
-- 2d perspective projection
|
|
xt (I) := (xt (I) * 200.0) / (zt (I) + 800.0) * scale + 160.0;
|
|
yt (I) := (yt (I) * 200.0) / (zt (I) + 800.0) * scale + 128.0;
|
|
|
|
end loop;
|
|
|
|
angle := angle + SPEED;
|
|
|
|
end rotate;
|
|
|
|
-------------------------------
|
|
-- render cube
|
|
-------------------------------
|
|
procedure Render is
|
|
|
|
begin
|
|
Renderers.Set_Draw_Colour (Ren, (0, 0, 40, 255));
|
|
Renderers.Clear (Ren); -- background
|
|
|
|
Renderers.Set_Draw_Colour (Ren, (100, 100, 255, 255)); -- pen
|
|
|
|
-- draw cube front face
|
|
Ren.Draw
|
|
(Line => ((int (xt (1)), int (yt (1))), (int (xt (2)), int (yt (2)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (2)), int (yt (2))), (int (xt (3)), int (yt (3)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (3)), int (yt (3))), (int (xt (4)), int (yt (4)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (4)), int (yt (4))), (int (xt (1)), int (yt (1)))));
|
|
|
|
-- draw cube back face
|
|
Ren.Draw
|
|
(Line => ((int (xt (5)), int (yt (5))), (int (xt (6)), int (yt (6)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (6)), int (yt (6))), (int (xt (7)), int (yt (7)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (7)), int (yt (7))), (int (xt (8)), int (yt (8)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (8)), int (yt (8))), (int (xt (5)), int (yt (5)))));
|
|
|
|
-- draw cube sides
|
|
Ren.Draw
|
|
(Line => ((int (xt (1)), int (yt (1))), (int (xt (5)), int (yt (5)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (2)), int (yt (2))), (int (xt (6)), int (yt (6)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (3)), int (yt (3))), (int (xt (7)), int (yt (7)))));
|
|
Ren.Draw
|
|
(Line => ((int (xt (4)), int (yt (4))), (int (xt (8)), int (yt (8)))));
|
|
|
|
Renderers.Present (Ren);
|
|
end Render;
|
|
|
|
-------------------------------
|
|
-- main
|
|
-------------------------------
|
|
|
|
begin
|
|
Put_Line ("3D cube rotating vector graphic demo");
|
|
initSDL; -- call initialise SDL
|
|
Renderers.Set_Scale (Ren, 2.0, 2.0);
|
|
|
|
Main :
|
|
loop
|
|
rotate; -- call rotate
|
|
Render; -- call draw
|
|
quit := Poll_Quit;
|
|
exit when quit;
|
|
delay 0.020;
|
|
end loop Main;
|
|
|
|
shutdownSDL;
|
|
end threed;
|