home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 093.lha / Chaos / Sources / chaos.mod < prev    next >
Encoding:
Text File  |  1986-11-21  |  6.7 KB  |  212 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. MODULE Chaos;
  15.  
  16. FROM SYSTEM     IMPORT ADR, BYTE, ADDRESS;
  17. FROM Intuition  IMPORT
  18.      Window, WindowFlags, NewWindow, MenuPick, IDCMPFlagsSet, 
  19.      WindowFlagsSet, WindowPtr, ScreenPtr, MenuPtr, MenuItemFlagsSet, 
  20.      ItemText, ItemEnabled, IntuiMessagePtr, CustomScreen, ScreenFlagsSet, 
  21.      OpenWindow, CloseWindow, NewScreen, OpenScreen, CloseScreen, ShowTitle,
  22.      SetMenuStrip, MENUNUM, ITEMNUM, MenuNull, SetWindowTitles;
  23. FROM Rasters    IMPORT Jam2, Jam1, DrawModeSet, SetRast;
  24. FROM Ports      IMPORT ReplyMsg, WaitPort, GetMsg, MessagePtr;
  25. FROM Views      IMPORT ViewModes, ViewModesSet, SetRGB4;
  26. FROM Drawing    IMPORT SetAPen, RectFill;
  27. FROM AmigaDOS   IMPORT Close;
  28. FROM System     IMPORT WBenchMsg, StdOutput;
  29. FROM SimpleWindows IMPORT CreateWindow;
  30. FROM GetRes     IMPORT ChooseResolution;
  31. FROM EasyMenus  IMPORT DetachMenuStrip, DisposeEasyMenuStrip;
  32. FROM ChaosMenu  IMPORT ChaosMenu, ActionItems, ScreenItems, PreSetsItems,
  33.                 MenuStripPtr, AltMenuStripPtr;
  34. FROM ChaosDraw  IMPORT DrawPicture; 
  35. FROM ChaosPanel IMPORT ControlPanel, SetUpPanelGadgets, CleanUpPanelGadgets,
  36.                        ControlValues;
  37. FROM ChaosInfo  IMPORT AboutChaos;
  38. FROM ChaosSave  IMPORT SavePicture;
  39.  
  40.  
  41. CONST
  42.   ChaosTitle     = "HENON MAPPING  © 1987 Richie Bielak";
  43.   ComputingTitle = "Drawing in progress ...";
  44.   SavingTitle    = "Saving picture...";  
  45.  
  46. VAR
  47.   DisplayWidth, DisplayHeight : CARDINAL;
  48.   DisplayType : ViewModesSet;
  49.   wp : WindowPtr;
  50.   sp : ScreenPtr;
  51.   DispTitle : BOOLEAN;
  52.  
  53. (*++++++++++++++++++++++++++++++++++++++ *)
  54. PROCEDURE InitScreen (name : ADDRESS) : ScreenPtr;
  55.   VAR s : NewScreen;
  56.   BEGIN
  57.     WITH s DO
  58.       LeftEdge := 0; TopEdge := 0; 
  59.       Width := DisplayWidth; Height := DisplayHeight;
  60.       Depth := 4; DetailPen := BYTE (0); BlockPen := BYTE (1);
  61.       ViewModes := DisplayType;
  62.       Type := CustomScreen; Font := NIL;
  63.       DefaultTitle := name;
  64.       Gadgets := NIL; CustomBitMap := NIL
  65.     END;
  66.     (* Now open the screen *)
  67.     RETURN OpenScreen (s)
  68.   END InitScreen;
  69.  
  70. (*++++++++++++++++++++++++++++++++++++++ *)
  71. (* Initialize and open a window.         *)
  72. PROCEDURE InitWindow (sp : ScreenPtr) : WindowPtr;
  73.   BEGIN
  74.      RETURN CreateWindow (0, 0, DisplayWidth, DisplayHeight,
  75.                           IDCMPFlagsSet {MenuPick},
  76.                  WindowFlagsSet {Activate, Borderless, BackDrop},
  77.               NIL, sp, NIL);
  78.   END InitWindow;
  79.  
  80. (*++++++++++++++++++++++++++++++++++++++ *)
  81. PROCEDURE SetColors (sp : ScreenPtr);
  82.   BEGIN
  83.     WITH sp^ DO
  84.       SetRGB4(ViewPort, 0, 0, 0, 0); SetRGB4(ViewPort, 1, 15, 15, 15);
  85.       SetRGB4(ViewPort, 2, 12, 12, 12); SetRGB4(ViewPort, 3, 9, 9, 9);
  86.       SetRGB4(ViewPort, 4, 10, 0, 10);  SetRGB4(ViewPort, 5, 8, 10, 15);
  87.       SetRGB4(ViewPort, 6, 15, 15, 2); SetRGB4(ViewPort, 7, 11, 15, 0);
  88.       SetRGB4(ViewPort, 8, 5, 13, 0);  SetRGB4(ViewPort, 9, 0, 0, 15);
  89.       SetRGB4(ViewPort, 10, 3, 6, 15); SetRGB4(ViewPort, 11, 7, 7, 15);
  90.       SetRGB4(ViewPort, 12, 12, 0, 14);SetRGB4(ViewPort, 13, 15, 2, 14);
  91.       SetRGB4(ViewPort, 14, 15, 15, 0);SetRGB4(ViewPort, 15, 5, 12, 12);
  92.     END
  93.   END SetColors;
  94.  
  95. (* +++++++++++++++++++++++++++++++++++++++++ *)
  96. PROCEDURE ProcessActionsMenu (code : CARDINAL; VAR quit : BOOLEAN);
  97.   BEGIN
  98.     CASE ActionItems(ITEMNUM(code)) OF
  99.       Begin:
  100.         (* Attach alternate menu and switch screen title *)
  101.         SetMenuStrip (wp^, AltMenuStripPtr^);
  102.         SetWindowTitles(wp^, NIL, ADR(ComputingTitle));
  103.         DrawPicture(wp, DisplayWidth, DisplayHeight);
  104.         (* Put old title back *)
  105.         SetWindowTitles(wp^, NIL, ADR(ChaosTitle));
  106.         DetachMenuStrip (wp);
  107.            |
  108.       Panel: ControlPanel (sp)
  109.            |
  110.       About: AboutChaos (sp)
  111.            |
  112.       SaveIFF:
  113.         SetWindowTitles(wp^, NIL, ADR(SavingTitle));
  114.         SavePicture (DisplayWidth, DisplayHeight, sp);
  115.         SetWindowTitles(wp^, NIL, ADR(ChaosTitle));
  116.            |
  117.       Quit: quit := TRUE;
  118.     END
  119.   END ProcessActionsMenu;
  120.  
  121. (* +++++++++++++++++++++++++++++++++++++++++ *)
  122. PROCEDURE ProcessScreensMenu (code : CARDINAL);
  123.   BEGIN
  124.     CASE ScreenItems (ITEMNUM(code)) OF
  125.       ToggleTitle:
  126.          DispTitle := NOT DispTitle;
  127.          ShowTitle (sp^, DispTitle);   
  128.      |
  129.       Clear:
  130.          SetRast (wp^.RPort^, 0);
  131.     END;
  132.   END ProcessScreensMenu;
  133.  
  134.  
  135. (* +++++++++++++++++++++++++++++++++++++++++ *)
  136. PROCEDURE ProcessPreSetsMenu (code : CARDINAL);
  137.   BEGIN
  138.     WITH ControlValues DO
  139.       IterPerOrbit := 1000; MaxOrbits := 130; MaxColors := 15;
  140.       xInc := 0.02; yInc := 0.02;          
  141.       IF DisplayHeight > 200 THEN 
  142.         ZoomFactor := 2.0;
  143.       ELSE
  144.         ZoomFactor := 1.0;
  145.       END;
  146.       CASE PreSetsItems(ITEMNUM(code)) OF
  147.         Pic1: a := 1.59; |
  148.     Pic2: a := 1.3;  |
  149.     Pic3: a := 0.5;  |
  150.     Pic4: a := 2.23; 
  151.       END;
  152.     END;
  153.   END ProcessPreSetsMenu;
  154.  
  155. (* +++++++++++++++++++++++++++++++++++++++++ *)
  156. PROCEDURE ProcessMenu (code : CARDINAL; VAR quit : BOOLEAN);
  157.   BEGIN
  158.     (* Remove the menu strip while processing things *) 
  159.     DetachMenuStrip (wp);
  160.     CASE ChaosMenu (MENUNUM(code)) OF
  161.       ActionMenu: ProcessActionsMenu (code, quit);  |
  162.       ScreenMenu: ProcessScreensMenu (code);        |
  163.       PreSetMenu: ProcessPreSetsMenu (code)
  164.     END;
  165.     (* Re-attach the menu strip *)
  166.     SetMenuStrip (wp^, MenuStripPtr^);
  167.   END ProcessMenu;
  168.  
  169. (* +++++++++++++++++++++++++++++++++++++++++ *)
  170. PROCEDURE ProcessMessages ();
  171.   VAR
  172.     quit : BOOLEAN;
  173.     msgptr : IntuiMessagePtr;
  174.     class  : IDCMPFlagsSet; code : CARDINAL;
  175.   BEGIN
  176.     quit := FALSE;
  177.     REPEAT
  178.       msgptr := WaitPort (wp^.UserPort^);
  179.       LOOP
  180.         msgptr := GetMsg (wp^.UserPort^);
  181.         IF msgptr = NIL THEN EXIT; END;
  182.         code := msgptr^.Code; class := msgptr^.Class;
  183.         ReplyMsg (MessagePtr(msgptr));
  184.         IF (class = IDCMPFlagsSet{MenuPick}) AND (code <> MenuNull) THEN
  185.           ProcessMenu(code, quit)
  186.         END;
  187.       END; (* LOOP *)
  188.     UNTIL quit;
  189.   END ProcessMessages;
  190.  
  191. BEGIN
  192.   (* Get rid of the extra window, if we started from WB *)
  193.   IF WBenchMsg <> NIL THEN
  194.     Close (StdOutput); StdOutput := NIL;
  195.   END;  
  196.   DispTitle := TRUE;
  197.   ChooseResolution (DisplayWidth, DisplayHeight, DisplayType);
  198.   sp := InitScreen (ADR(ChaosTitle));
  199.   wp := InitWindow (sp);
  200.   SetColors (sp);
  201.   SetMenuStrip (wp^, MenuStripPtr^);
  202.   SetUpPanelGadgets ();
  203.  
  204.   ProcessMessages ();
  205.  
  206.   DetachMenuStrip (wp);
  207.   DisposeEasyMenuStrip (MenuStripPtr);
  208.   DisposeEasyMenuStrip (AltMenuStripPtr);
  209.   CleanUpPanelGadgets ();
  210.   CloseWindow (wp^); CloseScreen (sp^);
  211. END Chaos.
  212.