home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / turbo_part1.lha / modula / examples / src / Sierpinski.mod < prev    next >
Encoding:
Text File  |  1994-11-11  |  3.3 KB  |  148 lines
  1. MODULE Sierpinski;
  2.  
  3. IMPORT
  4.   SYSTEM, MathIEEESingTrans, Graphics{33}, Intuition{33}, StdLib, Exec, Dos ;
  5.  
  6. CONST
  7.   SquareSize    = 512 ;
  8.   width        = SquareSize;
  9.   height    = SquareSize;
  10.  
  11. (* *********************************************************************** *)
  12. (* Graphics handling routines.                                             *)
  13. (* *********************************************************************** *)
  14.  
  15. VAR
  16.   screen : Intuition.ScreenPtr  ; (* The Screen *)
  17.   new     : Intuition.NewScreen  ;
  18.   rp     : Graphics.RastPortPtr ;
  19.  
  20. PROCEDURE CloseScreen( );
  21. BEGIN Intuition.CloseScreen(screen);
  22. END CloseScreen;
  23.  
  24. PROCEDURE OpenScreen( );
  25. BEGIN
  26.   WITH new DO
  27.     Width := 640 ;
  28.     Height := 512 ;
  29.     Depth := 1 ;
  30.     DefaultTitle := "";
  31.     ViewModes := Graphics.HIRES+Graphics.LACE ;
  32.     Type := Intuition.CUSTOMSCREEN ;
  33.   END;
  34.   screen := Intuition.OpenScreen(new);
  35.   IF screen = NIL THEN HALT END;
  36.   StdLib.atexit(CloseScreen);
  37.   rp := SYSTEM.ADR(screen^.RastPort);
  38. END OpenScreen;
  39.  
  40. VAR
  41.   i , h : INTEGER;
  42.  
  43. PROCEDURE DrawLine(sx, sy, ex, ey: INTEGER);
  44. BEGIN
  45.   Graphics.Move(rp, sx+100, sy);
  46.   Graphics.Draw(rp, ex+100, ey);
  47.   StdLib.chkabort();
  48. END DrawLine;
  49.  
  50.  
  51. (* *********************************************************************** *)
  52. (* A really *sad* line drawing procedure by N. Wirth.                      *)
  53. (* *********************************************************************** *)
  54.  
  55. VAR
  56.   Px, Py    : REAL;        (* Stuff needed by line(). *)
  57.  
  58. PROCEDURE rad(deg: INTEGER): REAL;
  59. CONST
  60.   pi = 3.14159265;
  61. BEGIN
  62.   RETURN FLOAT(deg)*pi/180.0;
  63. END rad;
  64.  
  65. PROCEDURE line(d, n: INTEGER);
  66. (* draw a line of length n in direction d (angle = 45*d degrees) *)
  67. VAR
  68.   fd, fn    : REAL;
  69.   oldx, oldy    : REAL;
  70. BEGIN
  71.   fd := rad(45*d+90);
  72.   fn := FLOAT(n);
  73.   oldx := Px;
  74.   oldy := Py;
  75.   Px := oldx + fn * MathIEEESingTrans.IEEESPCos(fd);
  76.   Py := oldy - fn * MathIEEESingTrans.IEEESPSin(fd);
  77.   DrawLine(TRUNC(oldx), TRUNC(oldy), TRUNC(Px), TRUNC(Py));
  78. END line;
  79.  
  80.  
  81. (* *********************************************************************** *)
  82. (* The code for Sierpinski, from "Programming in Modula-2", by N. Wirth.   *)
  83. (* *********************************************************************** *)
  84.  
  85. PROCEDURE A(k: INTEGER); FORWARD;
  86. PROCEDURE B(k: INTEGER); FORWARD;
  87. PROCEDURE C(k: INTEGER); FORWARD;
  88. PROCEDURE D(k: INTEGER); FORWARD;
  89.  
  90. PROCEDURE A(k: INTEGER);
  91. BEGIN
  92.   IF k>0 THEN
  93.     A(k-1); line(7, h); B(k-1); line(0, 2*h);
  94.     D(k-1); line(1, h); A(k-1);
  95.   END;
  96. END A;
  97.  
  98. PROCEDURE B(k: INTEGER);
  99. BEGIN
  100.   IF k>0 THEN
  101.     B(k-1); line(5, h); C(k-1); line(6, 2*h);
  102.     A(k-1); line(7, h); B(k-1);
  103.   END;
  104. END B;
  105.  
  106. PROCEDURE C(k: INTEGER);
  107. BEGIN
  108.   IF k>0 THEN
  109.     C(k-1); line(3, h); D(k-1); line(4, 2*h);
  110.     B(k-1); line(5, h); C(k-1);
  111.   END;
  112. END C;
  113.  
  114. PROCEDURE D(k: INTEGER);
  115. BEGIN
  116.   IF k>0 THEN
  117.     D(k-1); line(1, h); A(k-1); line(2, 2*h);
  118.     C(k-1); line(3, h); D(k-1);
  119.   END;
  120. END D;
  121.  
  122. PROCEDURE main();
  123. VAR
  124.   x0, y0    : INTEGER;
  125.   msg        : Exec.MessagePtr ;
  126. BEGIN
  127.   i := 0;
  128.   h := SquareSize DIV 4;
  129.   x0 := width DIV 2 - h;
  130.   y0 := height DIV 2;
  131.   REPEAT
  132.     INC(i);
  133.     h := h DIV 2;
  134.     x0 := x0 - h;
  135.     Px := FLOAT(x0);
  136.     Py := FLOAT(y0) + FLOAT(h)*1.75;
  137.     y0 := TRUNC(Py);
  138.     A(i); line(7, h); B(i); line(5, h);
  139.     C(i); line(3, h); D(i); line(1, h);
  140.   UNTIL (i = 5);
  141.   Dos.Delay(250) ;
  142. END main ;
  143.  
  144. BEGIN
  145.   OpenScreen();
  146.   main();
  147. END Sierpinski.
  148.