home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 04 / porter / porter.ls3 < prev    next >
Text File  |  1979-12-31  |  2KB  |  85 lines
  1.  
  2. STRUCTURED PROGRAMMINMG LISTING THREE APRIL ISSUE
  3.  
  4.  
  5. MODULE Sierpin;
  6.  
  7. (* Based on the Sierpinski recursive model in N. Wirth's book *)
  8. (*   "Programming in Modula-2."                               *)
  9. (* Wirth's program has been modified slightly to accommodate  *)
  10. (*   EGA graphics mode on the IBM PC.                         *)
  11. (* Written by K. Porter for DDJ, April 1988 issue.            *)
  12. (* ---------------------------------------------------------- *)
  13.  
  14. FROM InOut   IMPORT Read;
  15. FROM LineDwg IMPORT width, height, Px, Py, clear, line;
  16. FROM SYSTEM  IMPORT REGISTERS, INT;
  17.  
  18. CONST SquareSize = 512;
  19.  
  20. VAR  i, h, x0, y0 : CARDINAL;
  21.      ch           : CHAR;
  22.      reg          : REGISTERS;
  23.  
  24. PROCEDURE A (k : CARDINAL);
  25. BEGIN
  26.   IF k > 0 THEN
  27.     A (k-1);   line (7, h);   B (k-1);   line (0, 2*h);
  28.     D (k-1);   line (1, h);   A (k-1)
  29.   END
  30. END A;
  31. (* -------------------------- *)
  32.  
  33. PROCEDURE B (k : CARDINAL);
  34. BEGIN
  35.   IF k > 0 THEN
  36.     B (k-1);   line (5, h);   C (k-1);   line (6, 2*h);
  37.     A (k-1);   line (7, h);   B (k-1)
  38.   END
  39. END B;
  40. (* -------------------------- *)
  41.  
  42. PROCEDURE C (k : CARDINAL);
  43. BEGIN
  44.   IF k > 0 THEN
  45.     C (k-1);   line (3, h);   D (k-1);   line (4, 2*h);
  46.     B (k-1);   line (5, h);   C (k-1)
  47.   END
  48. END C;
  49. (* -------------------------- *)
  50.  
  51. PROCEDURE D (k : CARDINAL);
  52. BEGIN
  53.   IF k > 0 THEN
  54.     D (k-1);   line (1, h);   A (k-1);   line (2, 2*h);
  55.     C (k-1);   line (3, h);   D (k-1)
  56.   END
  57. END D;
  58. (* -------------------------- *)
  59.  
  60. BEGIN
  61.   clear;
  62.   i := 0;
  63.   h := SquareSize DIV 4;
  64.   x0 := CARDINAL (width) DIV 2;
  65.   y0 := CARDINAL (height) DIV 2 + h;
  66.   REPEAT
  67.     i  := i + 1;
  68.     x0 := x0 - h;
  69.     h  := h DIV 2;
  70.     y0 := y0 + h;
  71.     Px := x0;
  72.     Py := y0;
  73.     A (i);   line (7, h);   B (i);   line (5, h);
  74.     C (i);   line (3, h);   D (i);   line (1, h);
  75.   UNTIL (i = 4);
  76.   Read (ch);                             (* hold for keypress *)
  77.   reg.AH := 0;
  78.   reg.AL := 3;             (* restore 80 x 25 color text mode *)
  79.   INT (16, reg);
  80. END Sierpin.
  81.  
  82.  
  83.  
  84.  
  85.