home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / cdity / hotscreen / screenshuffle.mod < prev    next >
Text File  |  1994-03-24  |  4KB  |  180 lines
  1. MODULE ScreenShuffle;
  2.  
  3. (*
  4.  
  5.    KeyPatch 1.0    (13.10.1993)
  6.  
  7.    by Carsten Orthbandt
  8.  
  9.    Compiler: Amiga Oberon 3.0
  10.  
  11. *)
  12.  
  13.  
  14.  
  15.  
  16. IMPORT e:Exec,
  17.        SelectScreen,
  18.        es:ExecSupport,
  19.        cx:Commodities,
  20.        conv:Conversions,
  21.        y:SYSTEM,
  22.        str:Strings,
  23.        d:Dos,
  24.        wb:Workbench,
  25.        ol:OberonLib,
  26.        I: Intuition,
  27.        ie:InputEvent,
  28.        u: Utility,
  29.        ic:Icon;
  30.  
  31. TYPE   MyStr=ARRAY 254 OF CHAR;
  32.  
  33. VAR
  34.      PopKey:ARRAY 100 OF CHAR;
  35.      MyBrk :cx.CxObjPtr;
  36.      MyFil :cx.CxObjPtr;
  37.      MySnd :cx.CxObjPtr;
  38.      MyTrs :cx.CxObjPtr;
  39.      NwBrk :cx.NewBroker;
  40.      MsPrt :e.MsgPortPtr;
  41.      Quit  :BOOLEAN;
  42.      Shut  :BOOLEAN;
  43.      Err   :LONGINT;
  44.      eMsg  :e.APTR;
  45.      Msg   :cx.CxMsgPtr;
  46.      MsTp  :LONGSET;
  47.      MsId  :LONGINT;
  48.      CxPri :LONGINT;
  49.      CxKey :ARRAY 254 OF CHAR;
  50.      strn:MyStr;
  51.      Signal:LONGSET;
  52.  
  53. PROCEDURE GetToolTypes;
  54. VAR This:d.ProcessPtr;
  55.     wbm:wb.WBStartupPtr;
  56.     sptr:e.STRPTR;
  57.     MyIcon:wb.DiskObjectPtr;
  58.     OCurrentDir:d.FileLockPtr;
  59. BEGIN;
  60. This:=y.VAL(d.ProcessPtr,ol.Me);
  61. CxPri:=0;CxKey:="alt control s";
  62. IF ol.wbStarted THEN
  63.  wbm:=ol.wbenchMsg;
  64.  OCurrentDir:=This.currentDir;
  65.  y.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
  66.  MyIcon := ic.GetDiskObject(wbm.argList[0].name^);
  67.  y.SETREG(0,d.CurrentDir(OCurrentDir));
  68.  IF MyIcon#NIL THEN
  69.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_PRIORITY");
  70.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,CxPri) THEN END;END;
  71.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPKEY");
  72.   IF sptr#NIL THEN COPY(sptr^,CxKey);END;
  73.   ic.FreeDiskObject(MyIcon);
  74.  END;
  75. END;
  76. END GetToolTypes;
  77.  
  78. PROCEDURE Disable;
  79. BEGIN;
  80. IF cx.ActivateCxObj(MyBrk,0)#0 THEN END;
  81. END Disable;
  82.  
  83. PROCEDURE Enable;
  84. BEGIN;
  85. IF cx.ActivateCxObj(MyBrk,1)#0 THEN END;
  86. END Enable;
  87.  
  88. PROCEDURE Init():BOOLEAN;
  89. VAR ret:BOOLEAN;
  90. BEGIN;
  91. ret:=TRUE;
  92. Shut:=FALSE;
  93. IF ret THEN
  94. MsPrt:=e.CreateMsgPort();
  95. IF MsPrt=NIL THEN ret:=FALSE;END;
  96. IF ret THEN
  97. NwBrk.version:=cx.nbVersion;
  98. NwBrk.name:=y.ADR("HotScreen");
  99. NwBrk.title:=y.ADR("HotScreen 1.0 by HDS");
  100. NwBrk.descr:=y.ADR("Screen list by shortcut");
  101. NwBrk.unique:=SET{0,1};
  102. NwBrk.flags:=SET{};
  103. NwBrk.pri:=SHORT(SHORT(CxPri));
  104. NwBrk.port:=MsPrt;
  105. NwBrk.reservedChannel:=0;
  106. MyBrk:=cx.CxBroker(NwBrk,Err);
  107. IF Err#0 THEN ret:=FALSE;END;
  108. IF ret THEN
  109. MyFil:=cx.CxFilter(y.ADR(CxKey));
  110. MySnd:=cx.CxSender(MsPrt,cx.cxmIEvent);
  111. MyTrs:=cx.CxTranslate(NIL);
  112. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  113. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  114. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  115. cx.AttachCxObj(MyBrk,MyFil);
  116. cx.AttachCxObj(MyFil,MySnd);
  117. cx.AttachCxObj(MyFil,MyTrs);
  118. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  119. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  120. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  121. IF cx.ActivateCxObj(MyBrk,1)#0 THEN ret:=FALSE;END;
  122. IF MyFil=NIL THEN ret:=FALSE;END;
  123. IF MySnd=NIL THEN ret:=FALSE;END;
  124. IF MyTrs=NIL THEN ret:=FALSE;END;
  125. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  126. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  127. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  128. END;END;END;
  129. RETURN (ret);
  130. END Init;
  131.  
  132. PROCEDURE ShutDown;
  133. BEGIN;
  134. IF MyBrk#NIL THEN cx.DeleteCxObjAll(MyBrk);
  135. REPEAT;UNTIL e.GetMsg(MsPrt)=NIL;END;
  136. IF MsPrt#NIL THEN
  137. e.DeleteMsgPort(MsPrt);END;
  138. END ShutDown;
  139.  
  140. PROCEDURE CheckCx;
  141. VAR wnp:I.WindowPtr;
  142.     scr:I.ScreenPtr;
  143.     nwn:I.NewWindow;
  144. BEGIN;
  145. IF MsPrt#NIL THEN
  146. REPEAT;
  147. eMsg:=e.GetMsg(MsPrt);
  148. IF eMsg#NIL THEN
  149. Msg:=y.VAL(cx.CxMsgPtr,eMsg);
  150. MsTp:=cx.CxMsgType(Msg);
  151. MsId:=cx.CxMsgID(Msg);
  152. e.ReplyMsg(eMsg);
  153.  IF MsTp=LONGSET{cx.cxmIEvent} THEN
  154.  SelectScreen.DoIt;
  155.  END;
  156.  IF MsTp=LONGSET{cx.cxmCommand} THEN
  157.   IF MsId=cx.cmdDisable THEN Disable;END;
  158.   IF MsId=cx.cmdEnable THEN Enable;END;
  159.   IF MsId=cx.cmdKill THEN Quit:=TRUE;END;
  160.   IF MsId=cx.cmdUnique THEN Quit:=TRUE;END;
  161.  END;
  162. END;
  163. UNTIL eMsg=NIL;
  164. END;
  165. END CheckCx;
  166.  
  167. BEGIN;
  168. GetToolTypes;
  169. IF Init() THEN
  170. Enable;
  171. CheckCx;
  172. REPEAT;
  173. e.WaitPort(MsPrt);
  174. CheckCx;
  175. UNTIL Quit;
  176. END;
  177. ShutDown;
  178. END ScreenShuffle.
  179.  
  180.