home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / 3rdparty / intuisuputil.mod < prev    next >
Encoding:
Text File  |  1994-08-08  |  4.1 KB  |  162 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: IntuiSupUtil.mod $
  4.   Description: Support for clients of intuisup.library.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 2.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:06:14 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE IntuiSupUtil;
  18.  
  19. (*
  20. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
  21. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  22. ** $V= OvflChk       $Z= ZeroVars
  23. *)
  24.  
  25. IMPORT
  26.   E := Exec, I := Intuition, ISup := IntuiSup, SYS := SYSTEM;
  27.  
  28. (*------------------------------------------------------------------------*)
  29. (* Procedures for Gadgets *)
  30.  
  31. CONST
  32.   disableFlag = {ISup.gdDisabled};
  33.   noFlag = {};
  34.  
  35.  
  36. (*------------------------------------------------------------------------*)
  37. (* Procedures for AutoRequesters *)
  38.  
  39. CONST
  40.   noIDCMPFlags = {};
  41.   autoReqFlags =
  42.     {ISup.arBackFill, ISup.arMovePointerNeg, ISup.arDrawRaster};
  43.   acceptText = "Accept";
  44.   cancelText = "Cancel";
  45.   continueText = "Continue";
  46.  
  47.  
  48. (*------------------------------------------------------------------------*)
  49. (* Procedures for Gadgets *)
  50.  
  51. (*------------------------------------*)
  52. PROCEDURE DisableGadget *
  53.   ( gadgetList : ISup.GadgetList;
  54.     gadget     : INTEGER;
  55.     disableIt  : BOOLEAN);
  56.  
  57.   VAR ignore : LONGINT;
  58.  
  59. BEGIN (* DisableGadget *)
  60.   IF disableIt THEN
  61.     ignore :=
  62.       ISup.base.SetGadgetAttributes (
  63.         gadgetList, gadget, disableFlag, disableFlag,
  64.         ISup.useCurrentValue, ISup.useCurrentValue,
  65.         ISup.useCurrentValue);
  66.   ELSE
  67.     ignore :=
  68.       ISup.base.SetGadgetAttributes (
  69.         gadgetList, gadget, disableFlag, noFlag,
  70.         ISup.useCurrentValue, ISup.useCurrentValue,
  71.         ISup.useCurrentValue);
  72.   END; (* ELSE *)
  73. END DisableGadget;
  74.  
  75.  
  76. (*------------------------------------*)
  77. PROCEDURE SelectGadget *
  78.   ( gadgetList : ISup.GadgetList;
  79.     gadget     : INTEGER;
  80.     selectIt   : BOOLEAN);
  81.  
  82.   VAR ignore, value : LONGINT;
  83.  
  84. BEGIN (* SelectGadget *)
  85.   IF selectIt THEN value := 1 ELSE value := 0 END;
  86.   ignore :=
  87.     ISup.base.SetGadgetAttributes (
  88.       gadgetList, gadget, noFlag, noFlag, value, ISup.useCurrentValue,
  89.       ISup.useCurrentValue);
  90. END SelectGadget;
  91.  
  92.  
  93. (*------------------------------------*)
  94. PROCEDURE SetGadget *
  95.   ( gadgetList : ISup.GadgetList;
  96.     gadget     : INTEGER;
  97.     gadgetType : INTEGER;
  98.     value      : LONGINT);
  99.  
  100.   VAR ignore : LONGINT;
  101.  
  102. BEGIN (* SetGadget *)
  103.   CASE gadgetType OF
  104.     ISup.button, ISup.check :
  105.       ignore :=
  106.         ISup.base.SetGadgetAttributes
  107.           ( gadgetList, gadget, noFlag, noFlag, value, ISup.useCurrentValue,
  108.             ISup.useCurrentValue);
  109.     |
  110.     ISup.mx, ISup.cycle :
  111.       ignore :=
  112.         ISup.base.SetGadgetAttributes
  113.           ( gadgetList, gadget, noFlag, noFlag, ISup.useCurrentValue, value,
  114.             ISup.useCurrentValue);
  115.     |
  116.   ELSE
  117.     ignore :=
  118.       ISup.base.SetGadgetAttributes
  119.         ( gadgetList, gadget, noFlag, noFlag, ISup.useCurrentValue,
  120.           ISup.useCurrentValue, value);
  121.   END; (* CASE gadgetType *)
  122. END SetGadget;
  123.  
  124.  
  125. (*------------------------------------------------------------------------*)
  126. (* Procedures for AutoRequesters *)
  127.  
  128.  
  129. (*------------------------------------*)
  130. (* $D- disable copying of open arrays *)
  131. PROCEDURE DoRequest *
  132.   ( reqWin   : I.WindowPtr;
  133.     title    : E.STRPTR;
  134.     bodyText : ARRAY OF CHAR )
  135.   : BOOLEAN;
  136.  
  137. BEGIN (* DoRequest *)
  138.   RETURN
  139.     ISup.base.AutoRequest
  140.       ( reqWin, title, bodyText, SYS.ADR(acceptText), SYS.ADR(cancelText),
  141.         noIDCMPFlags, noIDCMPFlags, autoReqFlags, NIL);
  142. END DoRequest;
  143.  
  144.  
  145. (*------------------------------------*)
  146. (* $D- disable copying of open arrays *)
  147. PROCEDURE DoNotice *
  148.   ( reqWin : I.WindowPtr;
  149.     title    : E.STRPTR;
  150.     bodyText : ARRAY OF CHAR );
  151.  
  152.   VAR ignore : BOOLEAN;
  153.  
  154. BEGIN (* DoNotice *)
  155.   ignore :=
  156.     ISup.base.AutoRequest
  157.       ( reqWin, title, bodyText, NIL, SYS.ADR(continueText), noIDCMPFlags,
  158.         noIDCMPFlags, autoReqFlags, NIL);
  159. END DoNotice;
  160.  
  161. END IntuiSupUtil.
  162.