98 lines
2.7 KiB
Text
98 lines
2.7 KiB
Text
#!/usr/local/bin/spar
|
|
pragma annotate( summary, "DrawLine" )
|
|
@( description, "Draw a line given 2 points with the Bresenham's algorithm." )
|
|
@( see_also, "http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm" )
|
|
@( author, "Ken O. Burtch" );
|
|
pragma license( unrestricted );
|
|
|
|
pragma restriction( no_external_commands );
|
|
|
|
procedure drawline is
|
|
|
|
-- Spar 1.x has only single-dimensional arrays but we can simulate a
|
|
-- two dimensional array that has been folded into a 1D array
|
|
|
|
width : constant positive := 20;
|
|
height : constant positive := 20;
|
|
type image_array is array(1..400) of character;
|
|
Picture : image_array;
|
|
|
|
-- Line
|
|
-- Draw a line between two coordinates using the given character
|
|
|
|
procedure Line ( Start_X : positive; Start_Y : positive; Stop_X : positive; Stop_Y : positive; Color : character) is
|
|
|
|
-- at this point, formal parameters are defined but the actual values aren't defined!
|
|
-- but creating a dummy Line in a test script works?
|
|
|
|
DX : constant float := abs( float( Stop_X ) - float( Start_X ) );
|
|
DY : constant float := abs( float( Stop_Y ) - float( Start_Y ) );
|
|
Err : float;
|
|
X : positive := Start_X;
|
|
Y : positive := Start_Y;
|
|
Step_X : integer := 1;
|
|
Step_Y : integer := 1;
|
|
begin
|
|
if Start_X > Stop_X then
|
|
Step_X := -1;
|
|
end if;
|
|
if Start_Y > Stop_Y then
|
|
Step_Y := -1;
|
|
end if;
|
|
if DX > DY then
|
|
Err := DX / 2.0;
|
|
while X /= Stop_X loop
|
|
Picture (X + width*(Y-1)) := Color;
|
|
Err := @ - DY;
|
|
if Err < 0.0 then
|
|
Y := positive( integer(@) + Step_Y);
|
|
Err := @ + DX;
|
|
end if;
|
|
X := positive( integer(@) + Step_X );
|
|
end loop;
|
|
else
|
|
Err := DY / 2.0;
|
|
while Y /= Stop_Y loop
|
|
Picture (X + height*(Y-1)) := Color;
|
|
Err := @ - DX;
|
|
if Err < 0.0 then
|
|
X := positive( integer(@) + Step_X );
|
|
Err := @ + DY;
|
|
end if;
|
|
Y := positive( integer(@) + Step_Y );
|
|
end loop;
|
|
end if;
|
|
Picture (X + width*(Y-1)) := Color;
|
|
end Line;
|
|
|
|
-- new_picture
|
|
-- Erase the picture by filling it with spaces.
|
|
|
|
procedure new_picture is
|
|
begin
|
|
for i in arrays.first( Picture )..arrays.last( Picture ) loop
|
|
Picture(i) := ' ';
|
|
end loop;
|
|
end new_picture;
|
|
|
|
-- render
|
|
-- Draw the contents of the picture area.
|
|
|
|
procedure render is
|
|
begin
|
|
for i in arrays.first( Picture )..arrays.last( Picture ) loop
|
|
put( Picture(i) );
|
|
if i mod width = 0 then
|
|
new_line;
|
|
end if;
|
|
end loop;
|
|
end render;
|
|
|
|
begin
|
|
new_picture;
|
|
Line( 1, 8, 8, 16, 'X' );
|
|
Line( 8,16,16, 8, 'X' );
|
|
Line(16, 8, 8, 1, 'X' );
|
|
Line( 8, 1, 1, 8, 'X' );
|
|
render;
|
|
end drawline;
|