home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 093.lha / Chaos / Sources / cdraw.mod < prev    next >
Encoding:
Modula Implementation  |  1986-11-21  |  3.4 KB  |  119 lines
  1. (*
  2.         Chaos: a program that allows you to play with
  3.     "strange attractors". See "Scientific American" 
  4.     July 1987 issue.
  5.         
  6.         Created: 8/10/87 by Richie Bielak
  7.         
  8.         Copyright (c) 1987 by Richie Bielak
  9.         
  10.         This program maybe freely distributed, but please leave
  11.         my name in. Thanks.....Richie
  12.  
  13. *)
  14. IMPLEMENTATION MODULE ChaosDraw;
  15.  
  16. FROM MathLib0  IMPORT sin, cos, MathTransBase, MathTransName;
  17. FROM Drawing   IMPORT WritePixel, SetAPen;
  18. FROM Intuition IMPORT WindowPtr, ITEMNUM, IntuiMessagePtr, IDCMPFlags,
  19.                IDCMPFlagsSet, MenuNull;
  20. FROM Ports     IMPORT ReplyMsg, GetMsg, MessagePtr;
  21. FROM Libraries IMPORT OpenLibrary;
  22. FROM SYSTEM    IMPORT ADR;
  23. FROM Terminal  IMPORT WriteString;
  24. FROM ChaosPanel IMPORT ControlValues;
  25.  
  26. (* ++++++++++++++++++++++++++++++++++++++++++++++++++ *)
  27. PROCEDURE Round (x : REAL) : INTEGER;
  28.   VAR t : INTEGER;
  29.   BEGIN
  30.     t := TRUNC (x);
  31.     IF    (x - FLOAT(t)) > 0.5 THEN INC (t) 
  32.     ELSIF (FLOAT(t) - x) > 0.5 THEN DEC (t)
  33.     END;
  34.     RETURN t
  35.   END Round;
  36.  
  37. (* ++++++++++++++++++++++++++++++++++++++++++++++++++ *)
  38. (* Check if there are any messages waiting for        *)
  39. (* processing. Ignore, all but the "End" message      *)
  40. PROCEDURE ReadyToQuit (wp : WindowPtr) : BOOLEAN;
  41.   VAR 
  42.     msgptr : IntuiMessagePtr;
  43.     class  : IDCMPFlagsSet; code : CARDINAL;
  44.   BEGIN
  45.     LOOP
  46.       msgptr := GetMsg (wp^.UserPort^);
  47.       IF msgptr = NIL THEN RETURN FALSE END;
  48.       code := msgptr^.Code; class := msgptr^.Class;
  49.       ReplyMsg (MessagePtr(msgptr));
  50.       IF (class = IDCMPFlagsSet{MenuPick}) AND (code <> MenuNull) THEN
  51.       RETURN TRUE
  52.       END;
  53.     END;
  54.   END ReadyToQuit;
  55.  
  56. (* ++++++++++++++++++++++++++++++++++++++++++++++++++ *)
  57. PROCEDURE DrawPicture (wp : WindowPtr; w, h : CARDINAL);
  58.  
  59.   (* ++++++++++++++++++++++++++++++++++++++++++++++++++ *)
  60.   PROCEDURE Plot (x, y : REAL; ZoomFact : REAL);
  61.     VAR
  62.       xc, yc, rc : INTEGER;
  63.     BEGIN
  64.       (* Convert to integers *)
  65.       xc := Round (ZoomFact * x); yc := Round (ZoomFact * y);
  66.       (* Translate with respect to the center of the display *)
  67.       xc := xc + INTEGER(w) DIV 2;
  68.       yc := yc + INTEGER(h) DIV 2;
  69.       (* Check if within range *)
  70.       IF (xc < 0) OR (xc > INTEGER(w) - 1) THEN
  71.         RETURN
  72.       ELSIF (yc < 0) OR (yc > INTEGER(h) - 1) THEN
  73.         RETURN
  74.       END;
  75.       (* Now, plot the point *)
  76.       rc := WritePixel (wp^.RPort^, xc, yc);
  77.     END Plot;
  78.  
  79.   (* ++++++++++++++++++++++++++++++++++++++++ *)
  80.   PROCEDURE DrawOrbit (a, x, y, cosa, sina, zoom : REAL);
  81.     VAR i: CARDINAL;
  82.         xx, t1, z : REAL;
  83.     BEGIN
  84.       FOR i := 1 TO ControlValues.IterPerOrbit DO
  85.         t1 := y - x * x;
  86.         xx := x * cosa - t1 * sina;
  87.         y  := x * sina + t1 * cosa;
  88.         x  := xx;
  89.         Plot (x, y, zoom);
  90.       END;
  91.     END DrawOrbit;
  92.  
  93.   VAR
  94.     a, x, y : REAL;
  95.     i : CARDINAL;
  96.     z, cosa, sina : REAL;
  97.   BEGIN
  98.     WITH ControlValues DO
  99.       x := 0.001; y := 0.001;
  100.       (* First compute some things that don't change *)
  101.       cosa := cos(a); sina := sin(a);
  102.       z := ZoomFactor * 100.0;
  103.       FOR i := 0 TO MaxOrbits DO
  104.         SetAPen (wp^.RPort^,1 + (i MOD MaxColors));
  105.         DrawOrbit (a, x, y, cosa, sina, z);
  106.         IF ReadyToQuit (wp) THEN RETURN END;
  107.         x := x + xInc;
  108.         y := y + yInc;
  109.       END;
  110.     END;
  111.   END DrawPicture;
  112.  
  113. BEGIN
  114.   MathTransBase := OpenLibrary (ADR(MathTransName),0);
  115.   IF MathTransBase = NIL THEN
  116.     WriteString ("Can't open math lib...\n");
  117.   END;
  118. END ChaosDraw.
  119.