Vovanium
/
Video_library
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

+ Ellipse algorithm

This commit is contained in:
Vovanium 2023-08-03 00:06:32 +03:00
parent 72a3438910
commit 9c7d8cf31b
4 changed files with 135 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
ref.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 91 KiB

104
source/base/video-algorithms-generic_ellipse.adb Normal file
View File

@ -0,0 +1,104 @@
procedure Video.Algorithms.Generic_Ellipse (
Target : in out Raster;
Bounds : in Box;
Color : in Paint;
Clip : in Box := Full_Box)
is
subtype Prod is Coordinate_Product;
X, Y : Coordinate; -- Offset from center in half-pixels
D : Prod; -- Deviation from ideal ellipse
A, B : Distance; -- Axis lengths
A2, B2 : Prod; -- Squares of axis length
S : Prod;
procedure Plot (
A : Point
) is
begin
if Contains (Clip, A) then
Write_Pixel (Target, A, Color);
end if;
end Plot;
procedure Draw is
XS : constant Coordinate := Bounds.X.First + Bounds.X.Last;
YS : constant Coordinate := Bounds.Y.First + Bounds.Y.Last;
begin
Plot (((XS + X) / 2, (YS + Y) / 2));
Plot (((XS - X) / 2, (YS + Y) / 2));
Plot (((XS + X) / 2, (YS - Y) / 2));
Plot (((XS - X) / 2, (YS - Y) / 2));
end Draw;
begin
if Is_Empty (Bounds) or else Is_Empty (Clip)
or else (not Intersects (Bounds, Clip))
then
return; -- No points to draw
end if;
A := Length (Bounds.X); A2 := Prod (A)**2;
B := Length (Bounds.Y); B2 := Prod (B)**2;
-- Horizontal part
if A mod 2 = 0 then
Plot ((Bounds.X.First, Center (Bounds.Y)));
Plot ((Bounds.X.Last, Center (Bounds.Y)));
X := 0;
else
X := -1;
end if;
Y := B;
-- D := ((DX * B)**2 + (DY * A)**2 - A**2 * B) / 4;
D := ((Prod (X))**2 * B2 + 2) / 4; -- + 2 is for rounding
while Prod (X) * B2 < Prod (Y) * A2 loop
D := D + (Prod (X) + 1) * B2;
X := X + 2;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
-- Step Y -> Y - 2
-- D(i) = ((X * B)**2 + ( Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) = ((X * B)**2 + ((Y - 2) * A)**2 - A**2 * B**2) / 4
-- D(i+1) - D(i) = (((Y - 2) * A)**2) / 4 - ((Y * A)**2) / 4
-- = A**2 * (1 - Y)
S := (1 - Prod (Y)) * A2;
-- Step down when its deviation is of opposite sign and less in abs. value
if D + S >= -D then
Y := Y - 2;
D := D + S;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
end if;
Draw;
end loop;
-- Vertical part
while Y > 2 loop
D := D + (1 - Prod (Y)) * A2;
Y := Y - 2;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
-- Step X -> X + 2
-- D(i) = (( X * B)**2 + (Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) = (((X + 2) * B)**2 + (Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) - D(i) = (((X + 2) * B)**2) / 4 - ((X * B)**2) / 4
-- = B**2 * (X + 1)
S := (Prod (X) + 1) * B2;
if D + S < -D then
X := X + 2;
D := D + S;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
end if;
Draw;
end loop;
if B mod 2 = 0 then
Plot ((Center (Bounds.X), Bounds.Y.First));
Plot ((Center (Bounds.X), Bounds.Y.Last));
end if;
end Video.Algorithms.Generic_Ellipse;
-- Ellipse equation:
-- (X - Xc)²/A² + (Y - Yc)²/B² = 1
-- in integers:
-- (X - Xc)² B² + (Y - Yc)² A² = A² B²

15
source/base/video-algorithms-generic_ellipse.ads Normal file
View File

@ -0,0 +1,15 @@
with Video.Integer_Geometry;
use Video.Integer_Geometry;
generic
type Raster (<>) is limited private;
type Paint is limited private;
with procedure Write_Pixel (
T : in out Raster;
A : in Point;
C : in Paint);
procedure Video.Algorithms.Generic_Ellipse (
Target : in out Raster; -- Medium to paint on
Bounds : in Box; -- Ellipse boundaries
Color : in Paint; -- Painting data (like color, clipping area etc.)
Clip : in Box := Full_Box); -- Clipping area

100
source/base/video-pixels-generic_blits.adb
View File

@ -1,6 +1,7 @@
with Video.Integer_Geometry;
use Video.Integer_Geometry;
with Video.Algorithms.Generic_Ellipse;
--with Ada.Text_IO;
--use Ada.Text_IO;
--with Ada.Integer_Text_IO;
@ -99,96 +100,27 @@ package body Video.Pixels.Generic_Blits is
end loop;
end Circle;
procedure Write_Pixel (
Target : in out Pixel_Array;
A : in Integer_Geometry.Point;
Color : in Pixel)
is
begin
Target (A.Y, A.X) := Color;
end Write_Pixel;
procedure Inner_Ellipse is new Video.Algorithms.Generic_Ellipse (
Raster => Pixel_Array,
Paint => Pixel,
Write_Pixel => Write_Pixel);
procedure Ellipse (
Color : in Pixel;
Target : in out Pixel_Array;
Bounds : in Integer_Geometry.Box)
is
subtype Prod is Coordinate_Product;
X, Y : Coordinate; -- Offset from center in half-pixels
D : Prod; -- Deviation from ideal ellipse
A, B : Distance; -- Axis lengths
A2, B2 : Prod; -- Squares of axis length
S : Prod;
procedure Draw is
XS : constant Coordinate := Bounds.X.First + Bounds.X.Last;
YS : constant Coordinate := Bounds.Y.First + Bounds.Y.Last;
begin
Target ((YS + Y) / 2, (XS + X) / 2) := Color;
Target ((YS + Y) / 2, (XS - X) / 2) := Color;
Target ((YS - Y) / 2, (XS + X) / 2) := Color;
Target ((YS - Y) / 2, (XS - X) / 2) := Color;
end;
begin
if Is_empty (Bounds) then
return; -- No pixels to draw
end if;
A := Length (Bounds.X); A2 := Prod (A)**2;
B := Length (Bounds.Y); B2 := Prod (B)**2;
-- Horizontal part
if A mod 2 = 0 then
Target (Center (Bounds.Y), Bounds.X.First) := Color;
Target (Center (Bounds.Y), Bounds.X.Last) := Color;
X := 0;
else
X := -1;
end if;
Y := B;
-- D := ((DX * B)**2 + (DY * A)**2 - A**2 * B) / 4;
D := ((Prod (X))**2 * B2 + 2) / 4; -- + 2 is for rounding
while Prod (X) * B2 < Prod (Y) * A2 loop
D := D + (Prod (X) + 1) * B2;
X := X + 2;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
-- Step Y -> Y - 2
-- D(i) = ((X * B)**2 + ( Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) = ((X * B)**2 + ((Y - 2) * A)**2 - A**2 * B**2) / 4
-- D(i+1) - D(i) = (((Y - 2) * A)**2) / 4 - ((Y * A)**2) / 4
-- = A**2 * (1 - Y)
S := (1 - Prod (Y)) * A2;
-- Step down when its deviation is of opposite sign and less in abs. value
if D + S >= -D then
Y := Y - 2;
D := D + S;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
end if;
Draw;
end loop;
-- Vertical part
while Y > 2 loop
D := D + (1 - Prod (Y)) * A2;
Y := Y - 2;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
-- Step X -> X + 2
-- D(i) = (( X * B)**2 + (Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) = (((X + 2) * B)**2 + (Y * A)**2 - A**2 * B**2) / 4
-- D(i+1) - D(i) = (((X + 2) * B)**2) / 4 - ((X * B)**2) / 4
-- = B**2 * (X + 1)
S := (Prod (X) + 1) * B2;
if D + S / 2 < -D then
X := X + 2;
D := D + S;
--pragma Assert (D = (X * B)**2 + (Y * A)**2 - (A * B)**2);
end if;
Draw;
end loop;
if B mod 2 = 0 then
Target (Bounds.Y.First, Center (Bounds.X)) := Color;
Target (Bounds.Y.Last, Center (Bounds.X)) := Color;
end if;
Inner_Ellipse (Target, Bounds, Color);
end Ellipse;
-- Ellipse equation:
-- (X - Xc)²/A² + (Y - Yc)²/B² = 1
-- in integers:
-- (X - Xc)² B² + (Y - Yc)² A² = A² B²
end Video.Pixels.Generic_Blits;