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

* make Generic_Line buildable with No_Implicit_Dynamic_Code

This commit is contained in:
Vovanium 2023-08-01 23:17:05 +03:00
parent 10e13cf629
commit 92c7e13849
3 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
source/base/video-algorithms-generic_line.adb
View File

@ -2,8 +2,10 @@ with Video.Integer_Geometry;
use type Video.Integer_Geometry.Point;
procedure Video.Algorithms.Generic_Line (
Target : in out Raster;
A, B : in Integer_Geometry.Point;
A_Clip, B_Clip : in Integer_Geometry.Point)
A_Clip, B_Clip : in Integer_Geometry.Point;
Color : in Paint)
is
D : constant Integer_Geometry.Point := B - A; -- Direction vector
S : constant Integer_Geometry.Point := (
@ -21,7 +23,7 @@ begin
-- May need extended precision here
NC := abs (B_Clip.X - A_Clip.X);
for I in 0 .. NC loop
Put_Pixel (P);
Write_Pixel (Target, P, Color);
E := E + M;
if E >= 0 then
E := E - N;
@ -35,7 +37,7 @@ begin
E := -N / 2 + M * abs (A_Clip.Y - A.Y) - N * abs (A_Clip.X - A.X);
NC := abs (B_Clip.Y - A_Clip.Y);
for I in 0 .. NC loop
Put_Pixel (P);
Write_Pixel (Target, P, Color);
E := E + M;
if E >= 0 then
E := E - N;

11
source/base/video-algorithms-generic_line.ads
View File

@ -1,9 +1,16 @@
with Video.Integer_Geometry;
generic
with procedure Put_Pixel (A : Integer_Geometry.Point);
type Raster is limited private;
type Paint is limited private;
with procedure Write_Pixel (
T : in out Raster;
A : in Integer_Geometry.Point;
C : in Paint);
procedure Video.Algorithms.Generic_Line (
Target : in out Raster; -- Medium to paint on
A, B : in Integer_Geometry.Point; -- Virtual line ends (possibly out of clip area)
A_Clip, B_Clip : in Integer_Geometry.Point); -- Actual first and last points to draw
A_Clip, B_Clip : in Integer_Geometry.Point; -- Actual first and last points to draw
Color : in Paint); -- Painting data (like color, clipping area etc.)
-- A_Clip and B_Clip could be the same as A and B when no clipping is done
-- A_Clip is the closest to A and B_Clip is the closest to B to draw.

12
source/sdl/video-sdl2-surfaces.adb
View File

@ -93,18 +93,18 @@ package body Video.SDL2.Surfaces is
Colour => Colors.To_Pixel (Target.Data.Pixel_Format, Color));
end Fill_Rectangle;
procedure Inner_Line is new Algorithms.Generic_Line (
Raster => SDL_Surface,
Paint => Interfaces.Unsigned_32,
Write_Pixel => Write_Pixel);
procedure Line (
Target : in out SDL_Surface;
A, B : in Integer_Geometry.Point;
Color : in Interfaces.Unsigned_32)
is
procedure Put_Pixel (C : Integer_Geometry.Point) is
begin
Target.Write_Pixel (C, Color);
end Put_Pixel;
procedure Inner_Line is new Algorithms.Generic_Line (Put_Pixel);
begin
Inner_Line (A, B, A, B);
Inner_Line (Target, A, B, A, B, Color);
end Line;
procedure Line (