144 lines
4.4 KiB
Ada
144 lines
4.4 KiB
Ada
with Ada.Numerics.Elementary_Functions;
|
|
with Ada.Numerics.Generic_Real_Arrays;
|
|
|
|
with SDL.Video.Windows.Makers;
|
|
with SDL.Video.Renderers.Makers;
|
|
with SDL.Video.Palettes;
|
|
with SDL.Events.Events;
|
|
|
|
procedure Death_Star is
|
|
|
|
Width : constant := 400;
|
|
Height : constant := 400;
|
|
|
|
package Float_Arrays is
|
|
new Ada.Numerics.Generic_Real_Arrays (Float);
|
|
use Ada.Numerics.Elementary_Functions;
|
|
use Float_Arrays;
|
|
|
|
Window : SDL.Video.Windows.Window;
|
|
Renderer : SDL.Video.Renderers.Renderer;
|
|
|
|
subtype Vector_3 is Real_Vector (1 .. 3);
|
|
|
|
type Sphere_Type is record
|
|
Cx, Cy, Cz : Integer;
|
|
R : Integer;
|
|
end record;
|
|
|
|
function Normalize (V : Vector_3) return Vector_3 is
|
|
(V / Sqrt (V * V));
|
|
|
|
procedure Hit (S : Sphere_Type;
|
|
X, Y : Integer;
|
|
Z1, Z2 : out Float;
|
|
Is_Hit : out Boolean)
|
|
is
|
|
NX : constant Integer := X - S.Cx;
|
|
NY : constant Integer := Y - S.Cy;
|
|
Zsq : constant Integer := S.R * S.R - (NX * NX + NY * NY);
|
|
Zsqrt : Float;
|
|
begin
|
|
if Zsq >= 0 then
|
|
Zsqrt := Sqrt (Float (Zsq));
|
|
Z1 := Float (S.Cz) - Zsqrt;
|
|
Z2 := Float (S.Cz) + Zsqrt;
|
|
Is_Hit := True;
|
|
return;
|
|
end if;
|
|
Z1 := 0.0;
|
|
Z2 := 0.0;
|
|
Is_Hit := False;
|
|
end Hit;
|
|
|
|
procedure Draw_Death_Star (Pos, Neg : Sphere_Type;
|
|
K, Amb : Float;
|
|
Dir : Vector_3)
|
|
is
|
|
Vec : Vector_3;
|
|
ZB1, ZB2 : Float;
|
|
ZS1, ZS2 : Float;
|
|
Is_Hit : Boolean;
|
|
S : Float;
|
|
Lum : Integer;
|
|
begin
|
|
for Y in Pos.Cy - Pos.R .. Pos.Cy + Pos.R loop
|
|
for X in Pos.Cx - Pos.R .. Pos.Cx + Pos.R loop
|
|
Hit (Pos, X, Y, ZB1, ZB2, Is_Hit);
|
|
if not Is_Hit then
|
|
goto Continue;
|
|
end if;
|
|
Hit (Neg, X, Y, ZS1, ZS2, Is_Hit);
|
|
if Is_Hit then
|
|
if ZS1 > ZB1 then
|
|
Is_Hit := False;
|
|
elsif ZS2 > ZB2 then
|
|
goto Continue;
|
|
end if;
|
|
end if;
|
|
|
|
if Is_Hit then
|
|
Vec := (Float (Neg.Cx - X),
|
|
Float (Neg.Cy - Y),
|
|
Float (Neg.Cz) - ZS2);
|
|
else
|
|
Vec := (Float (X - Pos.Cx),
|
|
Float (Y - Pos.Cy),
|
|
ZB1 - Float (Pos.Cz));
|
|
end if;
|
|
S := Float'Max (0.0, Dir * Normalize (Vec));
|
|
|
|
Lum := Integer (255.0 * (S ** K + Amb) / (1.0 + Amb));
|
|
Lum := Integer'Max (0, Lum);
|
|
Lum := Integer'Min (Lum, 255);
|
|
|
|
Renderer.Set_Draw_Colour ((SDL.Video.Palettes.Colour_Component (Lum),
|
|
SDL.Video.Palettes.Colour_Component (Lum),
|
|
SDL.Video.Palettes.Colour_Component (Lum),
|
|
255));
|
|
Renderer.Draw (Point => (SDL.C.int (X + Width / 2),
|
|
SDL.C.int (Y + Height / 2)));
|
|
<<Continue>>
|
|
end loop;
|
|
end loop;
|
|
end Draw_Death_Star;
|
|
|
|
procedure Wait is
|
|
use type SDL.Events.Event_Types;
|
|
Event : SDL.Events.Events.Events;
|
|
begin
|
|
loop
|
|
while SDL.Events.Events.Poll (Event) loop
|
|
if Event.Common.Event_Type = SDL.Events.Quit then
|
|
return;
|
|
end if;
|
|
end loop;
|
|
delay 0.100;
|
|
end loop;
|
|
end Wait;
|
|
|
|
Direction : constant Vector_3 := Normalize ((20.0, -40.0, -10.0));
|
|
Positive : constant Sphere_Type := (0, 0, 0, 120);
|
|
Negative : constant Sphere_Type := (-90, -90, -30, 100);
|
|
begin
|
|
if not SDL.Initialise (Flags => SDL.Enable_Screen) then
|
|
return;
|
|
end if;
|
|
|
|
SDL.Video.Windows.Makers.Create (Win => Window,
|
|
Title => "Death star",
|
|
Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
|
|
Size => SDL.Positive_Sizes'(Width, Height),
|
|
Flags => 0);
|
|
SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
|
|
Renderer.Set_Draw_Colour ((0, 0, 0, 255));
|
|
Renderer.Fill (Rectangle => (0, 0, Width, Height));
|
|
|
|
Draw_Death_Star (Positive, Negative, 1.5, 0.2, Direction);
|
|
Window.Update_Surface;
|
|
|
|
Wait;
|
|
Window.Finalize;
|
|
SDL.Finalise;
|
|
end Death_Star;
|