File : drawline.bush

$ bush drawline
       X            
      X X           
     X   X          
    X     X         
   X       XX       
  X          X      
 X            X     
X              X    
 X            X     
  X          X      
   X        X       
   X       X        
    X     X         
     X   X          
      X X           
       X          

#!/usr/local/bin/bush

-- Based on the Ada example at Rosetta Code

pragma annotate( "DrawLine" );
pragma annotate( "" );
pragma annotate( "Draw a line given 2 points with the Bresenham's algorithm." );
pragma annotate( "translated by Ken O. Burtch" );

pragma restriction( no_external_commands );

procedure drawline is

-- Bush 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 - Start_X) );
   DY  : constant float := abs( float (Stop_Y - 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 + width*(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;