home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 931-950 / ff947 / steamywindows / steamywindows.mod < prev    next >
Text File  |  1993-12-22  |  8KB  |  272 lines
  1.  
  2. (* --------------------------------------------------------------------------
  3.   :Program.       SteamyWindows.mod
  4.   :Contents.      raises the priority of the active window's task (comdity)
  5.   :Author.        Franz Schwarz
  6.   :Copyright.     Freeware (freely distributable, copyrighted software)
  7.   :Language.      Oberon-2
  8.   :Translator.    Amiga Oberon 3.00
  9.   :History.       v1.0 26.10.93 [fSchwarz]
  10.   :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  11.   :Address.       uucp: Franz_Schwarz@mil.ka.sub.org - Fido: 2:2476/506.18
  12.   :Remark.        Requires OS3.0 interface modules update by hartmut Goebel
  13.   :Remark.        Amiga-Oberon 3.00 checks string pointers to be even if
  14.   :Remark.        OddChk is enabled; thus don't compile with OddChk.
  15.   :Usage.         SteamyWindows (CLI or wbstart) no args
  16. -------------------------------------------------------------------------- *)
  17.  
  18. MODULE SteamyWindows;
  19.  
  20. IMPORT
  21.   co: Commodities, e: Exec, I: Intuition, d: Dos, H: Hardware, 
  22.   o: OberonLib, y: SYSTEM;
  23.  
  24. CONST
  25.   verTag = "\000$VER: SteamyWindows 1.0 (26.10.93) © Franz_Schwarz@mil.ka.sub.org - Freeware";
  26.  
  27. CONST
  28.   true = TRUE; false = FALSE; (* adapt to common lower case CONST style *)
  29.  
  30.           (* ** Interface module bug fixes: ** *)
  31. VAR
  32.   coBase: e.LibraryPtr;
  33. (* CxBroker err parameter register mismatch in Commodities.mod! *)
  34. PROCEDURE CxBroker {coBase, -36} (VAR nb{8}: co.NewBroker;
  35.                                   err{0}   : UNTRACED POINTER TO LONGINT): co.CxObjPtr;
  36. CONST
  37.   unique = 0;          (* misdefinition in Commodities.mod *)
  38.  
  39.  
  40. CONST
  41.   cnb = co.NewBroker (co.nbVersion, y.ADR ("SteamyWindows"), y.ADR (verTag[7]),
  42.                       y.ADR ("Raises the priority of the active window's task"),
  43.                       {unique}, {}, 0, NIL, 0);
  44.  
  45.   cfakenb = co.NewBroker (co.nbVersion, y.ADR ("Angie"), y.ADR (verTag[7]),
  46.                       y.ADR ("Fake broker to exclude usage of Angie"),
  47.                       {unique}, {}, 0, NIL, 0);
  48.  
  49. VAR
  50.   active            : BOOLEAN;
  51.   nb                : co.NewBroker;
  52.   fakenb            : co.NewBroker;
  53.   br                : co.CxObjPtr; 
  54.   fakebr            : co.CxObjPtr; 
  55.  
  56.  
  57. VAR 
  58.   vblanksig: INTEGER;
  59.   oldwin   : I.WindowPtr;
  60.   win      : I.WindowPtr;
  61.  
  62. PROCEDURE VBlankSignaller * (a5{9}: e.APTR): LONGINT;
  63. (* $SaveRegs+ $StackChk- *)
  64. BEGIN
  65.   y.SETREG (13, a5);
  66.   oldwin := win; win := I.int.activeWindow;
  67.   IF oldwin # win THEN
  68.     e.Signal (o.Me, LONGSET {vblanksig-1});
  69.   END;  
  70.   RETURN 0; (* set Z flag *)
  71. END VBlankSignaller;
  72. (* $StackChk= *)
  73.  
  74. CONST
  75.   cvblint = e.Interrupt (NIL, NIL, e.interrupt, -100, y.ADR ("SteamyWindows Snooper"), 
  76.                          NIL, y.VAL (e.PROC, VBlankSignaller));
  77.  
  78. VAR
  79.   vblint: e.Interrupt;                         
  80.  
  81. PROCEDURE ActivateBroker (b: BOOLEAN);
  82. VAR
  83.   lb: LONGINT;
  84. BEGIN
  85.   IF b THEN lb := -1; ELSE lb := 0; END;
  86.   IF co.ActivateCxObj (br, lb) = e.false THEN END;
  87.   active := b;
  88. END ActivateBroker;
  89.  
  90. VAR
  91.   OldPri : INTEGER;
  92.   IncTask: e.TaskPtr;
  93.   
  94. CONST
  95.   invalidPri = 4000H;
  96.   incPri = 4001H;
  97.  
  98. PROCEDURE SecureSetTaskPri (task: e.TaskPtr; pri: INTEGER): INTEGER;
  99. VAR
  100.   t: e.TaskPtr;
  101.   r: INTEGER;
  102. BEGIN
  103.   r := invalidPri;
  104.   IF (task = NIL) OR (pri = invalidPri) THEN RETURN r; END;
  105.   e.Disable ();
  106.   LOOP
  107.     t := e.exec.taskReady.head;
  108.     WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
  109.     IF t.node.succ # NIL THEN EXIT; END;
  110.     t := e.exec.taskWait.head;
  111.     WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
  112.     EXIT;
  113.   END;  
  114.   IF (t.node.succ # NIL) & (e.FindTask (NIL) # t) THEN 
  115.     IF pri = incPri THEN
  116.       pri := LONG (t.node.pri)+1;
  117.     ELSE  
  118.       IF pri+1 # t.node.pri THEN pri := invalidPri; END;
  119.     END;
  120.     IF pri # invalidPri THEN
  121.       IF pri > MAX (SHORTINT) THEN pri := MAX (SHORTINT); END;
  122.       IF pri < MIN (SHORTINT) THEN pri := MIN (SHORTINT); END;
  123.       r := e.SetTaskPri (t, SHORT (pri)); 
  124.     END;  
  125.   END;
  126.   e.Enable ();
  127.   RETURN r;
  128. END SecureSetTaskPri;
  129.  
  130. PROCEDURE Init();
  131. BEGIN
  132.   coBase := co.base;
  133.   IF coBase = NIL THEN HALT (20); END;
  134.   nb := cnb;
  135.   fakenb := cfakenb;
  136.   nb.port := e.CreateMsgPort();
  137.   fakenb.port := e.CreateMsgPort();
  138.   IF (nb.port = NIL) OR (fakenb.port = NIL) THEN HALT (20); END;
  139.   br := CxBroker (nb, NIL);
  140.   fakebr := CxBroker (fakenb, NIL);
  141.   IF (br = NIL) OR (fakebr = NIL) THEN HALT (20); END;
  142.   vblanksig := e.AllocSignal (-1) + 1;
  143.   IF vblanksig = 0 THEN HALT (20); END;
  144.   vblint := cvblint;
  145.   vblint.data := y.REG (13);
  146.   e.AddIntServer (H.vertb, y.ADR (vblint));
  147.   ActivateBroker (true);
  148. END Init;
  149.  
  150.   
  151. PROCEDURE CleanUp();
  152. VAR
  153.   msg: e.MessagePtr;
  154. BEGIN
  155.   IF vblint.code # NIL THEN
  156.     e.RemIntServer (H.vertb, y.ADR (vblint)); vblint.code := NIL;
  157.   END;
  158.   y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL; 
  159.   e.FreeSignal (vblanksig-1); vblanksig := 0;
  160.   co.DeleteCxObjAll (br); br := NIL;
  161.   co.DeleteCxObjAll (fakebr); fakebr := NIL;
  162.   IF nb.port # NIL THEN
  163.     LOOP
  164.       msg := e.GetMsg (nb.port);
  165.       IF msg = NIL THEN EXIT; END;
  166.       e.ReplyMsg (msg);
  167.     END;
  168.   END;      
  169.   e.DeleteMsgPort (nb.port); nb.port := NIL;  
  170.   IF fakenb.port # NIL THEN
  171.     LOOP
  172.       msg := e.GetMsg (fakenb.port);
  173.       IF msg = NIL THEN EXIT; END;
  174.       e.ReplyMsg (msg);
  175.     END;
  176.   END;      
  177.   e.DeleteMsgPort (fakenb.port); fakenb.port := NIL;  
  178.   IF o.Result > 5 THEN I.DisplayBeep (NIL); END;
  179. END CleanUp;  
  180.  
  181. PROCEDURE ChangePri ();
  182. VAR
  183.   newtask: e.TaskPtr;
  184.   lk     : LONGINT;
  185.   w      : I.WindowPtr;
  186.   tmpport: e.MsgPortPtr;
  187. BEGIN
  188.   lk := I.LockIBase (0);
  189.   w := I.int.activeWindow;
  190.   IF active THEN
  191.     newtask := NIL;
  192.     e.Disable();
  193.     IF w # NIL THEN
  194.       tmpport := w.userPort;
  195.       IF (y.VAL (LONGSET, tmpport) * LONGSET {0,31} = LONGSET {}) &
  196.          (tmpport # NIL) & (e.public IN e.TypeOfMem (tmpport)) &
  197.          (e.public IN e.TypeOfMem (y.ADR (tmpport.msgList))) THEN
  198.         newtask := tmpport.sigTask;
  199.       END;  
  200.     END;  
  201.     e.Enable();
  202.     IF newtask # IncTask THEN 
  203.       y.SETREG (0, SecureSetTaskPri (IncTask, OldPri));
  204.       IncTask := newtask;
  205.       OldPri := SecureSetTaskPri (IncTask, incPri);
  206.       IF OldPri = invalidPri THEN IncTask := NIL; END;
  207.     END;
  208.   ELSE
  209.     y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
  210.   END;
  211.   I.UnlockIBase (lk);
  212. END ChangePri;
  213.  
  214.  
  215. PROCEDURE Server ();
  216. VAR
  217.   flgs: LONGSET;
  218.   msg : e.APTR;
  219.   msgtype: LONGSET;
  220.   msgid  : LONGINT;
  221. BEGIN  
  222.   LOOP
  223.     flgs := e.Wait (LONGSET {d.ctrlC, nb.port.sigBit, fakenb.port.sigBit, 
  224.                              vblanksig-1});
  225.     IF vblanksig-1 IN flgs THEN
  226.       ChangePri();
  227.     END;    
  228.     IF nb.port.sigBit IN flgs THEN
  229.       LOOP
  230.         msg := e.GetMsg (nb.port);
  231.         IF msg = NIL THEN EXIT; END;
  232.         msgtype := co.CxMsgType (msg);
  233.         msgid := co.CxMsgID (msg);
  234.         e.ReplyMsg (msg);
  235.         IF msgtype = LONGSET {co.cxmCommand} THEN
  236.           CASE msgid OF
  237.           co.cmdKill:
  238.             HALT (0); |
  239.           co.cmdEnable:
  240.             ActivateBroker (true); 
  241.             win := NIL; (* this is an atomic operation! *) |
  242.           co.cmdDisable:
  243.             ActivateBroker (false); 
  244.             y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
  245.           ELSE END;  
  246.         END;
  247.       END; (* LOOP *)
  248.     END;
  249.     IF fakenb.port.sigBit IN flgs THEN
  250.       LOOP
  251.         msg := e.GetMsg (fakenb.port);
  252.         IF msg = NIL THEN EXIT; END;
  253.         e.ReplyMsg (msg);
  254.         IF co.ActivateCxObj (fakebr, e.false) = e.false THEN END;
  255.       END;  
  256.     END;  
  257.     IF d.ctrlC IN flgs THEN HALT (5); END;
  258.   END;
  259. END Server;
  260.  
  261.  
  262. BEGIN
  263.   Init();
  264.  
  265.   Server();
  266.  
  267. CLOSE
  268.   CleanUp();
  269.  
  270. END SteamyWindows.
  271.  
  272.