Initial data commit

Task/Bitmap-Bresenhams-line-algorithm/SparForte/bitmap-bresenhams-line-algorithm.sparforte

@@ -0,0 +1,98 @@
+#!/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;