langs a-z

Task/Bitmap-Bresenhams-line-algorithm/PL-I/bitmap-bresenhams-line-algorithm-1.pli

@@ -0,0 +1,36 @@
+/* Draw a line from (x0, y0) to (x1, y1).   13 May 2010 */
+/* Based on Rosetta code proforma. */
+
+   /* Declarations for image and selected color, for 4-bit colors. */
+   declare image(40,40) bit (4), color bit (4) static initial ('1000'b);
+
+draw_line: procedure (xi, yi, xf, yf );
+   declare (xi, yi, xf, yf) fixed binary (31) nonassignable;
+   declare (x0, y0, x1, y1) fixed binary (31);
+   declare (deltax, deltay, x, y, ystep) fixed binary;
+   declare (error initial (0), delta_error) float;
+   declare steep bit (1);
+
+   x0 = xi; y = YI; y0 = yi; x1 = xf; y1 = yf;
+   steep = abs(y1 - y0) > abs (x1 - x0);
+   if steep then
+      do; call swap (x0, y0); call swap (x1, y1); end;
+   if x0 > x1 then
+      do; call swap (x0, x1); call swap (y0, y1); end;
+   deltax = x1 - x0; deltay = abs(y1 - y0);
+   delta_error = deltay/deltax;
+   if y0 < y1 then ystep = 1; else ystep = -1;
+   do x = x0 to x1;
+       if steep then image(y, x) = color; else image(x, y) = color;
+       if steep then put skip list (y, x); else put skip list (x, y);
+       error = error + delta_error;
+       if error >= 0.5 then do; y = y + ystep; error = error - 1; end;
+   end;
+
+swap: procedure (a, b);
+   declare (a, b) fixed binary (31);
+   declare t fixed binary (31);
+   t = a; a = b; b = t;
+end swap;
+
+end draw_line;

Task/Bitmap-Bresenhams-line-algorithm/PL-I/bitmap-bresenhams-line-algorithm-2.pli

@@ -0,0 +1,21 @@
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|.........*
+..........|.......**.
+..........|.....**...
+..........|...**.....
+----------+-**-------
+..........**.........
+........**|..........
+.......*..|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........
+..........|..........