home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 093.lha / Chaos / Sources / getres.mod < prev    next >
Encoding:
Modula Implementation  |  1986-11-21  |  2.5 KB  |  84 lines
  1. (*
  2.  
  3.     This module contains a procedure that prompts the user
  4.     for resolution parameters that will be used in
  5.     a later screen display.
  6.  
  7.     Created: 9/16/87 by Richie Bielak
  8.  
  9.     Modified:
  10.  
  11.     Copyright © 1987 by Richie Bielak
  12.     
  13.     This program maybe freely copied, but please leave
  14.     my name in. Thanks....Richie
  15.  
  16. *)
  17. IMPLEMENTATION MODULE GetRes;
  18.  
  19. FROM SYSTEM        IMPORT ADR;
  20. FROM SimpleWindows IMPORT CreateWindow;
  21. FROM Intuition     IMPORT WindowPtr, GadgetPtr, CloseWindow, IDCMPFlagsSet,
  22.                           IDCMPFlags, WindowFlagsSet, WindowFlags,
  23.               IntuiMessagePtr;
  24. FROM SimpleGadgets IMPORT BeginGadgetList, EndGadgetList, FreeGadgetList,
  25.                           AddGadgetTextButton;
  26. FROM Views         IMPORT ViewModesSet, ViewModes;
  27. FROM Ports         IMPORT WaitPort, ReplyMsg, GetMsg, MessagePtr;
  28.  
  29. TYPE
  30.   ResGadType = (Low, LowLace, High, HighLace);
  31.  
  32. (* ++++++++++++++++++++++++++++++++++++++++ *)
  33. PROCEDURE SetUpGadgets () : GadgetPtr;
  34.   BEGIN
  35.     BeginGadgetList ();
  36.     AddGadgetTextButton (20, 15, ADR("320 X 200"));
  37.     AddGadgetTextButton (20, 30, ADR("320 X 400"));
  38.     AddGadgetTextButton (120, 15, ADR("640 X 200"));
  39.     AddGadgetTextButton (120, 30, ADR("640 X 400"));
  40.     RETURN EndGadgetList ();
  41.   END SetUpGadgets;
  42.  
  43. (* ++++++++++++++++++++++++++++++++++++++++ *)
  44. PROCEDURE ChooseResolution (VAR width, height : CARDINAL;
  45.                             VAR distype : ViewModesSet);
  46.  
  47.   VAR
  48.     wp : WindowPtr;
  49.     gp, glistp : GadgetPtr;
  50.     msgptr : IntuiMessagePtr;
  51.   BEGIN
  52.     glistp := SetUpGadgets ();
  53.     wp := CreateWindow (100, 70, 220, 50,
  54.                         IDCMPFlagsSet {GadgetUp, GadgetDown},
  55.                         WindowFlagsSet {Activate, WindowDrag}, glistp, NIL,
  56.                     ADR ("Choose resolution"));
  57.  
  58.     (* All we got to do is get one message *)
  59.     msgptr := WaitPort (wp^.UserPort^);
  60.     LOOP
  61.       msgptr := GetMsg (wp^.UserPort^);
  62.       IF msgptr = NIL THEN EXIT END;
  63.       gp := msgptr^.IAddress;        
  64.       ReplyMsg (MessagePtr (msgptr));
  65.     END;
  66.     distype := ViewModesSet{}; width := 320; height := 200;
  67.     CASE ResGadType(gp^.GadgetID) OF
  68.       Low: (* This one is the default *)         |
  69.       LowLace:
  70.         distype := ViewModesSet{Lace}; 
  71.     height := 400;                           |
  72.       High:
  73.         distype := ViewModesSet{Hires}; 
  74.     width := 640;                            |
  75.       HighLace:
  76.         distype := ViewModesSet{Hires, Lace}; 
  77.     width := 640; height := 400;
  78.     END;
  79.     CloseWindow (wp^);
  80.     FreeGadgetList (glistp^);
  81.   END ChooseResolution;
  82.  
  83. END GetRes.
  84.