home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / mar94 / os20 / cdity / devicelock.lha / DeviceLock / Txt / DeviceLock.mod < prev    next >
Text File  |  1993-12-05  |  18KB  |  557 lines
  1. (*---------------------------------------------------------------------------
  2.  :Program.    DeviceLock.mod
  3.  :Author.     Thomas Wagner
  4.  :Address.    Mühlenweg 7, 90602 Pyrbaum, Germany
  5.  :Copyright.  © 1991-93 by Thomas Wagner [tom], see DeviceLock.guide
  6.  :Language.   Oberon
  7.  :Translator. Amiga Oberon Compiler V3.00d
  8.  :Import.     HotKey.mod         V2.0 Thomas Igracki, [tom]  (on this disk)
  9.  :Import.     MoreIntuition.mod  V1.3 [mick]                 (Amok 78)
  10.  :Import.     WBReadArgs.mod     V1.0 [hG]                   (Amok 83)
  11.  :Import.     PrintF.mod         V1.4 Volker Rudolph, [hG]   (Amok 82)
  12.  :Contents.   Lock with Intuition-Interface (2.04 or higher ONLY!)
  13. ---------------------------------------------------------------------------*)
  14.  
  15. MODULE DeviceLock;
  16.  
  17. (*-------------------------------------------------------------------------*)
  18.  
  19. IMPORT c  := Conversions,
  20.        d  := Dos,
  21.        DLd:= DLdrives,
  22.        DLr:= DLrequester,
  23.        DLs:= DLstrings,
  24.        DLp:= DLprefs,
  25.        e  := Exec,
  26.        g  := Graphics,
  27.        gt := GadTools,
  28.        hot:= HotKey,
  29.        I  := Intuition,
  30.        MI := MoreIntuition,
  31.        ol := OberonLib,
  32.        s  := Strings,
  33.        sys:= SYSTEM,
  34.        t  := Timer,
  35.        u  := Utility;
  36.  
  37. (*-------------------------------------------------------------------------*)
  38.  
  39. CONST
  40.  
  41.   comName  *= "DeviceLock\o$VER: DeviceLock 1.0 (31.10.93)";
  42.   comTitle *= "DeviceLock, 1.0 © 1991-93 [tom]";
  43.   comDescr *= "Intuition-Interface for CLI-Lock";
  44.  
  45.   scrtitle = "DeviceLock, 1.0 - © 1991-93 by Thomas Wagner. All Rights reserved.";
  46.  
  47.   about    = "DeviceLock 1.0\n\n"
  48.              "© 1991-93 by Thomas Wagner, Pyrbaum [tom].\n"
  49.               "%s";
  50.  
  51.   topadd = 5 ;
  52.  
  53.   checkscal = 2421;
  54.  
  55. (*-------------------------------------------------------------------------*)
  56.  
  57. TYPE
  58.  
  59.     NewMenus = ARRAY 9 OF gt.NewMenu;
  60.  
  61. (*-------------------------------------------------------------------------*)
  62.  
  63. CONST
  64.  
  65.   menuLock     = 1;
  66.   menuUnlock   = 2;
  67.   menuAbout    = 3;
  68.   menuHide     = 4;
  69.   menuQuit     = 5;
  70.  
  71.  
  72.   myNewMenuConst = NewMenus(
  73.     gt.title, NIL,         NIL,          {}, LONGSET{}, NIL,
  74.     gt.item , NIL,         sys.ADR("L"), {}, LONGSET{}, menuLock,
  75.     gt.item , NIL,         sys.ADR("U"), {}, LONGSET{}, menuUnlock,
  76.     gt.item , gt.barLabel, NIL,          {}, LONGSET{}, NIL,
  77.     gt.item , NIL,         sys.ADR("?"), {}, LONGSET{}, menuAbout,
  78.     gt.item , gt.barLabel, NIL,          {}, LONGSET{}, NIL,
  79.     gt.item , NIL,         sys.ADR("H"), {}, LONGSET{}, menuHide,
  80.     gt.item , NIL,         sys.ADR("Q"), {}, LONGSET{}, menuQuit,
  81.     gt.end  , NIL,         NIL,          {}, LONGSET{}, NIL);
  82. (*-------------------------------------------------------------------------*)
  83.  
  84. VAR
  85.   font          : g.TextFontPtr;
  86.   ng            : gt.NewGadget;
  87.   glist         : I.GadgetPtr;
  88.   gad           : I.GadgetPtr;
  89.   vi            : e.APTR;
  90.   terminated    : BOOLEAN;
  91.   imsg          : I.IntuiMessagePtr;
  92.   imsgClass     : LONGSET;
  93.   imsgCode      : INTEGER;
  94.   count         : INTEGER;
  95.   TimerPort     : e.MsgPortPtr;
  96.   TimeReq       : t.TimeRequestPtr;
  97.   OpenDev       : SHORTINT;
  98.   signals       : LONGSET;
  99.   allock        : BOOLEAN;
  100.   allunlock     : BOOLEAN;
  101.   quickquit     : BOOLEAN;
  102.   gheight       : INTEGER;
  103.   wheight       : INTEGER;
  104.   wwidth        : INTEGER;
  105.   windowopen    : BOOLEAN;
  106.   HotSig        : SHORTINT;
  107.   HotType    : LONGSET;
  108.   HotID         : LONGINT;
  109.   closewin      : BOOLEAN;
  110.   myNewMenu     : NewMenus;
  111.   menu          : I.MenuPtr;
  112.   topborder     : INTEGER;
  113.   zoom          : ARRAY 4 OF INTEGER;
  114.   force         : BOOLEAN;
  115.  
  116.  
  117. (*------ Append one Gadget to Gadget-List ---------------------------------*)
  118.  
  119. PROCEDURE * MakeGad(VAR n: DLp.driveT);
  120. BEGIN
  121.   ng.topEdge := topborder + topadd + 2 + (count)*gheight;
  122.   ng.gadgetText := sys.ADR(n.PrintName);
  123.   ng.gadgetID := count;
  124.   gad := gt.CreateGadget(gt.checkBoxKind, gad, ng,
  125.                          I.gaDisabled, sys.VAL(SHORTINT,n.disabled),
  126.                          gt.cbChecked, sys.VAL(SHORTINT,n.locked),
  127.                          gt.cbScaled, I.LTRUE,
  128.                          u.done);
  129.   n.GadPtr:=gad;
  130. END MakeGad;
  131.  
  132.  
  133. (*------ Prepare and Send IO ----------------------------------------------*)
  134.  
  135. PROCEDURE psIO();
  136. BEGIN
  137.   TimeReq.time.secs  := DLp.Prefs.CheckTime;
  138.   TimeReq.time.micro := 0;
  139.   e.SendIO(TimeReq);
  140. END psIO;
  141.  
  142.  
  143. (*------ Do something on response to a pressed Gadget ---------------------*)
  144.  
  145. PROCEDURE HandleGadgetEvent(gad: I.GadgetPtr; code: INTEGER);
  146. BEGIN
  147.   IF gad.gadgetID =  0 THEN
  148.     DLd.LockAll(FALSE);
  149.   ELSE
  150.     IF gad.gadgetID<=DLp.Prefs.DriveNum THEN
  151.       IF I.selected IN gad.flags THEN
  152.         DLd.LckOne(DLp.drive[gad.gadgetID-1])
  153.       ELSE
  154.         DLd.UnLckOne(DLp.drive[gad.gadgetID-1])
  155.       END;
  156.     END;
  157.     force := FALSE;
  158.   END;
  159. END HandleGadgetEvent;
  160.  
  161. (*------ Response to Menu-select ------------------------------------------*)
  162.  
  163. PROCEDURE HandleMenuEvent(code: INTEGER);
  164.  
  165. VAR
  166.   item: I.MenuItemPtr;
  167.  
  168. BEGIN
  169.   WHILE (code # I.menuNull) AND ~ terminated DO
  170.     item := I.ItemAddress(menu^, code);
  171.     CASE sys.VAL(LONGINT,gt.MenuItemUserData(item)) OF
  172.       menuLock   : DLd.LockAll(FALSE); |
  173.       menuUnlock : DLd.UnlockAll(FALSE); |
  174.       menuAbout  : DLr.RequestNotify(DLs.GetString(DLs.MsgAbout),
  175.                                    sys.ADR(about),
  176.                                    DLs.GetString(DLs.MsgAllRightsReserved)); |
  177.       menuHide   : closewin   := TRUE; |
  178.       menuQuit   : terminated := TRUE; quickquit := FALSE |
  179.     ELSE END;
  180.  
  181.     code := item.nextSelect;
  182.  
  183.   END;
  184.  
  185. END HandleMenuEvent;
  186.  
  187. (*------ Lock all window-specific resources and open window ---------------*)
  188.  
  189. PROCEDURE OpenWindow(hijackfront: BOOLEAN);
  190. VAR    twidth  : INTEGER;
  191.        mysc    : I.ScreenPtr;
  192.        gadwidth: LONGINT;
  193.  
  194.   (*------ Starts Gadget-List and calls MakeGadget --------------------------*)
  195.  
  196.   PROCEDURE CreateAllGadgets(VAR glist: I.GadgetPtr;
  197.                                  vi: e.APTR;
  198.                                  topborder: INTEGER;
  199.                                  mysc: I.ScreenPtr): BOOLEAN;
  200.   BEGIN
  201.     gad := gt.CreateContext(glist);
  202.     ng.textAttr := mysc.font;
  203.     ng.leftEdge := 8;
  204.     ng.topEdge := topadd + topborder;
  205.     ng.width := wwidth-15;
  206.     ng.height := gheight + 2;
  207.     ng.gadgetText := DLs.GetString(DLs.GadLockAll);
  208.     ng.flags := LONGSET{};
  209.     ng.gadgetID := 0;
  210.     ng.visualInfo := vi;
  211.     gad := gt.CreateGadget(gt.buttonKind, gad, ng, u.done);
  212.  
  213.     ng.flags := LONGSET{gt.placeTextRight};
  214.     ng.height := gheight;
  215.     ng.width := SHORT(gadwidth);
  216.     FOR count := 1 TO DLp.Prefs.DriveNum DO
  217.       MakeGad(DLp.drive[count-1]);
  218.     END;
  219.  
  220.     RETURN gad#NIL;
  221.  
  222.   END CreateAllGadgets;
  223.  
  224.   (*---- Check and FailOut if FALSE   +  Unlock PubScreen! ----------------*)
  225.   PROCEDURE CheckAndFail(test: BOOLEAN; error: ARRAY OF CHAR);
  226.   BEGIN
  227.     IF ~test THEN
  228.       (* Save to call with mysc=NIL ! *) I.UnlockPubScreen(NIL,mysc);
  229.       DLr.FailOut(error);
  230.     END;
  231.   END CheckAndFail;
  232.  
  233.   (*---- Swaps two INTEGER's ----------------------------------------------*)
  234.   PROCEDURE SwapInt(VAR x,y: INTEGER);
  235.   VAR s: INTEGER;
  236.   BEGIN
  237.     s := x;
  238.     x := y;
  239.     y := s;
  240.   END SwapInt;
  241.  
  242.   (*---- Max of two INTEGER's ---------------------------------------------*)
  243.   PROCEDURE Max(x,y: INTEGER):INTEGER;
  244.   BEGIN
  245.   IF x > y THEN RETURN(x) ELSE RETURN(y) END;
  246.   END Max;
  247.  
  248.   (*---- Min of two INTEGER's ---------------------------------------------*)
  249.   PROCEDURE Min(x,y: INTEGER):INTEGER;
  250.   BEGIN
  251.   IF x < y THEN RETURN(x) ELSE RETURN(y) END;
  252.   END Min;
  253.  
  254.  
  255. BEGIN
  256.   IF hijackfront THEN
  257.     DLp.Buffer1 := "\o";
  258.     mysc := MI.LockFrontPubScr(DLp.Buffer1);
  259.   ELSE
  260.     mysc := I.LockPubScreen(DLp.Prefs.PubScreen);
  261.   END;
  262.   IF mysc=NIL THEN mysc := I.LockPubScreen(NIL) END;
  263.   CheckAndFail(mysc#NIL,"LockPubScreen()");
  264.  
  265.   font := g.OpenFont(mysc.font^);
  266.   CheckAndFail(font#NIL,"OpenFont()");
  267.  
  268.   zoom[0] := DLp.Prefs.LeftEdgeZoomed;
  269.   zoom[1] := DLp.Prefs.TopEdgeZoomed;
  270.  
  271.   gheight := mysc.font.ySize;
  272.   IF gheight < 11 THEN gheight := 11 END;
  273.  
  274.   wwidth := g.TextLength(sys.ADR(mysc.rastPort),
  275.                          DLs.GetString(DLs.GadLockAll)^,
  276.                          s.Length(DLs.GetString(DLs.GadLockAll)^))