#!/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;