home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d138 / modulatools.lha / ModulaTools / ModulaTools.source / WindowTools.mod < prev   
Encoding:
Modula Implementation  |  1988-03-20  |  18.3 KB  |  374 lines
  1. (******************************************************************************)
  2. (*                                                                            *)
  3. (*  Version 1.00a.002 (Beta) :   March 2, 1988                                *)
  4. (*                                                                            *)
  5. (*    These procedures were originally written under version 1.20 of the TDI  *)
  6. (* Modula-2 compiler. I have rewritten this module to operate under the v2.00 *)
  7. (* compiler. However, should you find any problem or inconsistency with the   *)
  8. (* functionality of this code, please contact me at the following address:    *)
  9. (*                                                                            *)
  10. (*                               Jerry Mack                                   *)
  11. (*                               23 Prospect Hill Ave.                        *)
  12. (*                               Waltham, MA   02154                          *)
  13. (*                                                                            *)
  14. (*    Check the module MenuUtils for TDI's (considerably less powerful) ver-  *)
  15. (* sions of my Menu and IntuitionText procedures. The modules GadgetUtils and *)
  16. (* EasyGadgets should also be of great help.                                  *)
  17. (*                                                                            *)
  18. (******************************************************************************)
  19. (*                                                                            *)
  20. (*    The source code to WindowTools is in the public domain. You may do with *)
  21. (* it as you please.                                                          *)
  22. (*                                                                            *)
  23. (******************************************************************************)
  24.  
  25. IMPLEMENTATION MODULE WindowTools;
  26.  
  27.  
  28. FROM GraphicsBase    IMPORT GfxBasePtr, NTSC, PAL;
  29. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase;
  30. FROM Intuition       IMPORT IntuitionName, IntuitionBase, IntuitionBasePtr,
  31.                             IDCMPFlags,IDCMPFlagSet, StdScreenHeight,
  32.                             Screen, ScreenPtr, ScreenFlags, ScreenFlagSet,
  33.                             CustomScreen, WindowPtr, NewWindow,
  34.                             WindowFlags, WindowFlagSet, SmartRefresh;
  35. FROM Libraries       IMPORT OpenLibrary, CloseLibrary;
  36. FROM Screens         IMPORT NewScreen, NewScreenPtr, OpenScreen;
  37. FROM Storage         IMPORT ALLOCATE, DEALLOCATE;
  38. FROM Strings         IMPORT String, InitStringModule, Compare, Equal, Length;
  39. FROM SYSTEM          IMPORT ADR, BYTE, NULL;
  40. FROM Views           IMPORT Modes, ModeSet;
  41. FROM Windows         IMPORT OpenWindow;
  42.  
  43. CONST
  44.    NoText      = 0C;
  45.    MinHigh     = 30;                (* minimum height of Windows and Screens *)
  46.    MinWide     = 40;                (* minimum width  of Windows             *)
  47.  
  48. TYPE
  49.    StringPtr = POINTER TO String;       (* storage space for Menu text;      *)
  50.  
  51. VAR
  52.    ScreenHeight : INTEGER;           (* # of lines in non-interlaced display *)
  53.  
  54.  
  55.    PROCEDURE Min (int1, int2 : INTEGER ) : INTEGER;
  56.    
  57.    BEGIN
  58.       IF (int1 < int2) THEN              (* utility routine to find the    *)
  59.          RETURN int1;                    (* minimum of a pair of integers; *)
  60.       ELSE
  61.          RETURN int2;
  62.       END; (* IF int1 *)
  63.    END Min; 
  64.    
  65.    
  66.    PROCEDURE Max (int1, int2 : INTEGER ) : INTEGER;
  67.    
  68.    BEGIN
  69.       IF (int1 > int2) THEN              (* utility routine to find the    *)
  70.          RETURN int1;                    (* maximum of a pair of integers; *)
  71.       ELSE
  72.          RETURN int2;
  73.       END; (* IF int1 *)
  74.    END Max; 
  75.    
  76.  
  77. (***************************************************************************)
  78. (*                                                                         *)
  79. (*    This procedure opens the Intuition & Graphics libraries and initial- *)
  80. (* izes the user-accessible variables for the procedures CreateScreen and  *)
  81. (* CreateWindow. If both libraries are opened properly, the procedure re-  *)
  82. (* turns the value TRUE; otherwise, it returns the value FALSE.            *)
  83. (*                                                                         *)
  84. (***************************************************************************)
  85.  
  86.    PROCEDURE OpenGraphics () : BOOLEAN;
  87.  
  88.    CONST
  89.       IntuitionRev = 33;
  90.       GraphicsRev  = 33;
  91.  
  92.    BEGIN
  93.  
  94.       TextPen         := 0;               (* which color registers to use; *)
  95.       FillPen         := 1;
  96.       MinWindowWide   := MinWide;    (* minimum and maximum dimensions to  *)
  97.       MaxWindowWide   := 0;          (* which Window may be sized; 0 -->   *)
  98.       MinWindowHigh   := MinHigh;    (* current dimension is used;         *)
  99.       MaxWindowHigh   := 0;
  100.       ScreenBitMap    := NULL;   (* <> NULL --> user-managed Screen bitmap *)
  101.       WindowBitMap    := NULL;   (* <> NULL --> user-managed Window bitmap *)
  102.       ViewFeatures    := ModeSet{};
  103.       ScreenFeatures  := CustomScreen;
  104.       WindowFeatures  := SmartRefresh + WindowFlagSet {WindowSizing,
  105.                          WindowDrag, WindowDepth, WindowClose, 
  106.                          Activate, ReportMouseFlag}; 
  107.       IDCMPFeatures   := IDCMPFlagSet{MenuPick, CloseWindowFlag, NewSize,
  108.                                       GadgetUp};
  109.  
  110.  
  111.   (* IntuitionBase & GraphicsBase let the compiler know where to access  *)
  112.   (* the associated libraries; UserIntuiBase & UserGraphBase do the same *)
  113.   (* for the user;                                                       *)
  114.  
  115.       IntuitionBase   := OpenLibrary (IntuitionName,IntuitionRev);
  116.       UserIntuiBase   := IntuitionBasePtr (IntuitionBase);
  117.       IF (IntuitionBase = NULL) THEN
  118.          UserGraphBase := NIL;
  119.          RETURN FALSE;
  120.       ELSE
  121.          GraphicsBase  := OpenLibrary (GraphicsName, GraphicsRev);
  122.          UserGraphBase := GfxBasePtr (GraphicsBase);
  123.          IF (GraphicsBase = NULL) THEN
  124.             CloseLibrary (IntuitionBase);
  125.             RETURN FALSE;
  126.          ELSE            (* Hey TDI: Where's GraphicsBase^.NormalDisplayRows? *)
  127.             IF (UserGraphBase^.DisplayFlags = PAL) THEN
  128.                ScreenHeight := 256;         (* set Screen height according *)
  129.             ELSE                            (* to whether monitor is PAL   *)
  130.                ScreenHeight := 200;         (* or NTSC;                    *)
  131.             END; (* IF UserGraphBase^ *)
  132.             RETURN TRUE;
  133.          END; (* IF GraphicsBase *)
  134.       END; (* IF IntuitionBase *)
  135.    END OpenGraphics;
  136.  
  137.  
  138. (***************************************************************************)
  139. (*                                                                         *)
  140. (*    This procedure opens a Screen with a minimum of fuss while allowing  *)
  141. (* the user easy access to the fields of the NewScreen structure. Several  *)
  142. (* checks are made to insure that illegal parameter values are not handed  *)
  143. (* to the Amiga. The procedure returns a pointer to the desired Screen ex- *)
  144. (* cept when OpenScreen fails, in which case it will return a NULL pointer.*)
  145. (*    The procedure "OpenGraphics" must be called prior to invoking        *)
  146. (* this procedure, in order to open certain libraries & initialize certain *)
  147. (* variables.                                                              *)
  148. (*                                                                         *)
  149. (*    The following parameters are required as inputs:                     *)
  150. (*                                                                         *)
  151. (*     Left - (INTEGER) the leftmost pixel-position of the Screen; this is *)
  152. (*            always set to zero in this version of the procedure.         *)
  153. (*     Top  - (INTEGER) the topmost pixel-position of the Screen; this can *)
  154. (*            be set to any value between 0 and the bottommost vertical    *)
  155. (*            pixel (399 if Lace is set in ViewFeatures, 199 otherwise).   *)
  156. (*     Wide - (INTEGER) the width of the Screen; this will be set to the   *)
  157. (*            maximum # of horizontal pixels in the display (640 if Hires  *)
  158. (*            is set in ViewFeatures, 320 otherwise).                      *)
  159. (*     High - (INTEGER) the height of the Screen; this will be set so that *)
  160. (*            Top+High >= # of vertical pixels on the Screen.              *)
  161. (*   Bitplanes - (INTEGER) # of bitplanes desired for this Screen; this is *)
  162. (*               allowed to take the values from 0 to 5 with plain Screens,*)
  163. (*               0 to 6 with Dual-playfield Screens and 6 otherwise.       *)
  164. (*  ScreenTitle - (String) title of the Screen; if this equals the defined *)
  165. (*                constant "NoTitle", then neither a title nor a drag bar  *)
  166. (*                will be included with the Screen.                        *)
  167. (*                                                                         *)
  168. (***************************************************************************)
  169.  
  170.    PROCEDURE CreateScreen (Left, Top, Wide, High : INTEGER;
  171.                            Bitplanes             : INTEGER;
  172.                            VAR ScreenTitle       : String) : ScreenPtr;
  173.    
  174.    VAR
  175.       UserScreen : NewScreenPtr;
  176.       TempScreen : ScreenPtr;
  177.       
  178.    BEGIN
  179.       NEW (UserScreen);
  180.       WITH UserScreen^ DO 
  181.  
  182.          LeftEdge := 0;
  183.          IF (Hires IN ViewFeatures) THEN
  184.             Width := 640;                   (* make sure that Screen fills *)
  185.          ELSE                               (* the display                 *)
  186.             Width := 320;
  187.          END; (* IF Hires *)
  188.  
  189.  
  190. (* ensure that Screen is not larger than the display or smaller than I allow *)
  191.  
  192.          IF (Lace IN ViewFeatures) THEN
  193.             IF (High <> StdScreenHeight) THEN
  194.                Height  := Max(MinHigh, Min(High, 2*ScreenHeight));
  195.                TopEdge := Max(0,       Min(Top,  2*ScreenHeight - MinHigh));
  196.             ELSE
  197.                Height  := 2*ScreenHeight;
  198.                TopEdge := 0;
  199.             END; (* IF High *)
  200.          ELSE
  201.             IF (High <> StdScreenHeight) THEN
  202.                Height  := Max(MinHigh, Min(High, ScreenHeight));
  203.                TopEdge := Max(0,       Min(Top,  ScreenHeight - MinHigh));
  204.             ELSE
  205.                Height  := ScreenHeight;
  206.                TopEdge := 0;
  207.             END; (* IF High *)
  208.          END; (* IF Lace *)
  209.  
  210.  
  211.                          (* # of bitplanes desired/required *)
  212.  
  213.          IF (DualPF IN ViewFeatures) THEN      (* dual-playfield mode      *)
  214.             Depth := Min (6, Max(0, Bitplanes));
  215.          ELSIF (HAM IN ViewFeatures) THEN      (* hold-and-modify mode     *)
  216.             Depth := 6;
  217.          ELSIF (ExtraHalfBright IN ViewFeatures) THEN
  218.             Depth := 6;                        (* extra-half-bright mode   *)
  219.          ELSE
  220.             Depth := Min (5, Max (0, Bitplanes)); (* normal mode           *)
  221.          END; (* IF DualPF *)
  222.  
  223.          ViewModes    := ViewFeatures;
  224.          Type         := ScreenFeatures;
  225.          DetailPen    := BYTE(TextPen);
  226.          BlockPen     := BYTE(FillPen);
  227.          Font         := NULL;                 (* use system font          *)
  228.          Gadgets      := NULL;                 (* no gadget list to add    *)
  229.          CustomBitMap := ScreenBitMap;         (* initially NULL           *)
  230.  
  231.          IF (Compare(ScreenTitle, NoTitle) = Equal) THEN
  232.             DefaultTitle := ADR(ScreenTitle);
  233.          ELSE
  234.             DefaultTitle := ADR(ScreenTitle);  (* render Screen title      *)
  235.          END; (* IF Compare *)
  236.  
  237.       END; (* WITH UserScreen^ *)
  238.  
  239.       TempScreen := OpenScreen (UserScreen);
  240.       DISPOSE (UserScreen);                (* replaced by Screen structure *)
  241.       RETURN TempScreen;
  242.  
  243.    END CreateScreen;
  244.  
  245.    
  246. (***************************************************************************)
  247. (*                                                                         *)
  248. (*    This procedure opens a Window with a minimum of fuss while allowing  *)
  249. (* the user easy access to the fields of the NewWindow structure. Several  *)
  250. (* checks are made to insure that illegal parameter values are not handed  *)
  251. (* to the Amiga. The procedure returns a pointer to the desired Window ex- *)
  252. (* cept when OpenWindow fails, in which case it will return a NULL pointer.*)
  253. (*    The procedure "OpenGraphics" must be called prior to invoking        *)
  254. (* this procedure, in order to open certain libraries & initialize certain *)
  255. (* variables.                                                              *)
  256. (*                                                                         *)
  257. (*    The following parameters are required as inputs:                     *)
  258. (*                                                                         *)
  259. (*     Left - (INTEGER) the leftmost pixel-position of the Window;         *)
  260. (*     Top  - (INTEGER) the topmost  pixel-position of the Window;         *)
  261. (*     Wide - (INTEGER) the width  of the Window;                          *)
  262. (*     High - (INTEGER) the height of the Window;                          *)
  263. (*                                                                         *)
  264. (*  WindowTitle - (String) title of the Window; if this equals the defined *)
  265. (*                constant "NoTitle", then no title will be rendered;      *)
  266. (*  UserScreen  - (ScreenPtr) pointer to the Screen in which the Window    *)
  267. (*                will be opened; if this is set to NULL, then the Window  *)
  268. (*                will be opened in the WorkBench Screen.                  *)
  269. (*                                                                         *)
  270. (*                                                                         *)
  271. (*    The following relationships hold among the first four parameters:    *)
  272. (*                                                                         *)
  273. (*                 0    <=  Left  <=  Screen width  -  MinWide;            *)
  274. (*                 0    <=  Top   <=  Screen height -  MinHigh;            *)
  275. (*              MinWide <=  Wide  <=  Screen width  -  Left;               *)
  276. (*              MinHigh <=  High  <=  Screen height -  Top.                *)
  277. (*                                                                         *)
  278. (*         MinWide and MinHigh are global constants defined above.         *)
  279. (*                                                                         *)
  280. (***************************************************************************)
  281.  
  282.    PROCEDURE CreateWindow (Left, Top, Wide, High : INTEGER;
  283.                            VAR WindowTitle       : String;
  284.                            UserScreen            : ScreenPtr) : WindowPtr;
  285.                          
  286.    VAR
  287.       UserWindow    : NewWindow;
  288.  
  289.    BEGIN
  290.  
  291.       IF (UserScreen <> NULL) THEN      (* make sure Window fits in Screen *)
  292.          Left := Max(0,       Min(Left, UserScreen^.Width  - MinWide));
  293.          Wide := Max(MinWide, Min(Wide, UserScreen^.Width  - Left));
  294.          Top  := Max(0,       Min(Top,  UserScreen^.Height - MinHigh));
  295.          High := Max(MinHigh, Min(High, UserScreen^.Height - Top));
  296.       ELSE                           (* make sure Window fits in WorkBench *)
  297.          Left := Max(0,       Min(Left, 640 - MinWide));
  298.          Wide := Max(MinWide, Min(Wide, 640 - Left));
  299.          Top  := Max(0,       Min(Top,  ScreenHeight - MinHigh));
  300.          High := Max(MinHigh, Min(High, ScreenHeight - Top));
  301.       END; (* IF UserScreen *)
  302.  
  303.       MinWindowWide := Max(0, Min(1024, MinWindowWide)); (* limits to which   *)
  304.       MinWindowHigh := Max(0, Min(1024, MinWindowHigh)); (* Window may be     *)
  305.       MaxWindowWide := Max(0, Min(1024, MaxWindowWide)); (* sized with sizing *)
  306.       MaxWindowHigh := Max(0, Min(1024, MaxWindowHigh)); (* gadget;           *)
  307.  
  308.       WITH UserWindow DO                 (* Initialize NewWindow structure *)
  309.  
  310.          LeftEdge   := Left;
  311.          TopEdge    := Top;              (* location & size of Window      *)
  312.          Width      := Wide;
  313.          Height     := High;
  314.          DetailPen  := BYTE (TextPen);   (* pen for Window's text          *)
  315.          BlockPen   := BYTE (FillPen);   (* pen for Window's background    *)
  316.          Flags      := WindowFeatures;   (* Window type, gadgets, etc.     *)
  317.          IDCMPFlags := IDCMPFeatures;    (* Intuition messages received    *)
  318.          CheckMark  := NULL;             (* <> NULL --> use your checkmark *)
  319.  
  320.          IF (Compare(WindowTitle, NoTitle) = Equal) THEN
  321.             Title   := NULL;
  322.          ELSE
  323.             Title   := ADR(WindowTitle); (* render Window title            *)
  324.          END; (* IF Compare *)
  325.  
  326.          IF (UserScreen <> NULL) THEN    (* use user-opened Screen         *)
  327.             Type := CustomScreen;
  328.          ELSE                            (* use WorkBench Screen           *)
  329.             Type := ScreenFlagSet{WBenchScreen};
  330.          END; (* IF UserWindow *)
  331.  
  332.          FirstGadget := NULL;            (* user-created gadget-list       *)
  333.          BitMap      := WindowBitMap;    (* <> NULL --> user-managed bitmap*)
  334.          MinWidth    := MinWindowWide;
  335.          MinHeight   := MinWindowHigh;   (* limits to which Window can be  *)
  336.          MaxWidth    := MaxWindowWide;   (* sized if size gadget attached  *)
  337.          MaxHeight   := MaxWindowHigh;
  338.          Screen      := UserScreen;      (* Window appears in this Screen  *)
  339.  
  340.       END; (* WITH UserWindow *)
  341.  
  342.       RETURN OpenWindow (UserWindow);
  343.    END CreateWindow;
  344.    
  345.    
  346. (***************************************************************************)
  347. (*                                                                         *)
  348. (*    This procedure closes the Intuition & Graphics libraries which were  *)
  349. (* opened by the OpenGraphics procedure. Since GraphicsBase and Intuition- *)
  350. (* Base were assigned by this module, they must also be closed by this     *)
  351. (* module. Any attempt by the user to close these libraries using her/his  *)
  352. (* own GraphicsBase and IntuitionBase won't work, since the bases she/he   *)
  353. (* imports will be different variables. UserIntuiBase & UserGraphBase gives*)
  354. (* user access to these addresses, if she/he requires.                     *)
  355. (*                                                                         *)
  356. (***************************************************************************)
  357.  
  358.    PROCEDURE CloseGraphics ();
  359.    
  360.    BEGIN
  361.       CloseLibrary (GraphicsBase );  (* Close libraries in the  *)
  362.       CloseLibrary (IntuitionBase ); (* order they were opened  *) 
  363.    END CloseGraphics;
  364.  
  365.  
  366.  
  367. BEGIN
  368.  
  369.    InitStringModule;
  370.                                (* default # of lines in non-interlaced     *)
  371.    ScreenHeight := 200;        (* display; it's reassigned in CreateScreen *)
  372.  
  373. END WindowTools.
  374.