Data commit

Task/Sierpinski-triangle/PL-I/sierpinski-triangle.pli

@@ -0,0 +1,49 @@
+sierpinski: procedure options (main); /* 2010-03-30 */
+   declare t (79,79) char (1);
+   declare (i, j, k) fixed binary;
+   declare (y, xs, ys, xll, xrr, ixrr, limit) fixed binary;
+
+   t = ' ';
+   xs = 40; ys = 1;
+   /* Make initial triangle */
+   call make_triangle (xs, ys);
+   y = ys + 4;
+   xll = xs-4; xrr = xs+4;
+   do k = 1 to 3;
+      limit = 0;
+      do forever;
+         ixrr = xrr;
+         do i = xll to xll+limit by 8;
+            if t(y-1, i) = ' ' then
+               do;
+                  call make_triangle (i, y);
+                  if t(y+3,i-5) = '*' then
+                     t(y+3,i-4), t(y+3,ixrr+4) = '*';
+                  call make_triangle (ixrr, y);
+               end;
+            ixrr = ixrr - 8;
+         end;
+         xll = xll - 4; xrr = xrr + 4;
+         y = y + 4;
+         limit = limit + 8;
+         if xll+limit > xs-1 then leave;
+      end;
+      t(y-1,xs) = '*';
+   end;
+
+   /* Finished generation; now print the Sierpinski triangle. */
+   put edit (t) (skip, (hbound(t,2)) a);
+
+make_triangle: procedure (x, y);
+   declare (x, y) fixed binary;
+   declare i fixed binary;
+
+   do i = 0 to 3;
+      t(y+i, x-i), t(y+i, x+i) = '*';
+   end;
+   do i = x-2 to x+2;  /* The base of the triangle. */
+      t(y+3, i) = '*';
+   end;
+end make_triangle;
+
+end sierpinski;