home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 2
/
FFMCD02.bin
/
new
/
amigalibdisks
/
disk938
/
angie
/
angie.mod
< prev
next >
Wrap
Text File
|
1993-12-21
|
104KB
|
3,344 lines
(* --------------------------------------------------------------------------
:Program. Angie.mod
:Contents. "ANGIE - ANother Great Intuition Enhancer" - commodity
:Author. Franz Schwarz
:Copyright. Giftware (Freely distributable, yet copyrighted software.
:Copyright. If you like this magnificent;-) piece of software, you
:Copyright. are encouraged to send the author a present, a nice
:Copyright. postcard, money, or something else pleasing the author.)
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:History. v1.0 20.10.93 [fSchwarz]
:History. v1.1 22.10.93 [fSchwarz] improved setDefPubScreen action
:History. fixed ActivateXXXXScreen, fixed Menu Attrs selection
:History. v1.2 23.10.93 [fSchwarz] doesn't send any closeWindow
:History. event on Close action when window is blocked by
:History. requesters.
:History. v1.3 24.10.93 [fSchwarz] added Edithook for hotkey
:History. definition gadget
:History. v1.4a 29.10.93 [fSchwarz] major code cleanup, now
:History. supports dos command and inputevent insertion type
:History. v1.5 4.11.93 [fSchwarz] now really uses the frontmost
:History. window of screens instead of just screen.firstWindow;
:History. improved Key Screen Activation handling for screens
:History. without windows
:History. v1.6 4.11.93 [fSchwarz] removed last Intuition stuff from
:History. cxcustom inputhandler - now all accesses to Intuition
:History. structures are safeguarded by official CBM protocols;
:History. enhanced Intuition/GadTools V37 GUI
:Imports. CxLib 1.0b, BlackMagic 1.13
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz_Schwarz@mil.ka.sub.org - Fido: 2:2476/506.18
:Remark. Requires OS3.0 interface modules update by hartmut Goebel
:Remark. Amiga-Oberon 3.00 checks string pointers to be even if
:Remark. OddChk is enabled; thus don't compile with OddChk. The
:Remark. compiler's options stack is broken as of Amiga-Oberon 3.00
:Usage. Angie [args] (see doc / icon for help)
-------------------------------------------------------------------------- *)
(* $SET NODEBUG *)
MODULE Angie;
IMPORT
b: BlackMagic, co: Commodities, cx: CxLib, ie: InputEvent,
e: Exec, I: Intuition, ti: Timer, H: Hardware, g: Graphics,
l: Layers, d: Dos, ic: Icon, o: OberonLib, st: Strings, u: Utility,
gt: GadTools, ag: AngieGUI, y: SYSTEM, es: ExecSupport, wb: Workbench,
sp: SPrintf
(* $IF DEBUG *) , io, NoGuru (* $END *) ;
CONST
verTag = "\000$VER: Angie 1.6 (4.11.93) © Franz Schwarz - Giftware";
CONST
true = TRUE; false = FALSE; (* adapt to common lower case CONST style *)
CONST
strGadLen = 256; (* size shrunk since I'm tired of e.STRPTR-related problems *)
(* ** Interface module bug fixes: ** *)
VAR
coBase: e.LibraryPtr;
(* CxBroker err parameter register mismatch in Commodities.mod! *)
PROCEDURE CxBroker {coBase, -36} (VAR nb{8}: co.NewBroker;
err{0} : UNTRACED POINTER TO LONGINT): co.CxObjPtr;
CONST
sposMakeVisible = 1; (* misdefinition in Intuition.mod *)
unique = 0; (* misdefinition in Commodities.mod *)
notify = 1; (* misdefinition in Commodities.mod *)
CONST
cnb = co.NewBroker (co.nbVersion, y.ADR ("Angie"), y.ADR (verTag[7]),
y.ADR ("ANother Great Intuition Enhancer"),
{unique, notify}, {co.showHide}, 0, NIL, 0);
frontAttrStr = "WFront";
frontAttrConst = 256;
noKeyScrActAttrStr = "NoKeyScrAct";
noKeyScrActAttrConst = 512;
repeatAttrStr = "Repeatable";
repeatAttrConst = 1024;
cxPopUpStr = "CX_POPUP";
cxPriorityStr = "CX_PRIORITY";
keyActivateStr = "KEYACTIVATE";
shuffleBackdropStr = "SHUFFLEBACKDROP";
shufflePatStr = "SHUFFLEPAT";
defaultShufflePat = "#?";
huntAlwaysStr = "HUNTMODEALWAYS";
huntWinToFrontStr = "HUNTMODEWFRONT";
huntSetDefPubModeStr = "HUNTMODESETDEFPUBSCR";
stableTimeStr = "STABLETIME";
snoopDelayStr = "SNOOPDELAY";
incWinTaskPriStr = "RAISEWINTASKPRI";
scrMoveStepsStr = "SCRMOVESTEPS";
winMoveStepsStr = "WINMOVESTEPS";
doNotWaitStr = "DONOTWAIT";
TYPE
MiscTTNamesArr = ARRAY 14 OF b.LStrPtr;
CONST
miscTTNames = MiscTTNamesArr (y.ADR (cxPopUpStr),
y.ADR (cxPriorityStr),
y.ADR (keyActivateStr),
y.ADR (shuffleBackdropStr),
y.ADR (shufflePatStr),
y.ADR (huntAlwaysStr),
y.ADR (huntWinToFrontStr),
y.ADR (huntSetDefPubModeStr),
y.ADR (stableTimeStr),
y.ADR (snoopDelayStr),
y.ADR (incWinTaskPriStr),
y.ADR (scrMoveStepsStr),
y.ADR (winMoveStepsStr),
y.ADR (doNotWaitStr));
popGUI = 0;
popGUINam = "CX_POPKEY";
huntWindow = 1;
huntWindowNam = "HuntWindow";
activate = 2;
activateNam = "Activate";
activateNext = 3;
activateNextNam = "ActivateNext";
activatePrev = 4;
activatePrevNam = "ActivatePrev";
activateBackDrop = 5;
activateBackDropNam = "ActivateBackDrop";
activateFrontScr = 6;
activateFrontScrNam = "ActivateFrontScr";
lastActive = 7;
lastActiveNam = "LastActive";
lastActiveScr = 8;
lastActiveScrNam = "LastActiveScr";
activeToFront = 9;
activeToFrontNam = "ToFront";
activeToBack = 10;
activeToBackNam = "ToBack";
adaptWindow = 11;
adaptWindowNam = "AdaptWindow";
centerWin = 12;
centerWinNam = "Center";
zipWin = 13;
zipWinNam = "Zip";
closeWin = 14;
closeWinNam = "Close";
maxWin = 15;
maxWinNam = "Max";
maxWinWidth = 16;
maxWinWidthNam = "MaxWidth";
maxWinHeight = 17;
maxWinHeightNam = "MaxHeight";
minWin = 18;
minWinNam = "Min";
moveWinLeft = 19;
moveWinLeftNam = "MoveLeft";
moveWinRight = 20;
moveWinRightNam = "MoveRight";
moveWinUp = 21;
moveWinUpNam = "MoveUp";
moveWinDown = 22;
moveWinDownNam = "MoveDown";
upperLeftWin = 23;
upperLeftWinNam = "UpperLeft";
lowerLeftWin = 24;
lowerLeftWinNam = "LowerLeft";
upperRightWin = 25;
upperRightWinNam = "UpperRight";
lowerRightWin = 26;
lowerRightWinNam = "LowerRight";
expandWidth = 27;
expandWidthNam = "ExpandWidth";
expandHeight = 28;
expandHeightNam = "ExpandHeight";
shrinkWidth = 29;
shrinkWidthNam = "ShrinkWidth";
shrinkHeight = 30;
shrinkHeightNam = "ShrinkHeight";
doubleWidth = 31;
doubleWidthNam = "DoubleWidth";
doubleHeight = 32;
doubleHeightNam = "DoubleHeight";
halveWidth = 33;
halveWidthNam = "HalveWidth";
halveHeight = 34;
halveHeightNam = "HalveHeight";
activateNextScreen = 35;
activateNextScreenNam = "ActivateNextScreen";
activatePrevScreen = 36;
activatePrevScreenNam = "ActivatePrevScreen";
activateWBenchScreen = 37;
activateWBenchScreenNam = "ActivateWBenchScreen";
activateDefPubScreen = 38;
activateDefPubScreenNam = "ActivateDefPubScreen";
nextScreen = 39;
nextScreenNam = "NextScreen";
prevScreen = 40;
prevScreenNam = "PrevScreen";
wbenchScreen = 41;
wbenchScreenNam = "WBenchScreen";
defPubScreen = 42;
defPubScreenNam = "DefPubScreen";
scrollScrLeft = 43;
scrollScrLeftNam = "ScrollScrLeft";
scrollScrRight = 44;
scrollScrRightNam = "ScrollScrRight";
scrollScrUp = 45;
scrollScrUpNam = "ScrollScrUp";
scrollScrDown = 46;
scrollScrDownNam = "ScrollScrDown";
upperLeftScr = 47;
upperLeftScrNam = "UpperLeftScr";
lowerLeftScr = 48;
lowerLeftScrNam = "LowerLeftScr";
upperRightScr = 49;
upperRightScrNam = "UpperRightScr";
lowerRightScr = 50;
lowerRightScrNam = "LowerRightScr";
showScrCenter = 51;
showScrCenterNam = "ShowScrCenter";
screenTop = 52;
screenTopNam = "ScreenTop";
setDefPubScreen = 53;
setDefPubScreenNam = "SetDefPubScreen";
filter = 54;
filterNam = "Filter";
noKeyActivate = 55;
noKeyActivateNam = "NoKeyActivate";
custom = 56;
customNam = "Custom";
hotKeys = 57;
huntZipped = hotKeys;
huntSigd = hotKeys+1;
scrActivateMagic = hotKeys+2;
sendHuntZipped = huntZipped + frontAttrConst;
sendHuntSigd = huntSigd + frontAttrConst;
TYPE
HotArr = ARRAY hotKeys+1 OF b.LStrPtr;
CONST
hotnames = HotArr (
y.ADR (popGUINam),
y.ADR (huntWindowNam),
y.ADR (activateNam),
y.ADR (activateNextNam),
y.ADR (activatePrevNam),
y.ADR (activateBackDropNam),
y.ADR (activateFrontScrNam),
y.ADR (lastActiveNam),
y.ADR (lastActiveScrNam),
y.ADR (activeToFrontNam),
y.ADR (activeToBackNam),
y.ADR (adaptWindowNam),
y.ADR (centerWinNam),
y.ADR (zipWinNam),
y.ADR (closeWinNam),
y.ADR (maxWinNam),
y.ADR (maxWinWidthNam),
y.ADR (maxWinHeightNam),
y.ADR (minWinNam),
y.ADR (moveWinLeftNam),
y.ADR (moveWinRightNam),
y.ADR (moveWinUpNam),
y.ADR (moveWinDownNam),
y.ADR (upperLeftWinNam),
y.ADR (lowerLeftWinNam),
y.ADR (upperRightWinNam),
y.ADR (lowerRightWinNam),
y.ADR (expandWidthNam),
y.ADR (expandHeightNam),
y.ADR (shrinkWidthNam),
y.ADR (shrinkHeightNam),
y.ADR (doubleWidthNam),
y.ADR (doubleHeightNam),
y.ADR (halveWidthNam),
y.ADR (halveHeightNam),
y.ADR (activateNextScreenNam),
y.ADR (activatePrevScreenNam),
y.ADR (activateWBenchScreenNam),
y.ADR (activateDefPubScreenNam),
y.ADR (nextScreenNam),
y.ADR (prevScreenNam),
y.ADR (wbenchScreenNam),
y.ADR (defPubScreenNam),
y.ADR (scrollScrLeftNam),
y.ADR (scrollScrRightNam),
y.ADR (scrollScrUpNam),
y.ADR (scrollScrDownNam),
y.ADR (upperLeftScrNam),
y.ADR (lowerLeftScrNam),
y.ADR (upperRightScrNam),
y.ADR (lowerRightScrNam),
y.ADR (showScrCenterNam),
y.ADR (screenTopNam),
y.ADR (setDefPubScreenNam),
y.ADR (filterNam),
y.ADR (noKeyActivateNam),
y.ADR (customNam),
NIL
);
CONST
close1 = ie.InputEventAdr (NIL, ie.closewindow, 0, 0, {}, NIL, 0, 0);
VAR
Close1: ie.InputEventAdr;
VAR
ScrKeys, ScrKeys1, ScrKeys2: UNTRACED POINTER TO ARRAY OF co.IX;
DummyIX: co.IX;
VAR
cx38 : BOOLEAN;
int39 : BOOLEAN;
active : BOOLEAN;
nb : co.NewBroker;
br, cxcustom : co.CxObjPtr;
cxcustomfilter : co.CxObjPtr;
huntwindowalways : BOOLEAN;
huntwindowwfr : BOOLEAN;
setdefpubonhunt : BOOLEAN;
keyactivate : BOOLEAN;
shufflebackdrop : BOOLEAN;
incwintaskpri : BOOLEAN;
shuffle : b.DynStrPtr;
shufflestr : b.DynStrPtr;
stabletime : LONGINT;
snoopdelay : LONGINT;
scrMoveSteps : INTEGER;
winMoveSteps : INTEGER;
cxpopup : BOOLEAN;
hotdeflist : e.List;
TYPE
WinScr = STRUCT
scr : I.ScreenPtr;
win : I.WindowPtr;
END;
VAR
ScrArr : ARRAY 40 OF WinScr;
lastwin : WinScr;
lastscrwin : WinScr;
zipwin : WinScr;
CONST
nilWinScr = WinScr (NIL, NIL);
TYPE
DispInfo = STRUCT
activeScr: I.ScreenPtr;
activeWin: WinScr;
winBox : I.IBox;
time : ti.TimeVal;
END;
VAR
dinfopass : DispInfo;
dinfotask : DispInfo;
dinfochange : BOOLEAN;
dinfosig : INTEGER;
chieftask : e.TaskPtr;
IncTask : e.TaskPtr;
chiefpri : SHORTINT;
retpri : SHORTINT;
tval1, tval2 : ti.TimeVal;
stabletval : ti.TimeVal;
CONST
init = 1; (* ChildTask states *)
ok = 2;
requestDie = 3;
died = 4;
yetUnlaunched = 0;
VAR
ChildState : SHORTINT;
ChildStack : ARRAY 1001 OF LONGINT;
tcb : e.Task;
CONST
ctcbnd = e.Node (NIL, NIL, e.task, 9, y.ADR ("Angie Snoop"));
(*
* $StackChk-
* !!No stack checking in cxcustom & child task accessable code, please!!
*)
PROCEDURE IsValidScr (scr: I.ScreenPtr): BOOLEAN;
VAR
si: I.ScreenPtr;
BEGIN
si := I.int.firstScreen;
WHILE (si # NIL) & (si # scr) DO si := si.nextScreen; END;
RETURN si # NIL;
END IsValidScr;
PROCEDURE IsValidWinScr (VAR sa: WinScr): BOOLEAN;
VAR
wi: I.WindowPtr;
BEGIN
IF ~IsValidScr (sa.scr) THEN RETURN false; END;
wi := sa.scr.firstWindow;
WHILE (wi # NIL) & (wi # sa.win) DO wi := wi.nextWindow; END;
RETURN wi # NIL;
END IsValidWinScr;
PROCEDURE ValidateScrArr ();
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO LEN (ScrArr)-1 DO
IF ~IsValidWinScr (ScrArr[i]) THEN
e.Disable();
ScrArr[i] := nilWinScr;
e.Enable();
END;
END;
END ValidateScrArr;
PROCEDURE UpdateScrArr (VAR sa: WinScr);
VAR
i, j : INTEGER;
BEGIN
IF (sa.win = NIL) OR (sa.scr = NIL) THEN RETURN; END;
FOR i := 0 TO LEN (ScrArr)-1 DO
IF sa.scr = ScrArr[i].scr THEN
e.Disable(); ScrArr[i].win := sa.win; e.Enable();
RETURN;
END;
END;
FOR j := 0 TO 1 DO
FOR i := 0 TO LEN (ScrArr)-1 DO
IF ScrArr[i].scr = NIL THEN
e.Disable();
ScrArr[i].scr := sa.scr;
ScrArr[i].win := sa.win;
e.Enable();
RETURN;
END;
END; (* FOR i *)
ValidateScrArr();
END; (* FOR j *)
e.Disable();
ScrArr[LEN (ScrArr) DIV 2].scr := sa.scr;
ScrArr[LEN (ScrArr) DIV 2].win := sa.win;
e.Enable();
END UpdateScrArr;
PROCEDURE ScrFrontWin (scr: I.ScreenPtr): I.WindowPtr;
VAR
ly: g.LayerPtr;
w : I.WindowPtr;
BEGIN
w := NIL;
IF scr = NIL THEN RETURN NIL; END;
l.LockLayerInfo (y.ADR (scr.layerInfo));
ly := scr.layerInfo.topLayer;
LOOP
IF ly = NIL THEN EXIT; END;
IF ly # scr.barLayer THEN w := ly.window; END;
IF w # NIL THEN EXIT; END;
ly := ly.back;
END;
IF w = NIL THEN w := scr.firstWindow; END;
l.UnlockLayerInfo (scr.layerInfo);
RETURN w;
END ScrFrontWin;
CONST
exactWin = 0;
multiScrWin = 1;
PROCEDURE MouseWin (mode: INTEGER): I.WindowPtr;
VAR
ly : g.LayerPtr;
scr: I.ScreenPtr;
lsc: I.ScreenPtr;
w : I.WindowPtr;
BEGIN
CASE mode OF exactWin, multiScrWin: ELSE RETURN NIL; END;
scr := I.int.firstScreen; lsc := NIL;
LOOP
IF mode = multiScrWin THEN
WHILE (scr # NIL) & (scr.firstWindow = NIL) DO scr := scr.nextScreen; END;
END;
IF scr = NIL THEN
IF mode = exactWin THEN RETURN NIL; END;
RETURN ScrFrontWin (lsc);
END;
IF g.vpHide IN scr.viewPort.modes THEN
IF mode = exactWin THEN RETURN NIL; END;
RETURN ScrFrontWin (lsc);
END;
IF scr.mouseY >=0 THEN
ly := l.WhichLayer (y.ADR (scr.layerInfo), scr.mouseX, scr.mouseY);
IF ly # NIL THEN
IF ly # scr.barLayer THEN
w := ly.window;
IF w # NIL THEN RETURN w; END;
END;
END;
IF mode = exactWin THEN RETURN NIL; END;
RETURN ScrFrontWin (scr);
END;
lsc := scr; scr := scr.nextScreen;
END;
END MouseWin;
PROCEDURE GetScrWin (s: I.ScreenPtr): I.WindowPtr;
VAR
i: INTEGER;
w: I.WindowPtr;
BEGIN
FOR i := 0 TO LEN (ScrArr)-1 DO
IF ScrArr[i].scr = s THEN
IF IsValidWinScr (ScrArr[i]) THEN
w := ScrArr[i].win;
RETURN w;
END;
END;
END; (* FOR *)
RETURN NIL;
END GetScrWin;
PROCEDURE GetBestWin (): I.WindowPtr;
VAR
w1,w2: I.WindowPtr;
s: I.ScreenPtr;
BEGIN
w1 := MouseWin (multiScrWin);
IF w1 # NIL THEN s := w1.wScreen; ELSE s := I.int.firstScreen; END;
w2 := GetScrWin (s);
IF w2 # NIL THEN RETURN w2; END;
IF w1 # NIL THEN RETURN w1; END;
RETURN ScrFrontWin (s);
END GetBestWin;
VAR
qual : SET;
lmbstate: SET;
CONST
lmbPressed = 0;
lmbEmulated = 1;
lmbEffective = 2;
PROCEDURE CxCustomHandler * (obj: co.CxObjPtr; msg: co.CxMsgPtr);
VAR
ev : ie.InputEventPtr;
w : I.WindowPtr;
s : I.ScreenPtr;
i : LONGINT;
(* $DeallocPars- $SaveRegs+ *)
BEGIN
ev := co.CxMsgData (msg);
IF qual # ev.qualifier THEN
qual := ev.qualifier;
IF (lmbPressed IN lmbstate) & ~(ie.leftButton IN qual) THEN
lmbstate := lmbstate - {lmbPressed, lmbEffective};
ELSIF ~(lmbPressed IN lmbstate) & (ie.leftButton IN qual) THEN
lmbstate := lmbstate + {lmbPressed, lmbEffective};
END;
IF (lmbEmulated IN lmbstate) & ~(ie.lAlt IN qual) THEN
lmbstate := lmbstate - {lmbEmulated, lmbEffective};
ELSIF ~(lmbEmulated IN lmbstate) & (ie.lAlt IN qual) &
({ie.lCommand, ie.rCommand} * qual # {}) THEN
lmbstate := lmbstate + {lmbEmulated, lmbEffective};
END;
END;
IF ~keyactivate OR ~active THEN RETURN; END;
IF ev.class # ie.rawkey THEN RETURN; END;
IF ev.code >= ie.upPrefix THEN RETURN; END;
IF cx38 THEN (* MatchIX() available: *)
IF ScrKeys # NIL THEN
FOR i := 0 TO LEN (ScrKeys^)-1 DO
IF co.MatchIX (ev, y.ADR (ScrKeys[i])) THEN RETURN; END;
END;
END;
END;
w := I.int.activeWindow;
IF (y.VAL (LONGSET, w) * LONGSET {0, 31} = LONGSET {}) &
(w # NIL) & (I.menuState IN w.flags) THEN RETURN; END;
s := I.int.activeScreen;
IF (s = NIL) OR (y.VAL (LONGSET, s) * LONGSET {0, 31} # LONGSET {}) OR
~(g.vpHide IN s.viewPort.modes) THEN RETURN; END;
co.DivertCxMsg (msg, cxcustomfilter, cxcustom);
END CxCustomHandler;
(* $IF SmallData *)
TYPE
CustomCxStubT = STRUCT
code1 : ARRAY 2 OF INTEGER;
a5 : e.APTR;
code2 : ARRAY 6 OF INTEGER;
jsr : co.CustomProcType;
code3 : ARRAY 3 OF INTEGER;
END;
CONST
customCxStub = CustomCxStubT (02F0DU, 02A7CU, NIL, 04CEFU, 00003U, 00008U,
048E7U, 0C000U, 04EB9U, CxCustomHandler,
0508FU, 02A5FU, 04E75U);
VAR
CustomCxStub: CustomCxStubT;
(* $END *)
CONST
nilTVal = ti.TimeVal (0, 0);
PROCEDURE SetStableTime (n: LONGINT);
BEGIN
e.Forbid ();
stabletime := b.Max2 (-1, b.Min2 (1000, n));
IF stabletime >= 0 THEN
stabletval.secs := stabletime DIV 1000;
stabletval.micro := (stabletime MOD 1000) * 1000;
ELSE
stabletval := nilTVal;
END;
e.Permit ();
END SetStableTime;
VAR
snooptval : ti.TimeVal;
PROCEDURE SetSnoopDelay (n: LONGINT);
BEGIN
snoopdelay := b.Max2 (10, b.Min2 (1000, n));
e.Forbid();
snooptval.secs := snoopdelay DIV 1000;
snooptval.micro := (snoopdelay MOD 1000) * 1000;
e.Permit();
END SetSnoopDelay;
(*
* CHILDTASK LOCAL VARS - global due to access efficiency considerations
* from within IBaseChanged():
*)
VAR
childtimerport : e.MsgPortPtr;
childtio : ti.TimeRequestPtr;
dinfoold, dinfonew : DispInfo;
PROCEDURE ChildTask * ();
PROCEDURE Init(): BOOLEAN;
BEGIN
LOOP
childtimerport := e.CreateMsgPort ();
childtio := e.CreateIORequest (childtimerport, SIZE (childtio^));
IF childtio = NIL THEN EXIT; END;
IF e.OpenDevice (ti.timerName, ti.vBlank, childtio, LONGSET{}) # 0 THEN EXIT; END;
ti.base := childtio.node.device;
childtio.node.command := ti.addRequest;
ChildState := ok;
EXIT;
END;
e.Signal (chieftask, LONGSET {dinfosig});
RETURN ChildState = ok;
END Init;
PROCEDURE CleanUp();
BEGIN
IF childtio # NIL THEN e.CloseDevice (childtio); END;
e.DeleteIORequest (childtio);
e.DeleteMsgPort (childtimerport);
e.Forbid();
ChildState := died;
e.Signal (chieftask, LONGSET {dinfosig});
END CleanUp;
PROCEDURE IBaseChanged (): BOOLEAN;
VAR
lk : LONGINT;
r : BOOLEAN;
BEGIN
r := false;
lk := I.LockIBase (0);
LOOP
IF stabletime < 0 THEN dinfochange := false; END;
dinfoold := dinfonew;
dinfonew.activeWin := nilWinScr;
e.Disable();
dinfonew.activeScr := I.int.activeScreen;
dinfonew.activeWin.win := I.int.activeWindow;
IF dinfonew.activeWin.win # NIL THEN
dinfonew.activeWin.scr := dinfonew.activeWin.win.wScreen;
END;
e.Enable();
IF (dinfonew.activeWin.scr # dinfonew.activeScr) OR (dinfonew.activeScr = NIL) THEN
dinfonew.activeWin := nilWinScr;
END;
IF dinfonew.activeWin.win # NIL THEN
dinfonew.activeWin.scr := dinfonew.activeWin.win.wScreen;
dinfonew.winBox := y.VAL (I.IBoxPtr, y.ADR (dinfonew.activeWin.win.leftEdge))^;
IF dinfoold.activeWin.win # dinfonew.activeWin.win THEN
IF dinfoold.activeWin.win # NIL THEN
lastwin := dinfoold.activeWin;
IF dinfoold.activeWin.scr # dinfonew.activeWin.scr THEN
lastscrwin := dinfoold.activeWin;
END;
END;
UpdateScrArr(dinfonew.activeWin);
ELSIF ~huntwindowalways & ~incwintaskpri & (IncTask = NIL) THEN
EXIT;
ELSE
IF dinfoold.activeScr = dinfonew.activeScr THEN
IF dinfoold.winBox.left = dinfonew.winBox.left THEN
IF dinfoold.winBox.top = dinfonew.winBox.top THEN
IF dinfoold.winBox.width = dinfonew.winBox.width THEN
IF dinfoold.winBox.height = dinfonew.winBox.height THEN
IF dinfoold.time.secs = dinfonew.time.secs THEN
IF dinfoold.time.micro = dinfonew.time.micro THEN
IF dinfochange & ~(lmbEffective IN lmbstate) THEN
ti.GetSysTime (tval1);
e.Forbid(); tval2 := stabletval; e.Permit();
ti.AddTime (tval2, dinfonew.time);
IF ti.CmpTime (tval2, tval1) >= 0 THEN
dinfopass := dinfonew;
dinfochange := false;
r := true;
END;
END;
EXIT;
END;
END;
END;
END;
END;
END;
END;
END;
END;
ti.GetSysTime (dinfonew.time);
IF stabletime < 0 THEN
IF lmbEffective IN lmbstate THEN
dinfonew.activeWin := nilWinScr;
ELSE
dinfopass := dinfonew; r := true;
END;
ELSE
dinfochange := true;
END;
EXIT;
END; (* LOOP *)
I.UnlockIBase (lk);
IF ~huntwindowalways & ~incwintaskpri & (IncTask = NIL) THEN r := false; END;
RETURN r
END IBaseChanged;
BEGIN
(* $IF SmallData *)
y.SETREG (13, e.exec.thisTask.userData);
(* $END *)
IF ~Init() THEN CleanUp(); RETURN; END;
LOOP
IF IBaseChanged() THEN e.Signal (chieftask, LONGSET {dinfosig}); END;
e.Forbid(); childtio.time := snooptval; e.Permit();
e.OldDoIO (childtio);
IF ChildState = requestDie THEN EXIT; END;
END;
CleanUp();
END ChildTask;
(* $StackChk= !!end of code that is accessable from cxcustom or child task!! *)
PROCEDURE BoolToLBool (bool: BOOLEAN): I.LONGBOOL;
BEGIN
IF bool THEN RETURN I.LTRUE; ELSE RETURN I.LFALSE; END;
END BoolToLBool;
VAR
guiwndsig: INTEGER;
VAR
hotdefs: b.DynTTPtr;
SelectedHotKey: LONGINT;
TYPE
HotKeyNodePtr = UNTRACED POINTER TO HotKeyNode;
HotKeyNode = STRUCT (node: e.Node)
cxobj: co.CxObjPtr;
type : LONGINT;
text : b.DynStrPtr;
def : b.DynStrPtr;
END;
PROCEDURE AttrsOfId (id: LONGINT): LONGINT;
BEGIN
RETURN y.VAL (LONGINT, y.VAL (LONGSET, id) * LONGSET {8..10});
END AttrsOfId;
PROCEDURE PlainId (id: LONGINT): LONGINT;
BEGIN
RETURN y.VAL (LONGINT, y.VAL (LONGSET, id) * LONGSET {0..7});
END PlainId;
PROCEDURE IsToFrontId (id: LONGINT): BOOLEAN;
BEGIN
CASE PlainId (id) OF
activeToFront, huntWindow, popGUI:
RETURN true; |
nextScreen, prevScreen, wbenchScreen, defPubScreen, scrollScrLeft,
scrollScrRight, scrollScrUp, scrollScrDown, upperLeftScr, lowerLeftScr,
upperRightScr, lowerRightScr, showScrCenter, activeToBack, setDefPubScreen,
screenTop, filter, noKeyActivate:
RETURN false;
ELSE
RETURN y.VAL (LONGSET, id) * y.VAL (LONGSET, frontAttrConst) # LONGSET {};
END;
END IsToFrontId;
PROCEDURE IsRepeatId (id: LONGINT): BOOLEAN;
BEGIN
CASE PlainId (id) OF
noKeyActivate, filter:
RETURN true;
ELSE
RETURN y.VAL (LONGSET, id) * y.VAL (LONGSET, repeatAttrConst) # LONGSET {};
END;
END IsRepeatId;
PROCEDURE IsNoKeyScrActId (id: LONGINT): BOOLEAN;
BEGIN
CASE PlainId (id) OF
noKeyActivate:
RETURN true;
ELSE
RETURN y.VAL (LONGSET, id) * y.VAL (LONGSET, noKeyScrActAttrConst) # LONGSET {};
END;
END IsNoKeyScrActId;
PROCEDURE IsValidId (id: LONGINT): BOOLEAN;
BEGIN
IF (PlainId (id) < 0) OR (PlainId (id) >= hotKeys) THEN RETURN false; END;
RETURN y.VAL (LONGSET, id) * LONGSET {11..15} = LONGSET {};
END IsValidId;
PROCEDURE AdaptIdToEntry (id: LONGINT; entry: LONGINT): LONGINT;
BEGIN
id := PlainId (id) + AttrsOfId (id);
IF PlainId (id) = custom THEN INC (id, ASH (entry, 16)); END;
RETURN id;
END AdaptIdToEntry;
PROCEDURE GetHotKeyNode (i: LONGINT): HotKeyNodePtr;
BEGIN
IF (i < 0) OR (i >= b.DynTTLen (hotdefs)) THEN RETURN NIL; END;
RETURN y.VAL (HotKeyNodePtr, hotdefs[i]);
END GetHotKeyNode;
TYPE
editnmenu1T = ARRAY 7 OF gt.NewMenu;
CONST
MNfrontattr = 2000H;
MNnokeyscractattr = 2001H;
MNrepeatattr = 2002H;
TYPE
AttrT = STRUCT
isProc : PROCEDURE (id: LONGINT): BOOLEAN;
menuId: e.APTR;
const : INTEGER;
name : b.LStrPtr;
END;
AttrArr = ARRAY 3 OF AttrT;
CONST
attrs = AttrArr (
IsToFrontId, MNfrontattr, frontAttrConst, y.ADR (frontAttrStr),
IsNoKeyScrActId, MNnokeyscractattr, noKeyScrActAttrConst, y.ADR (noKeyScrActAttrStr),
IsRepeatId, MNrepeatattr, repeatAttrConst, y.ADR (repeatAttrStr));
CONST
editnmenu1 = editnmenu1T (
gt.title, y.ADR ("Edit·Hotkey·Type"), NIL, {}, y.VAL (LONGSET, 0), -1,
gt.item, y.ADR ("Attributes"), NIL, {}, y.VAL (LONGSET, 0), -1,
gt.sub, y.ADR ("Window To Front?"), y.ADR ("1"), {I.checkIt,I.menuToggle}, y.VAL (LONGSET, 0), MNfrontattr,
gt.sub, y.ADR ("No Key Screen Activation?"), y.ADR ("2"), {I.checkIt,I.menuToggle}, y.VAL (LONGSET, 0), MNnokeyscractattr,
gt.sub, y.ADR ("Repeatable?"), y.ADR ("3"), {I.checkIt,I.menuToggle}, y.VAL (LONGSET, 0), MNrepeatattr,
gt.item, gt.barLabel, NIL, {}, LONGSET {}, -1,
gt.end, NIL, NIL, {}, LONGSET {}, -1);
VAR
editnewmenu: ARRAY hotKeys+6 OF gt.NewMenu;
editmenu: I.MenuPtr;
PROCEDURE SetupEditMenu(): INTEGER;
VAR
i: INTEGER;
BEGIN
IF editmenu = NIL THEN
FOR i := 0 TO 5 DO editnewmenu [i] := editnmenu1 [i]; END;
editnewmenu [LEN (editnewmenu)-1] := editnmenu1 [LEN (editnmenu1)-1];
FOR i := 0 TO hotKeys-1 DO
editnewmenu [i+6] := editnmenu1 [1];
editnewmenu [i+6].label := b.StrIndexA (hotnames[i]^, 0);
editnewmenu [i+6].userData := i;
END;
editmenu := gt.CreateMenus (editnewmenu, gt.mnFrontPen, 0, u.done);
END;
IF editmenu = NIL THEN RETURN 3 END;
I.ClearMenuStrip (ag.AngieWnd);
ag.AngieMenus.nextMenu := editmenu;
IF NOT gt.LayoutMenus (ag.AngieMenus, ag.VisualInfo,
gt.mnNewLookMenus, I.LTRUE, u.done) THEN RETURN 4 END;
IF ~ I.SetMenuStrip (ag.AngieWnd, ag.AngieMenus^) THEN RETURN 5 END;
RETURN 0;
END SetupEditMenu;
PROCEDURE GetMenuAttrs(): INTEGER;
VAR
result: INTEGER;
i : INTEGER;
item : I.MenuItemPtr;
BEGIN
result := 0;
FOR i := 0 TO LEN (attrs)-1 DO
item := b.gtItemAddr (ag.AngieMenus, attrs[i].menuId);
IF item # NIL THEN IF I.checked IN item.flags THEN
INC (result, attrs[i].const);
END; END;
END;
RETURN result;
END GetMenuAttrs;
PROCEDURE SetMenuAttrs (n: LONGINT);
VAR
i : INTEGER;
item : I.MenuItemPtr;
BEGIN
I.ClearMenuStrip (ag.AngieWnd);
FOR i := 0 TO LEN (attrs)-1 DO
item := b.gtItemAddr (ag.AngieMenus, attrs[i].menuId);
IF item # NIL THEN
IF attrs[i].isProc (n) THEN
INCL (item.flags, I.checked);
ELSE
EXCL (item.flags, I.checked);
END;
END;
END;
IF I.ResetMenuStrip (ag.AngieWnd, ag.AngieMenus^) THEN END;
END SetMenuAttrs;
PROCEDURE SuspendHotKeyDisplay();
BEGIN
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhotkeys]^, ag.AngieWnd, NIL,
gt.lvLabels, -1, u.done);
END SuspendHotKeyDisplay;
PROCEDURE^ ProperType (type: LONGINT): LONGINT;
CONST
fixType = 0; (* flag for UpdateHotKeyDisplay *)
PROCEDURE UpdateHotKeyDisplay (flags: SET);
VAR
l : LONGINT;
tg : LONGINT;
nd : HotKeyNodePtr;
ls : b.LStrPtr;
BEGIN
l := b.DynTTLen (hotdefs);
IF (SelectedHotKey < 0) & (l > 0) THEN SelectedHotKey := 0; END;
SelectedHotKey := b.Max2 (-1, b.Min2 (SelectedHotKey, l-1));
IF SelectedHotKey >= 0 THEN
IF int39 THEN tg := gt.lvMakeVisible; ELSE tg := gt.lvTop; END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhotkeys]^, ag.AngieWnd, NIL,
gt.lvLabels, y.ADR (hotdeflist), gt.lvSelected,
SelectedHotKey, tg, SelectedHotKey, u.done);
tg := I.LFALSE;
nd := GetHotKeyNode (SelectedHotKey);
IF fixType IN flags THEN
nd.type := AdaptIdToEntry (ProperType (nd.type), SelectedHotKey);
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDattrs]^, ag.AngieWnd, NIL,
gt.cyActive, ASH (AttrsOfId (nd.type), -8), u.done);
SetMenuAttrs (nd.type);
IF PlainId (nd.type) # custom THEN
ls := hotnames [PlainId (nd.type)];
ELSE
ls := y.ADR (nd.text[0]);
END;
ELSE
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhotkeys]^, ag.AngieWnd, NIL,
gt.lvLabels, y.ADR (hotdeflist), u.done);
tg := I.LTRUE;
ls := y.ADR ("");
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhotkeys]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDtype]^, ag.AngieWnd, NIL,
gt.stString, ls, I.gaDisabled, tg, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDattrs]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDdefinition]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDdel]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
tg := BoolToLBool (SelectedHotKey <= 0);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDup]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
tg := BoolToLBool (SelectedHotKey >= l-1);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDdown]^, ag.AngieWnd, NIL,
I.gaDisabled, tg, u.done);
I.ClearMenuStrip (ag.AngieWnd);
IF SelectedHotKey >= 0 THEN
INCL (editmenu.flags, I.menuEnabled);
ELSE
EXCL (editmenu.flags, I.menuEnabled);
END;
IF I.ResetMenuStrip (ag.AngieWnd, ag.AngieMenus^) THEN END;
END UpdateHotKeyDisplay;
PROCEDURE CloseGUI();
BEGIN
guiwndsig := d.ctrlC;
ag.CloseAngieWindow ();
gt.FreeMenus (editmenu); editmenu := NIL;
ag.CloseDownScreen ();
END CloseGUI;
PROCEDURE OpenGUI1(): BOOLEAN;
VAR
pat: b.LStrPtr;
BEGIN
IF ag.AngieWnd # NIL THEN RETURN true; END;
ag.hotnames := y.ADR (hotnames);
IF ag.Scr = NIL THEN IF ag.SetupScreen ("") = 0 THEN
IF ag.OpenAngieWindow (true) = 0 THEN
IF SetupEditMenu() = 0 THEN
I.SetWindowTitles (ag.AngieWnd, nb.title, nb.title);
guiwndsig := ag.AngieWnd.userPort.sigBit;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDpri]^, ag.AngieWnd, NIL,
gt.slLevel, nb.pri, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDdelay]^, ag.AngieWnd, NIL,
gt.slLevel, snoopdelay, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDstable]^, ag.AngieWnd, NIL,
gt.slLevel, stabletime, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDpop]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (cxpopup), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDkeyact]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (keyactivate), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDincwintaskpri]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (incwintaskpri), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntalways]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (huntwindowalways), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntwintofront]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (huntwindowwfr), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDshufflebdrop]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (shufflebackdrop), u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDscrsteps]^, ag.AngieWnd, NIL,
gt.slLevel, scrMoveSteps, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDwinsteps]^, ag.AngieWnd, NIL,
gt.slLevel, winMoveSteps, u.done);
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntdefpub]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (setdefpubonhunt), u.done);
IF shufflestr # NIL THEN
pat := y.ADR (shufflestr[0]);
ELSE
pat := y.ADR ("#?");
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDshufflepat]^, ag.AngieWnd, NIL,
gt.stString, pat, u.done);
UpdateHotKeyDisplay ({fixType});
RETURN true;
END;
END;
END; END;
CloseGUI();
RETURN false;
END OpenGUI1;
PROCEDURE^ DoIntuiAction (actionid: LONGINT);
PROCEDURE OpenGUI (): BOOLEAN;
VAR
orighuntwindowwfr: BOOLEAN;
BEGIN
IF ~OpenGUI1() THEN RETURN false; END;
I.ScreenToFront (ag.AngieWnd.wScreen);
I.ActivateWindow (ag.AngieWnd);
IF I.int.activeWindow # ag.AngieWnd THEN d.Delay (10); END;
IF I.int.activeWindow = ag.AngieWnd THEN
orighuntwindowwfr := huntwindowwfr; huntwindowwfr := true;
DoIntuiAction (activeToFront + frontAttrConst);
huntwindowwfr := orighuntwindowwfr;
END;
RETURN true;
END OpenGUI;
PROCEDURE CreateCustom();
BEGIN
IF cxcustom = NIL THEN
(* $IF SmallData *)
CustomCxStub := customCxStub;
CustomCxStub.a5 := y.REG (13);
e.CacheClearU();
cxcustom := co.CxCustom (y.VAL (co.CustomProcType, y.ADR (CustomCxStub)), 0);
(* $ELSE *)
cxcustom := co.CxCustom (CxCustomHandler, 0);
(* $END *)
y.SETREG (0, co.SetCxObjPri (cxcustom, 1));
END;
co.RemoveCxObj (cxcustom);
IF br # NIL THEN co.EnqueueCxObj (br, cxcustom); END;
END CreateCustom;
PROCEDURE CreateCustomFilter();
BEGIN
IF cxcustomfilter = NIL THEN
cxcustomfilter := cx.HotKey ("diskinserted", nb.port, scrActivateMagic);
END;
END CreateCustomFilter;
PROCEDURE DeleteCxObjs();
VAR
i : LONGINT;
nd : HotKeyNodePtr;
BEGIN
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
co.DeleteCxObjAll (nd.cxobj); nd.cxobj := NIL;
END;
co.DeleteCxObjAll (cxcustom); cxcustom := NIL;
END DeleteCxObjs;
PROCEDURE ResetBroker();
VAR
i : LONGINT;
nd : HotKeyNodePtr;
BEGIN
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
co.RemoveCxObj (nd.cxobj);
END;
co.RemoveCxObj (cxcustom);
co.DeleteCxObj (br); br := NIL;
br := CxBroker (nb, NIL);
IF br # NIL THEN
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
IF nd.cxobj # NIL THEN co.EnqueueCxObj (br, nd.cxobj); END;
END;
co.EnqueueCxObj (br, cxcustom);
END;
END ResetBroker;
PROCEDURE ResetNoActScrKeys();
VAR
i,n : LONGINT;
nd : HotKeyNodePtr;
BEGIN
DISPOSE (ScrKeys1); n := 0;
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
IF PlainId (nd.type) = noKeyActivate THEN INC (n); END;
END;
IF n > 0 THEN
y.ALLOCATE (ScrKeys1, n);
IF ScrKeys1 # NIL THEN
n := 0;
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
IF PlainId (nd.type) = noKeyActivate THEN
IF co.ParseIX (nd.node.name^, ScrKeys1[n]) = 0 THEN END;
INC (n);
END;
END; (* FOR *)
END;
END;
ScrKeys2 := ScrKeys;
e.Disable(); ScrKeys := ScrKeys1; e.Enable();
DISPOSE (ScrKeys2); ScrKeys1 := NIL;
END ResetNoActScrKeys;
PROCEDURE UpdateHotKeyNodeTypes();
VAR
i : LONGINT;
nd: HotKeyNodePtr;
BEGIN
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
IF PlainId (nd.type) = custom THEN
nd.type := AdaptIdToEntry (nd.type, i);
IF nd.cxobj # NIL THEN
co.DeleteCxObjAll (nd.cxobj); nd.cxobj := NIL;
nd.cxobj := cx.HotKey (nd.node.name^, nb.port, nd.type);
IF IsNoKeyScrActId (nd.type) THEN
y.SETREG (0, co.SetCxObjPri (nd.cxobj, 2));
END;
IF br # NIL THEN co.EnqueueCxObj (br, nd.cxobj); END;
END;
END;
END;
END UpdateHotKeyNodeTypes;
PROCEDURE DelHotKey (entry: LONGINT);
VAR
nd: HotKeyNodePtr;
l : LONGINT;
type: LONGINT;
BEGIN
type := 0;
l := b.DynTTLen (hotdefs);
IF entry = -1 THEN entry := l-1; END;
IF (entry < 0) OR (entry >= l) THEN RETURN END;
nd := GetHotKeyNode (entry);
IF nd # NIL THEN
type := nd.type;
co.DeleteCxObjAll (nd.cxobj); nd.cxobj := NIL;
IF nd.node.succ # NIL THEN e.Remove (nd); nd.node.succ := NIL; END;
DISPOSE (nd.text); DISPOSE (nd.def);
END;
IF b.RemDynTTEntry (hotdefs, entry) THEN END;
UpdateHotKeyNodeTypes();
IF PlainId (type) = noKeyActivate THEN ResetNoActScrKeys(); END;
END DelHotKey;
PROCEDURE GetHotKeyNodeFromList (entry: LONGINT): e.NodePtr;
VAR
n: e.NodePtr;
j: LONGINT;
BEGIN
IF (entry < 0) OR (entry >= b.DynTTLen (hotdefs)) THEN RETURN NIL; END;
n := hotdeflist.head;
FOR j := 1 TO entry DO;
IF n.succ = NIL THEN RETURN NIL; END;
n := n.succ;
END;
RETURN n;
END GetHotKeyNodeFromList;
PROCEDURE SwapHotKeys (entry1, entry2: LONGINT): BOOLEAN;
VAR
l : LONGINT;
nd1, nd2: HotKeyNodePtr;
BEGIN
IF entry1 < entry2 THEN l := entry1; entry1 := entry2; entry2 := l; END;
l := b.DynTTLen (hotdefs);
IF (entry1 < 0) OR (entry1 >= l) OR
(entry2 < 0) OR (entry2 >= l) OR (entry1 = entry2) THEN RETURN false; END;
nd1 := GetHotKeyNode (entry1);
nd2 := GetHotKeyNode (entry2);
IF (nd1 = NIL) OR (nd2 = NIL) THEN RETURN false; END;
IF (nd1.node.succ = NIL) OR (nd2.node.succ = NIL) THEN RETURN false; END;
e.Remove (nd1); e.Remove (nd2);
hotdefs[entry1] := y.VAL (e.APTR, nd2);
hotdefs[entry2] := y.VAL (e.APTR, nd1);
e.Insert (hotdeflist, nd1, GetHotKeyNodeFromList (entry2-1));
e.Insert (hotdeflist, nd2, GetHotKeyNodeFromList (entry1-1));
UpdateHotKeyNodeTypes();
RETURN true;
END SwapHotKeys;
CONST
replaceMode = false;
insertMode = true;
VAR
nilNode: HotKeyNode;
VAR
addname, addtext: b.DynStrPtr;
PROCEDURE AddHotKey (type : LONGINT;
name : ARRAY OF CHAR;
text : ARRAY OF CHAR;
entry: LONGINT;
mode : BOOLEAN ): BOOLEAN;
VAR
l, j: LONGINT;
matchok: BOOLEAN;
nd: HotKeyNodePtr;
(* $CopyArrays- *)
BEGIN
IF (st.Length (name) >= strGadLen) OR (st.Length (text) >= strGadLen) OR
~IsValidId (type) THEN RETURN false; END;
l := b.DynTTLen (hotdefs);
IF l >= MAX (INTEGER)-2 THEN RETURN false; END; (* for all you hardcore users out there;-) *)
IF entry = -1 THEN entry := l; END;
IF (entry < 0) OR (entry > l) THEN RETURN false; END;
IF mode = replaceMode THEN
DISPOSE (addname); DISPOSE (addtext);
IF ~b.DynAppend (addname, name) THEN RETURN false; END;
IF ~b.DynAppend (addtext, text) THEN RETURN false; END;
DelHotKey (entry);
RETURN AddHotKey (type, addname^, addtext^, entry, insertMode);
END;
(* insertMode *)
type := AdaptIdToEntry (type, entry);
IF ~b.DynInsertTT (hotdefs, entry, nilNode, {b.noNulTerm}) THEN RETURN false; END;
nd := GetHotKeyNode (entry);
IF ~b.DynAppend (nd.def, name) THEN DelHotKey (entry); RETURN false; END;
IF ~b.DynAppend (nd.text, text) THEN DelHotKey (entry); RETURN false; END;
nd.type := type;
nd.node.name := y.ADR (nd.def[0]);
e.Insert (hotdeflist, nd, GetHotKeyNodeFromList (entry-1));
UpdateHotKeyNodeTypes();
IF PlainId (type) = noKeyActivate THEN
nd.cxobj := NIL;
matchok := co.ParseIX (name, DummyIX) = 0;
ResetNoActScrKeys();
RETURN matchok;
END;
nd.cxobj := cx.HotKey (name, nb.port, type);
IF IsNoKeyScrActId (type) THEN y.SETREG (0, co.SetCxObjPri (nd.cxobj, 2)); END;
IF br # NIL THEN co.EnqueueCxObj (br, nd.cxobj); END;
RETURN nd.cxobj # NIL;
END AddHotKey;
PROCEDURE SetShufflePattern (patarg: ARRAY OF CHAR): BOOLEAN;
VAR
pat: b.LStrPtr;
l : LONGINT;
(* $CopyArrays- *)
BEGIN
IF patarg # "" THEN pat := y.ADR (patarg[0]); ELSE pat := y.ADR ("#?"); END;
l := st.Length (pat^);
IF l < strGadLen THEN
IF b.DynExpand (shufflestr, l) THEN
IF b.DynExpand (shuffle, (l+1)*4) THEN
IF d.ParsePatternNoCase (pat^, shuffle^, LEN (shuffle^)) >= 0 THEN
COPY (pat^, shufflestr^);
RETURN true;
END;
END;
END;
END;
DISPOSE (shuffle); DISPOSE (shufflestr);
RETURN false;
END SetShufflePattern;
CONST
prefsName = "PROGDIR:Angie";
VAR
readdstr: b.DynStrPtr;
PROCEDURE ReadSettings();
VAR
tt, tti : b.TTPtr;
i : SHORTINT;
j : LONGINT;
k : INTEGER;
v : b.LStrPtr;
si : LONGINT;
type : LONGINT;
textstr : b.LStrPtr;
BEGIN
tt := cx.ArgArrayInit();
IF tt = NIL THEN HALT (20); END;
huntwindowalways := cx.ArgBool (NIL, huntAlwaysStr, true);
huntwindowwfr := cx.ArgBool (NIL, huntWinToFrontStr, true);
setdefpubonhunt := cx.ArgBool (NIL, huntSetDefPubModeStr, false);
incwintaskpri := cx.ArgBool (NIL, incWinTaskPriStr, true);
keyactivate := cx.ArgBool (NIL, keyActivateStr, true);
shufflebackdrop := cx.ArgBool (NIL, shuffleBackdropStr, false);
cxpopup := cx.ArgBool (NIL, cxPopUpStr, true);
scrMoveSteps := SHORT (b.Max2 (1, b.Min2 (50, cx.ArgInt (NIL, scrMoveStepsStr, 5))));
winMoveSteps := SHORT (b.Max2 (1, b.Min2 (50, cx.ArgInt (NIL, winMoveStepsStr, 5))));
SetSnoopDelay (cx.ArgInt (NIL, snoopDelayStr, 30));
SetStableTime (cx.ArgInt (NIL, stableTimeStr, 20));
IF SetShufflePattern (cx.ArgString (NIL, shufflePatStr,
defaultShufflePat)^) THEN END;
nb.pri := SHORT (SHORT (b.Max2 (MIN (SHORTINT),
b.Min2 (MAX (SHORTINT),
cx.ArgInt (NIL, cxPriorityStr, 0)))));
j := 0;
WHILE tt[j] # NIL DO
LOOP
FOR i := 0 TO hotKeys-1 DO
IF b.CmpToolNames (tt[j]^, hotnames[i]^) THEN
IF readdstr # NIL THEN readdstr[0] := CHR (0); END;
IF b.DynAppend (readdstr, b.GetToolValue (tt[j]^)^) THEN
type := i; si := 0;
WHILE (readdstr[si] # ':') & (readdstr[si] # '\000') DO INC (si); END;
IF readdstr[si] = ':' THEN
readdstr[si] := '\000';
FOR k := 0 TO LEN (attrs)-1 DO
IF ic.MatchToolValue (readdstr^, attrs[k].name^) THEN
INC (type, attrs[k].const);
END;
END;
v := b.StrIndex (readdstr^, si+1);
ELSE
v := b.StrIndex (readdstr^, 0);
END;
type := ProperType (type);
textstr := y.ADR ("");
IF PlainId (type) = custom THEN
si := 0;
WHILE (v[si] # CHR (27)) & (v[si] # '\000') DO INC (si); END;
IF v[si] = CHR (27) THEN
v[si] := '\000';
textstr := y.ADR (v[si+1]);
END;
END;
IF AddHotKey (type, v^, textstr^, -1, insertMode) THEN END;
END;
EXIT;
END; (* IF b.CmpToolNames ... *)
END; (* FOR i *)
EXIT;
END; (* LOOP *)
INC (j);
END; (* WHILE *)
END ReadSettings;
PROCEDURE ActivateBroker (b: BOOLEAN);
BEGIN
IF co.ActivateCxObj (br, BoolToLBool (b)) = e.false THEN END;
active := b;
END ActivateBroker;
VAR
instimerport : e.MsgPortPtr;
instio : ti.TimeRequestPtr;
instimeropen : BOOLEAN;
inserttval : ti.TimeVal;
VAR
OldCd: d.FileLockPtr;
PROCEDURE Init();
VAR
i : INTEGER;
BEGIN
dinfosig := -1;
guiwndsig := d.ctrlC;
chieftask := e.FindTask (NIL);
retpri := chieftask.node.pri;
OldCd := chieftask (d.Process).currentDir;
IF o.wbStarted THEN
y.SETREG (0, d.CurrentDir (o.wbenchMsg (wb.WBStartup).argList[0].lock));
END;
chiefpri := SHORT (SHORT (b.Min2 (MAX (SHORTINT), b.Max2 (retpri, 2))));
IF (co.base = NIL) OR (e.exec.libNode.version < 37) THEN HALT (20); END;
coBase := co.base;
cx38 := co.base.version >= 38;
int39 := I.int.libNode.version >= 39;
es.NewList (hotdeflist);
nb := cnb;
nb.port := e.CreateMsgPort();
IF nb.port = NIL THEN HALT (20); END;
ReadSettings();
CreateCustom();
ResetBroker();
IF br = NIL THEN HALT (20); END;
IF co.CxObjError (br) # LONGSET{} THEN HALT (20); END;
CreateCustomFilter();
IF cxcustomfilter = NIL THEN HALT (20); END;
dinfosig := e.AllocSignal (-1);
IF dinfosig = -1 THEN HALT (20); END;
tcb.node := ctcbnd;
tcb.spLower := y.ADR (ChildStack [0]);
tcb.spUpper := y.ADR (ChildStack [LEN (ChildStack)-1]);
tcb.spReg := tcb.spUpper;
e.CacheClearU();
(* $IF SmallData *)
tcb.userData := y.REG (13);
(* $END *)
ChildState := init;
e.AddTask (y.ADR (tcb), ChildTask, NIL);
y.SETREG (0, e.Wait (LONGSET {dinfosig}));
IF ChildState # ok THEN HALT (20); END;
instimerport := e.CreateMsgPort ();
instio := e.CreateIORequest (instimerport, SIZE (instio^));
IF instio = NIL THEN HALT (20); END;
ActivateBroker (true);
IF cxpopup THEN IF OpenGUI() THEN END; END;
y.SETREG (0, e.SetTaskPri (chieftask, chiefpri));
END Init;
PROCEDURE^ SaveProcCleanUp(): BOOLEAN;
VAR
OldPri : INTEGER;
CONST
invalidPri = 4000H;
incPri = 4001H;
PROCEDURE SecureSetTaskPri (task: e.TaskPtr; pri: INTEGER): INTEGER;
VAR
t: e.TaskPtr;
r: INTEGER;
BEGIN
r := invalidPri;
IF (task = NIL) OR (pri = invalidPri) THEN RETURN r; END;
e.Disable ();
LOOP
t := e.exec.taskReady.head;
WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
IF t.node.succ # NIL THEN EXIT; END;
t := e.exec.taskWait.head;
WHILE (t.node.succ # NIL) & (t # task) DO t := t.node.succ; END;
EXIT;
END;
IF (t.node.succ # NIL) & (e.FindTask (NIL) # t) THEN
IF pri = incPri THEN
pri := LONG (t.node.pri)+1;
ELSE
IF pri+1 # t.node.pri THEN pri := invalidPri; END;
END;
IF pri # invalidPri THEN
pri := SHORT (b.Max2 (MIN (SHORTINT), b.Min2 (MAX (SHORTINT), pri)));
r := e.SetTaskPri (t, SHORT (pri));
END;
END;
e.Enable ();
RETURN r;
END SecureSetTaskPri;
PROCEDURE CleanUp();
VAR
msg: e.MessagePtr;
BEGIN
y.SETREG (0, e.SetTaskPri (chieftask, retpri));
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
y.SETREG (0, SaveProcCleanUp());
CloseGUI();
IF instimeropen THEN e.CloseDevice (instio); instimeropen := false; END;
e.DeleteIORequest (instio); instio := NIL;
e.DeleteMsgPort (instimerport); instimerport := NIL;
DeleteCxObjs();
co.DeleteCxObj (br); br := NIL;
IF nb.port # NIL THEN
LOOP
msg := e.GetMsg (nb.port);
IF msg = NIL THEN EXIT; END;
e.ReplyMsg (msg);
END;
END;
e.DeleteMsgPort (nb.port); nb.port := NIL;
co.DeleteCxObjAll (cxcustomfilter); cxcustomfilter := NIL;
IF ChildState # yetUnlaunched THEN
e.Forbid();
IF ChildState # died THEN ChildState := requestDie; END;
e.Permit();
WHILE ChildState # died DO y.SETREG (0,e.Wait (LONGSET {dinfosig})); END;
END;
DISPOSE (shuffle);
e.FreeSignal (dinfosig); dinfosig := -1;
y.SETREG (0, d.CurrentDir (OldCd));
IF o.Result > 5 THEN I.DisplayBeep (NIL); END;
END CleanUp;
PROCEDURE PrepareScrPos (scr: I.ScreenPtr; x1, y1, x2, y2: LONGINT;
VAR sx: LONGINT; VAR sy: LONGINT);
VAR
vpe : g.ViewPortExtraPtr;
rect: g.Rectangle;
BEGIN
sx := 0; sy := 0;
IF ~int39 & (scr # NIL) THEN
vpe := b.ScrVPExtra (scr);
IF (vpe # NIL) & b.VisibleOfScreen (scr, rect) THEN
IF vpe.displayClip.maxX-vpe.displayClip.minX+1 < x2-x1+1 THEN
sx := rect.minX-x1-(vpe.displayClip.maxX-vpe.displayClip.minX+1)+
(rect.maxX-rect.minX+1);
ELSIF rect.minX > x1 THEN
sx := b.Max2 (rect.minX-x1, 0);
ELSE
sx := b.Min2 (rect.maxX-x2, 0);
END;
IF vpe.displayClip.maxY-vpe.displayClip.minY+1 < y2-y1+1 THEN
sy := rect.minY-y1-(vpe.displayClip.maxY-vpe.displayClip.minY+1)+
(rect.maxY-rect.minY+1);
ELSIF rect.minY > y1 THEN
sy := b.Max2 (rect.minY-y1, 0);
ELSE
sy := b.Min2 (rect.maxY-y2, 0);
END;
END;
END;
END PrepareScrPos;
PROCEDURE ScrPos (scr: I.ScreenPtr; x1, y1, x2, y2, sx, sy: LONGINT);
BEGIN
IF scr # NIL THEN
IF ~int39 OR (sx # 0) OR (sy # 0) THEN
I.MoveScreen (scr, sx, sy);
ELSE
I.ScreenPosition (scr, LONGSET{sposMakeVisible},
x1, y1, x2, y2);
END;
END;
END ScrPos;
PROCEDURE IsActivationId (id: LONGINT): BOOLEAN;
BEGIN
CASE PlainId (id) OF
activate, activateNext, activatePrev, activateBackDrop,
activateFrontScr, nextScreen, prevScreen, wbenchScreen, defPubScreen,
lastActive, lastActiveScr, activateNextScreen, activatePrevScreen,
activateWBenchScreen, activateDefPubScreen:
RETURN true;
ELSE
RETURN false;
END;
END IsActivationId;
PROCEDURE IsHuntId (id: LONGINT): BOOLEAN;
BEGIN
RETURN huntwindowalways OR (IsToFrontId (id) & huntwindowwfr) OR
(PlainId (id)=huntWindow);
END IsHuntId;
PROCEDURE IsPubScreen (scr: I.ScreenPtr; VAR name: b.DynStrPtr): BOOLEAN;
VAR
ScrList: e.ListPtr;
nd1 : I.PubScreenNodePtr;
res : BOOLEAN;
BEGIN
res := false;
IF scr = NIL THEN RETURN false; END;
ScrList := I.LockPubScreenList ();
nd1 := ScrList.head;
WHILE (nd1.node.succ # NIL) & ~res DO
IF ~(I.psnfPrivate IN nd1.flags) THEN
IF nd1.screen = scr THEN
IF b.DynExpand (name, st.Length (nd1.node.name^)) THEN
COPY (nd1.node.name^, name^);
res := true;
END;
END;
END;
nd1 := nd1.node.succ;
END; (* WHILE *)
I.UnlockPubScreenList ();
RETURN res;
END IsPubScreen;
VAR
pubnam: b.DynStrPtr;
PROCEDURE MakeDefPubScr (scr: I.ScreenPtr; failWB: BOOLEAN);
VAR
dps: I.ScreenPtr;
BEGIN
dps := I.LockPubScreen (NIL);
I.UnlockPubScreen (NIL, dps);
IF dps # scr THEN
IF IsPubScreen (scr, pubnam) THEN
I.SetDefaultPubScreen (pubnam^);
ELSE
IF failWB THEN I.SetDefaultPubScreen (NIL); END;
END;
END;
END MakeDefPubScr;
CONST
minStack = 4096;
VAR
ConTitle: ARRAY strGadLen OF CHAR;
PROCEDURE DoIntuiAction (actionid: LONGINT);
VAR
newtask : e.TaskPtr;
lk : LONGINT;
scr,bscr,fscr: I.ScreenPtr;
auxscr : I.ScreenPtr;
pscr : I.ScreenPtr;
rect : g.Rectangle;
sx, sy : LONGINT;
vpe : g.ViewPortExtraPtr;
dcwidth : LONGINT;
dcheight : LONGINT;
vswidth : LONGINT;
vsheight : LONGINT;
w,w0, w1,w2,w3: I.WindowPtr;
wl,wt,ww,wh : LONGINT;
wx,wy,nww,nwh: LONGINT;
x1,y1,x2,y2 : LONGINT;
reallyzip : BOOLEAN;
reallychwbox : BOOLEAN;
reallymovewnd: BOOLEAN;
reallytofront: BOOLEAN;
reallytoback : BOOLEAN;
reallyactivate: BOOLEAN;
reallymovescr: BOOLEAN;
reallyscrtofront: BOOLEAN;
reallymakedefpub: BOOLEAN;
tmpport : e.MsgPortPtr;
nd : HotKeyNodePtr;
text : b.LStrPtr;
entr : LONGINT;
inp : d.FileHandlePtr;
ok : BOOLEAN;
iev : ie.InputEventPtr;
stk : LONGINT;
insertdelay : LONGINT;
chrscvted : LONGINT;
PROCEDURE CheckHuntWindow();
VAR
vpe : g.ViewPortExtraPtr;
BEGIN
sx := 0; sy := 0;
IF (w # NIL) & IsHuntId (actionid) THEN
scr := w.wScreen;
IF setdefpubonhunt THEN reallymakedefpub := true; END;
IF I.backDrop IN w.flags THEN
vpe := b.ScrVPExtra (scr);
IF (vpe # NIL) & b.VisibleOfScreen (scr, rect) THEN
sy := rect.maxY-rect.minY+1 -
b.Min2 (scr.height, vpe.displayClip.maxY-vpe.displayClip.minY+1);
IF sy < 0 THEN reallymovescr := true; END;
END;
ELSE
PrepareScrPos (scr, wl, wt, wl+ww-1, wt+wh-1, sx, sy);
reallymovescr := true;
END;
IF I.int.firstScreen # scr THEN reallyscrtofront := true; END;
END; (* IF w # NIL *)
END CheckHuntWindow;
PROCEDURE HuntWindow();
BEGIN
IF reallymovescr THEN ScrPos (scr, wl, wt, wl+ww-1, wt+wh-1, sx, sy); END;
IF reallyscrtofront THEN I.ScreenToFront (scr); END;
IF reallymakedefpub THEN MakeDefPubScr (scr, true); END;
END HuntWindow;
PROCEDURE ResetActionFlags();
BEGIN
w := NIL; scr := NIL; bscr := NIL; fscr := NIL; pscr := NIL;
reallytofront := false; reallyactivate := false;
reallymovescr := false; reallyscrtofront := false;
reallyzip := false; reallychwbox := false;
reallymovewnd := false; reallytoback := false;
reallymakedefpub := false;
END ResetActionFlags;
PROCEDURE MatchWindow (w: I.WindowPtr): BOOLEAN;
VAR
wtitle: e.STRPTR;
BEGIN
IF w # NIL THEN
IF ~(I.backDrop IN w.flags) OR shufflebackdrop THEN
wtitle := w.title;
IF wtitle = NIL THEN wtitle := y.ADR (""); END;
IF shuffle = NIL THEN RETURN true; END;
IF d.MatchPatternNoCase (shuffle^, wtitle^) THEN RETURN true; END;
END;
END;
RETURN false;
END MatchWindow;
PROCEDURE PutIEventsDelayed (iev: ie.InputEventPtr);
VAR
iev1: ie.InputEventPtr;
BEGIN
WHILE iev # NIL DO
IF d.ctrlC IN e.SetSignal (LONGSET{}, LONGSET{}) THEN RETURN; END;
iev1 := iev.nextEvent;
iev.nextEvent := NIL;
co.AddIEvents (iev);
iev.nextEvent := iev1;
iev := iev1;
instio.time := inserttval;
instio.node.command := ti.addRequest; e.OldDoIO (instio);
END;
END PutIEventsDelayed;
BEGIN
IF ~active THEN RETURN; END;
lk := I.LockIBase (0);
w := I.int.activeWindow;
IF w # NIL THEN
IF I.menuState IN w.flags THEN I.UnlockIBase (lk); RETURN; END;
END;
ResetActionFlags();
CASE PlainId (actionid) OF
custom:
I.UnlockIBase (lk);
entr := ASH (actionid, -16);
nd := GetHotKeyNode (entr);
IF (nd # NIL) & (PlainId (nd.type) = custom) THEN
ok := false;
IF (nd.text[0] # '#') & (nd.text[0] # '~') THEN
(* launching a background shell isn't necessarily an 'IntuiAction', though ;-> *)
scr := I.LockPubScreen (NIL);
vpe := b.ScrVPExtra (scr);
IF (vpe # NIL) & b.VisibleOfScreen (scr, rect) THEN
vswidth := rect.maxX-rect.minX+1;
vsheight := rect.maxY-rect.minY+1;
dcwidth := vpe.displayClip.maxX-vpe.displayClip.minX+1;
dcheight := vpe.displayClip.maxY-vpe.displayClip.minY+1;
sp.SPrintF (ConTitle,
"CON:%ld/%ld/%ld/%ld/Angie Output/AUTO/CLOSE/WAIT/"
"ALT%ld/%ld/%ld/%ld/SCREEN",
rect.minX + vswidth DIV 64, rect.minY + vsheight DIV 7,
vswidth - vswidth DIV 16+1, vsheight DIV 3+1,
rect.minX, rect.minY, dcwidth, dcheight);
inp := d.Open (ConTitle, d.oldFile);
IF inp # NIL THEN
IF chieftask (d.Process).cli # NIL THEN
stk := ASH (chieftask (d.Process).cli.defaultStack, 2);
ELSE
stk := chieftask (d.Process).stackSize;
END;
IF stk < minStack THEN stk := minStack; END;
IF d.SystemTags(nd.text^, d.sysInput, b.BPtrVal (inp), d.sysAsynch, e.LTRUE,
d.sysOutput, NIL, d.npStackSize, stk,
d.npPriority, retpri, u.done) = d.DOSTRUE THEN
d.OldClose (inp);
ELSE
ok := true;
END;
END;
END;
I.UnlockPubScreen (NIL, scr);
IF ok & IsToFrontId (actionid) THEN
DoIntuiAction (defPubScreen);
END;
ELSE (* we have an input description string *)
text := y.ADR (nd.text[1]);
IF nd.text[0] = '#' THEN
insertdelay := 50;
CASE text[0] OF '0'..'9':
chrscvted := d.StrToLong (text^, insertdelay);
IF chrscvted > 0 THEN
CASE text[chrscvted] OF '~', ' ': INC (chrscvted); ELSE END;
text := y.ADR (text[chrscvted]);
ELSE
insertdelay := 50;
END;
END;
insertdelay := b.Max2 (0, b.Min2 (999, insertdelay));
END;
iev := cx.InvertStringForwd (text^, NIL);
IF iev # NIL THEN
IF (nd.text[0] # '#') OR (insertdelay = 0) THEN
co.AddIEvents (iev);
ok := true;
ELSIF ~instimeropen THEN (* do the delay stuff *)
instimeropen := e.OpenDevice (ti.timerName,
ti.microHz, instio, LONGSET{}) = 0;
IF instimeropen THEN
inserttval.micro := insertdelay * 1000;
PutIEventsDelayed (iev);
e.CloseDevice (instio); instimeropen := false;
ok := true;
END;
END;
END;
cx.FreeIEvents (iev);
END;
IF ~ok THEN I.DisplayBeep (NIL); END;
END; |
filter:
I.UnlockIBase (lk); |
activate, activateNext, activatePrev, activeToFront, activateBackDrop,
activateFrontScr, nextScreen, prevScreen, wbenchScreen, defPubScreen,
activateNextScreen, activatePrevScreen, activateWBenchScreen,
activateDefPubScreen,
lastActive, lastActiveScr, huntWindow, zipWin, maxWin, minWin, closeWin,
centerWin, activeToBack, setDefPubScreen, moveWinLeft, moveWinRight,
moveWinUp, moveWinDown, upperLeftWin, lowerLeftWin, upperRightWin,
lowerRightWin, expandWidth, expandHeight, shrinkWidth, shrinkHeight,
doubleWidth, doubleHeight, halveWidth, halveHeight, adaptWindow,
maxWinWidth, maxWinHeight, huntZipped, huntSigd:
CASE PlainId (actionid) OF
huntZipped:
e.Forbid();
IF IsValidWinScr (zipwin) THEN w := zipwin.win; END;
e.Permit();
IF I.int.activeWindow # w THEN w := NIL; END; |
huntSigd:
e.Forbid(); dinfotask := dinfopass; e.Permit();
w := dinfotask.activeWin.win;
scr := dinfotask.activeScr;
IF incwintaskpri THEN
newtask := NIL;
e.Disable();
IF w # NIL THEN
tmpport := w.userPort;
IF (y.VAL (LONGSET, tmpport) * LONGSET {0,31} = LONGSET {}) &
(tmpport # NIL) & (e.public IN e.TypeOfMem (tmpport)) &
(e.public IN e.TypeOfMem (y.ADR (tmpport.msgList))) THEN
newtask := tmpport.sigTask;
END;
END;
e.Enable();
IF newtask # IncTask THEN
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri));
IncTask := newtask;
OldPri := SecureSetTaskPri (IncTask, incPri);
IF OldPri = invalidPri THEN IncTask := NIL; END;
END;
ELSE
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
END;
IF ~huntwindowalways THEN
w := NIL;
ELSE
IF w # NIL THEN
wl := dinfotask.winBox.left;
wt := dinfotask.winBox.top;
ww := dinfotask.winBox.width;
wh := dinfotask.winBox.height;
LOOP
IF scr = I.int.activeScreen THEN
IF w = I.int.activeWindow THEN
IF wl = w.leftEdge THEN
IF wt = w.topEdge THEN
IF ww = w.width THEN
IF wh = w.height THEN
EXIT;
END;
END;
END;
END;
END;
END;
IF stabletime >= 0 THEN dinfochange := true; END;
w := NIL;
EXIT;
END; (* LOOP *)
END;
END; |
setDefPubScreen:
scr := I.int.activeScreen;
auxscr := I.int.firstScreen;
IF (scr = NIL) OR
((g.vpHide IN scr.viewPort.modes) & (auxscr # NIL) &
(auxscr.firstWindow = NIL)) THEN
scr := auxscr;
END;
IF scr # NIL THEN reallymakedefpub := true; END; |
closeWin:
w := I.int.activeWindow;
IF (w # NIL) & (~(I.windowClose IN w.flags) OR (w.reqCount > 0)) THEN
w := NIL;
END;
IF w # NIL THEN
Close1 := close1;
Close1.addr := y.VAL (ie.IEDummyPtr, w);
co.AddIEvents (y.VAL (ie.InputEventPtr, y.ADR (Close1)));
END; |
activate:
w := MouseWin (exactWin); |
activateNext:
w1 := I.int.activeWindow;
IF w1 # NIL THEN
w := w1.nextWindow;
LOOP
IF w = NIL THEN w := w1.wScreen.firstWindow; END;
IF (w = NIL) OR (w = w1) THEN EXIT; END;
IF MatchWindow (w) THEN EXIT; END;
w := w.nextWindow;
END;
END; |
activatePrev:
w0 := I.int.activeWindow;
IF w0 # NIL THEN
w1 := w0;
LOOP
w3 := w1.wScreen.firstWindow;
w2 := w3; w := w2;
WHILE (w2 # NIL) & ((w2 # w1) OR (w2 = w3)) DO
w := w2; w2 := w2.nextWindow;
END;
IF w = NIL THEN EXIT; END;
IF MatchWindow (w) THEN EXIT; END;
w1 := w; w := NIL;
IF w1 = w0 THEN EXIT; END;
END;
END; |
activeToFront, huntWindow:
w := I.int.activeWindow; |
activeToBack:
w := I.int.activeWindow;
IF w # NIL THEN
IF ~(I.backDrop IN w.flags) THEN reallytoback := true; END;
END; |
lastActive:
e.Forbid();
IF IsValidWinScr (lastwin) THEN
w := lastwin.win;
ELSIF (lastwin.scr # I.int.activeScreen) & IsValidScr (lastwin.scr) THEN
w := ScrFrontWin (lastwin.scr);
END;
e.Permit(); |
lastActiveScr:
e.Forbid();
IF IsValidWinScr (lastscrwin) THEN
w := lastscrwin.win;
ELSIF IsValidScr (lastscrwin.scr) THEN
w := ScrFrontWin (lastscrwin.scr);
END;
e.Permit(); |
activateBackDrop:
scr := I.int.activeScreen;
IF scr # NIL THEN
w := scr.firstWindow;
LOOP
IF w = NIL THEN EXIT; END;
IF I.backDrop IN w.flags THEN EXIT; END;
w := w.nextWindow;
END;
END; |
activateFrontScr:
scr := I.int.firstScreen;
w := ScrFrontWin (scr); |
nextScreen, prevScreen, wbenchScreen, defPubScreen,
activateNextScreen, activatePrevScreen, activateWBenchScreen,
activateDefPubScreen:
CASE PlainId (actionid) OF
nextScreen, activateNextScreen:
scr := I.int.firstScreen;
LOOP
IF scr = NIL THEN EXIT; END;
IF scr.nextScreen = NIL THEN EXIT; END;
scr := scr.nextScreen;
END;
IF scr = I.int.firstScreen THEN scr := NIL; END;
fscr := scr; |
prevScreen, activatePrevScreen:
bscr := I.int.firstScreen;
IF bscr.nextScreen = NIL THEN bscr := NIL; END;
IF bscr # NIL THEN scr := bscr.nextScreen; END; |
wbenchScreen, defPubScreen, activateWBenchScreen, activateDefPubScreen:
I.UnlockIBase (lk);
CASE PlainId (actionid) OF
wbenchScreen, activateWBenchScreen:
pscr := I.LockPubScreen ("Workbench"); |
defPubScreen, activateDefPubScreen:
pscr := I.LockPubScreen (NIL);
ELSE END;
lk := I.LockIBase (0);
scr := pscr;
IF I.int.firstScreen = scr THEN scr := NIL; END;
fscr := scr;
ELSE END;
w := GetScrWin (scr);
IF (w = NIL) & (scr # NIL) THEN w := ScrFrontWin (scr); END;
CASE PlainId (actionid) OF
nextScreen, prevScreen, wbenchScreen, defPubScreen:
w := NIL;
ELSE
IF (scr # NIL) & setdefpubonhunt & IsHuntId (actionid) THEN
reallymakedefpub := true;
END;
END; |
zipWin:
w := I.int.activeWindow;
IF w # NIL THEN
IF ~(I.hasZoom IN w.flags) THEN w := NIL; END;
END;
IF w # NIL THEN
wl := w.leftEdge; wt := w.topEdge; ww := w.width; wh := w.height;
zipwin.win := w; zipwin.scr := w.wScreen;
reallyzip := true;
END; |
maxWinWidth, maxWinHeight,
doubleWidth, doubleHeight, halveWidth, halveHeight, adaptWindow,
maxWin, minWin, expandWidth, expandHeight, shrinkWidth, shrinkHeight,
moveWinLeft, moveWinRight, moveWinUp, moveWinDown, upperLeftWin,
lowerLeftWin, upperRightWin, lowerRightWin, centerWin:
w := I.int.activeWindow;
IF w # NIL THEN
CASE PlainId (actionid) OF
doubleWidth, doubleHeight, halveWidth, halveHeight,
maxWin, minWin, expandWidth, expandHeight, shrinkWidth, shrinkHeight,
maxWinWidth, maxWinHeight:
IF ~(I.windowSizing IN w.flags) THEN w := NIL; END;
ELSE END;
CASE PlainId (actionid) OF
moveWinLeft, moveWinRight, moveWinUp, moveWinDown, upperLeftWin,
lowerLeftWin, upperRightWin, lowerRightWin, centerWin:
IF w # NIL THEN IF ~(I.windowDrag IN w.flags) THEN w := NIL; END; END;
ELSE END;
END;
IF w # NIL THEN
vpe := b.ScrVPExtra (w.wScreen);
IF (vpe = NIL) OR ~b.VisibleOfScreen (w.wScreen, rect) THEN w := NIL; END;
END;
IF w # NIL THEN
dcwidth := vpe.displayClip.maxX-vpe.displayClip.minX+1;
dcheight := vpe.displayClip.maxY-vpe.displayClip.minY+1;
vswidth := rect.maxX-rect.minX+1;
vsheight := rect.maxY-rect.minY+1;
wx := b.Max2 (dcwidth DIV winMoveSteps, 1);
wy := b.Max2 (dcheight DIV winMoveSteps, 1);
wl := w.leftEdge; wt := w.topEdge; ww := w.width; wh := w.height;
CASE PlainId (actionid) OF
adaptWindow:
IF ~(I.windowDrag IN w.flags) THEN
IF I.windowSizing IN w.flags THEN
IF (wl <= rect.maxX) & (wt <= rect.maxY) &
(wl+ww-1 >= rect.minX) & (wt+wh-1 >= rect.minY) THEN
IF (wl+ww-1 > rect.maxX) & (wl + w.minWidth -1 <= rect.maxX) THEN
ww := b.Max2 (1, (b.Max2 (w.minWidth, rect.maxX-wl+1)));
END;
IF (wt+wh-1 > rect.maxY) & (wt + w.minHeight-1 <= rect.maxY) THEN
wh := b.Max2 (1, b.Max2 (w.minHeight, rect.maxY-wt+1));
END;
END;
END
ELSE
IF I.windowSizing IN w.flags THEN
IF ww > vswidth THEN
ww := b.Max2 (1, b.Max2 (w.minWidth , vswidth ));
END;
IF wh > vsheight THEN
wh := b.Max2 (1, b.Max2 (w.minHeight, vsheight));
END;
END;
IF wl+ww-1 > rect.maxX THEN wl := b.Max2 (0, rect.maxX+1-ww); END;
IF wt+wh-1 > rect.maxY THEN wt := b.Max2 (0, rect.maxY+1-wh); END;
IF wl < rect.minX THEN
wl := b.Max2 (0, b.Min2 (rect.minX, w.wScreen.width -ww));
END;
IF wt < rect.minY THEN
wt := b.Max2 (0, b.Min2 (rect.minY, w.wScreen.height-wh));
END;
END; |
maxWin, maxWinWidth, maxWinHeight:
IF I.windowDrag IN w.flags THEN
nww := vswidth; nwh := vsheight;
CASE PlainId (actionid) OF
maxWin, maxWinWidth:
wl := b.Max2 (0, b.Min2 (rect.minX, w.wScreen.width-w.minWidth)); |
ELSE END;
CASE PlainId (actionid) OF
maxWin, maxWinHeight:
wt := b.Max2 (0, b.Min2 (rect.minY, w.wScreen.height-w.minHeight));
ELSE END;
ELSE
nww := dcwidth; nwh := dcheight;
END;
CASE PlainId (actionid) OF
maxWin, maxWinWidth:
ww := b.Max2 (1, b.Max2 (w.minWidth,
b.Min2 (b.Min2 (nww, w.wScreen.width-wl),
I.UIntToLong (w.maxWidth ))));
ELSE END;
CASE PlainId (actionid) OF
maxWin, maxWinHeight:
wh := b.Max2 (1, b.Max2 (w.minHeight,
b.Min2 (b.Min2 (nwh, w.wScreen.height-wt),
I.UIntToLong (w.maxHeight))));
ELSE END; |
minWin:
ww := b.Max2 (1, b.Min2 (w.wScreen.width , w.minWidth ));
wh := b.Max2 (1, b.Min2 (w.wScreen.height, w.minHeight));
IF I.windowDrag IN w.flags THEN
wl := b.Max2 (0, rect.maxX-ww+1);
wt := b.Max2 (0, rect.maxY-wh+1);
END; |
doubleWidth, expandWidth:
CASE PlainId (actionid) OF
doubleWidth: nww := 2 * ww; |
expandWidth: nww := ww+wx
END;
IF I.windowDrag IN w.flags THEN
ww := b.Max2 (1, b.Min2 (w.wScreen.width,
b.Min2 (nww, I.UIntToLong (w.maxWidth))));
wl := b.Max2 (0, b.Min2 (wl, w.wScreen.width-ww));
ELSE
ww := b.Max2 (1, b.Min2 (w.wScreen.width-wl,
b.Min2 (nww, I.UIntToLong (w.maxWidth))));
END; |
doubleHeight, expandHeight:
CASE PlainId (actionid) OF
doubleHeight: nwh := 2 * wh; |
expandHeight: nwh := wh+wy
END;
IF I.windowDrag IN w.flags THEN
wh := b.Max2 (1, b.Min2 (w.wScreen.height,
b.Min2 (nwh, I.UIntToLong (w.maxHeight))));
wt := b.Max2 (0, b.Min2 (wt, w.wScreen.height-wh));
ELSE
wh := b.Max2 (1, b.Min2 (w.wScreen.height-wt,
b.Min2 (nwh, I.UIntToLong (w.maxHeight))));
END; |
halveWidth:
ww := b.Max2 (1, b.Max2 (w.minWidth, ww DIV 2)); |
halveHeight:
wh := b.Max2 (1, b.Max2 (w.minHeight, wh DIV 2)); |
shrinkWidth:
ww := b.Max2 (1, b.Max2 (w.minWidth, ww-wx)); |
shrinkHeight:
wh := b.Max2 (1, b.Max2 (w.minHeight, wh-wy)); |
moveWinRight:
wl := b.Max2 (0, b.Min2 (wl+wx, w.wScreen.width-ww)); |
moveWinLeft :
wl := b.Max2 (0, wl-wx); |
moveWinDown :
wt := b.Max2 (0, b.Min2 (wt+wy, w.wScreen.height-wh)); |
moveWinUp :
wt := b.Max2 (0, wt-wy); |
upperLeftWin:
wl := b.Max2 (0, b.Min2 (rect.minX, w.wScreen.width -ww));
wt := b.Max2 (0, b.Min2 (rect.minY, w.wScreen.height-wh)); |
lowerLeftWin:
wl := b.Max2 (0, b.Min2 (rect.minX, w.wScreen.width -ww));
wt := b.Max2 (0, rect.maxY-wh+1); |
upperRightWin:
wl := b.Max2 (0, rect.maxX-ww+1);
wt := b.Max2 (0, b.Min2 (rect.minY, w.wScreen.height-wh)); |
lowerRightWin:
wl := b.Max2 (0, rect.maxX-ww+1);
wt := b.Max2 (0, rect.maxY-wh+1); |
centerWin:
wl := b.Max2 (0, vswidth -w.width ) DIV 2 + rect.minX;
wt := b.Max2 (0, vsheight-w.height) DIV 2 + rect.minY;
ELSE END;
wx := wl - w.leftEdge;
wy := wt - w.topEdge;
IF (wl # w.leftEdge) OR
(wt # w.topEdge) OR (ww # w.width) OR (wh # w.height) THEN
CASE PlainId (actionid) OF
moveWinLeft, moveWinRight, moveWinUp, moveWinDown, upperLeftWin,
lowerLeftWin, upperRightWin, lowerRightWin, centerWin:
reallymovewnd := true;
ELSE END;
IF ~(I.windowSizing IN w.flags) THEN
reallymovewnd := true;
END;
IF ~reallymovewnd THEN reallychwbox := true; END;
END;
END;
ELSE END;
IF w # NIL THEN
IF IsActivationId (actionid) THEN reallyactivate := true; END;
IF IsToFrontId (actionid) THEN
IF ~(I.backDrop IN w.flags) THEN reallytofront := true; END;
END;
IF ~reallyzip & ~reallychwbox & ~reallymovewnd THEN
wl := w.leftEdge; wt := w.topEdge; ww := w.width; wh := w.height;
END;
END;
CheckHuntWindow();
y.SETREG (0, e.SetTaskPri (chieftask, 100));
I.UnlockIBase (lk);
IF fscr # NIL THEN I.ScreenToFront (fscr); END;
IF bscr # NIL THEN I.ScreenToBack (bscr); END;
IF reallyactivate THEN I.ActivateWindow (w); END;
IF reallytofront THEN I.WindowToFront (w); END;
IF reallytoback THEN I.WindowToBack (w); END;
IF reallyzip THEN I.ZipWindow (w); END;
IF reallychwbox THEN I.ChangeWindowBox (w, wl, wt, ww, wh); END;
IF reallymovewnd THEN I.MoveWindow (w, wx, wy); END;
I.UnlockPubScreen (NIL, pscr);
HuntWindow();
y.SETREG (0, e.SetTaskPri (chieftask, chiefpri));
IF reallyzip & IsToFrontId (actionid) THEN
d.Delay (10);
DoIntuiAction (sendHuntZipped);
END; |
scrollScrLeft, scrollScrRight, scrollScrUp, scrollScrDown:
sx := 0; sy := 0;
scr := I.int.activeScreen;
vpe := b.ScrVPExtra (scr);
IF vpe # NIL THEN
sx := b.Max2((vpe.displayClip.maxX-vpe.displayClip.minX+1)
DIV scrMoveSteps, 1);
sy := b.Max2((vpe.displayClip.maxY-vpe.displayClip.minY+1)
DIV scrMoveSteps, 1);
CASE PlainId (actionid) OF
scrollScrLeft : sy := 0; |
scrollScrRight: sy := 0; sx := -sx; |
scrollScrUp : sx := 0; sy := b.Min2 (scr.topEdge+sy,
vpe.displayClip.maxY)-scr.topEdge; |
scrollScrDown : sx := 0; sy := -sy;
ELSE END;
END;
IF (sx # 0) OR (sy # 0) THEN reallymovescr := true; END;
y.SETREG (0, e.SetTaskPri (chieftask, 100));
I.UnlockIBase (lk);
IF reallymovescr THEN I.MoveScreen (scr, sx, sy); END;
y.SETREG (0, e.SetTaskPri (chieftask, chiefpri)); |
upperLeftScr, lowerLeftScr, upperRightScr, lowerRightScr, showScrCenter, screenTop:
scr := I.int.activeScreen;
vpe := b.ScrVPExtra (scr);
IF (vpe # NIL) & b.VisibleOfScreen (scr, rect) THEN
sx := b.Min2 (vpe.displayClip.maxX-vpe.displayClip.minX+1, scr.width);
sy := b.Min2 (vpe.displayClip.maxY-vpe.displayClip.minY+1, scr.height);
CASE PlainId (actionid) OF
screenTop:
x1 := rect.minX; y1 := 0; sx := rect.maxX-rect.minX+1; |
upperLeftScr:
x1 := 0; y1 := 0; |
lowerLeftScr:
x1 := 0; y1 := scr.height-sy; |
upperRightScr:
x1 := scr.width-sx; y1 := 0; |
lowerRightScr:
x1 := scr.width-sx; y1 := scr.height-sy; |
showScrCenter:
x1 := (scr.width-sx) DIV 2; y1 := (scr.height-sy) DIV 2;
ELSE END;
x2 := x1+sx-1; y2 := y1+sy-1;
reallymovescr := true;
PrepareScrPos (scr, x1, y1, x2, y2, sx, sy);
END;
y.SETREG (0, e.SetTaskPri (chieftask, 100));
I.UnlockIBase (lk);
IF reallymovescr THEN ScrPos (scr, x1, y1, x2, y2, sx, sy); END;
y.SETREG (0, e.SetTaskPri (chieftask, chiefpri));
ELSE
I.UnlockIBase (lk);
I.DisplayBeep (NIL);
END;
END DoIntuiAction;
VAR
AngieMsg: I.IntuiMessage;
AngieGad: I.GadgetPtr;
TYPE
GadProcArrT = ARRAY LEN (ag.AngieGadgets) OF PROCEDURE (): BOOLEAN;
VAR
defprocstr: b.DynStrPtr;
PROCEDURE^ HotKeysKeyProc (): BOOLEAN;
PROCEDURE DefinitionProc (): BOOLEAN;
VAR
l : LONGINT;
nd: HotKeyNodePtr;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
nd := GetHotKeyNode (SelectedHotKey);
DISPOSE (defprocstr);
IF ~b.DynAppend (defprocstr, nd.node.name^) THEN END;
l := b.DynTTLen (hotdefs);
SuspendHotKeyDisplay();
IF (AngieMsg.code # 27) &
~AddHotKey (nd.type,
ag.AngieGadgets [ag.GDdefinition].specialInfo (I.StringInfo).buffer^,
nd.text^, SelectedHotKey, replaceMode) &
(l = b.DynTTLen (hotdefs)) & (defprocstr # NIL) &
~AddHotKey (nd.type, defprocstr^, nd.text^,
SelectedHotKey, replaceMode) THEN END;
UpdateHotKeyDisplay ({fixType});
IF b.DynTTLen (hotdefs) = l THEN
CASE AngieMsg.code OF
ag.rawCrsrUp, ag.rawCrsrDown:
RETURN HotKeysKeyProc ();
ELSE END;
END;
RETURN true;
END DefinitionProc;
PROCEDURE DefinitionKeyProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
IF I.ActivateGadget (ag.AngieGadgets [ag.GDdefinition]^,
ag.AngieWnd, NIL) THEN END;
RETURN true;
END DefinitionKeyProc;
PROCEDURE HotKeysProc (): BOOLEAN;
BEGIN
SelectedHotKey := AngieMsg.code;
UpdateHotKeyDisplay ({fixType});
RETURN true;
END HotKeysProc;
PROCEDURE HotKeysKeyProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
CASE AngieMsg.code OF
ag.rawCrsrUp:
IF SelectedHotKey > 0 THEN DEC (SelectedHotKey); END; |
ag.rawCrsrDown:
IF SelectedHotKey < b.DynTTLen (hotdefs)-1 THEN INC (SelectedHotKey); END;
ELSE END;
UpdateHotKeyDisplay ({fixType});
RETURN true;
END HotKeysKeyProc;
PROCEDURE PriProc (): BOOLEAN;
BEGIN
nb.pri := SHORT (AngieMsg.code);
LOOP
ResetBroker();
IF co.CxObjError (br) = LONGSET {} THEN EXIT; END;
IF b.SimpleRequestArgs (ag.AngieWnd, LONGSET {b.lockWindow, b.ignoreTitle},
"", "Problems during resetting the broker",
"Retry|Quit Angie", NIL) = 0 THEN HALT (20); END;
END;
IF active THEN ActivateBroker (true); END;
RETURN true;
END PriProc;
PROCEDURE PriKeyProc (): BOOLEAN;
BEGIN
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
IF nb.pri >= MAX (SHORTINT) THEN RETURN true; END;
INC (nb.pri, 1);
ELSE
IF nb.pri <= MIN (SHORTINT) THEN RETURN true; END;
DEC (nb.pri, 1);
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDpri]^, ag.AngieWnd, NIL,
gt.slLevel, nb.pri, u.done);
AngieMsg.code := nb.pri;
RETURN PriProc();
END PriKeyProc;
PROCEDURE DelayProc (): BOOLEAN;
BEGIN
SetSnoopDelay (AngieMsg.code);
RETURN true;
END DelayProc;
PROCEDURE DelayKeyProc (): BOOLEAN;
BEGIN
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
SetSnoopDelay (snoopdelay + b.Max2 (1, snoopdelay DIV 10));
ELSE
SetSnoopDelay (snoopdelay - b.Max2 (1, snoopdelay DIV 10));
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDdelay]^, ag.AngieWnd, NIL,
gt.slLevel, snoopdelay, u.done);
RETURN true;
END DelayKeyProc;
PROCEDURE StableProc (): BOOLEAN;
BEGIN
SetStableTime (AngieMsg.code);
RETURN true;
END StableProc;
PROCEDURE StableKeyProc (): BOOLEAN;
BEGIN
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
SetStableTime (stabletime + b.Max2 (1, stabletime DIV 10));
ELSE
SetStableTime (stabletime - b.Max2 (1, stabletime DIV 10));
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDstable]^, ag.AngieWnd, NIL,
gt.slLevel, stabletime, u.done);
RETURN true;
END StableKeyProc;
PROCEDURE PopProc (): BOOLEAN;
BEGIN
cxpopup := I.selected IN AngieGad.flags;
RETURN true;
END PopProc;
PROCEDURE PopKeyProc(): BOOLEAN;
BEGIN
cxpopup := ~cxpopup;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDpop]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (cxpopup), u.done);
RETURN true;
END PopKeyProc;
PROCEDURE KeyActProc (): BOOLEAN;
BEGIN
keyactivate := I.selected IN AngieGad.flags;
RETURN true;
END KeyActProc;
PROCEDURE KeyActKeyProc (): BOOLEAN;
BEGIN
keyactivate := ~keyactivate;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDkeyact]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (keyactivate), u.done);
RETURN true;
END KeyActKeyProc;
PROCEDURE IncWinTaskPriProc (): BOOLEAN;
BEGIN
incwintaskpri := I.selected IN AngieGad.flags;
IF ~incwintaskpri THEN
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
END;
RETURN true;
END IncWinTaskPriProc;
PROCEDURE IncWinTaskPriKeyProc (): BOOLEAN;
BEGIN
incwintaskpri := ~incwintaskpri;
IF ~incwintaskpri THEN
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL;
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDincwintaskpri]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (incwintaskpri), u.done);
RETURN true;
END IncWinTaskPriKeyProc;
PROCEDURE HuntAlwaysProc (): BOOLEAN;
BEGIN
huntwindowalways := I.selected IN AngieGad.flags;
RETURN true;
END HuntAlwaysProc;
PROCEDURE HuntAlwaysKeyProc (): BOOLEAN;
BEGIN
huntwindowalways := ~huntwindowalways;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntalways]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (huntwindowalways), u.done);
RETURN true;
END HuntAlwaysKeyProc;
PROCEDURE HuntWinToFrontProc (): BOOLEAN;
BEGIN
huntwindowwfr := I.selected IN AngieGad.flags;
RETURN true;
END HuntWinToFrontProc;
PROCEDURE HuntWinToFrontKeyProc (): BOOLEAN;
BEGIN
huntwindowwfr := ~huntwindowwfr;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntwintofront]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (huntwindowwfr), u.done);
RETURN true;
END HuntWinToFrontKeyProc;
VAR
shufflepatprocstr: b.DynStrPtr;
PROCEDURE ShufflePatProc (): BOOLEAN;
VAR
pat: b.LStrPtr;
BEGIN
IF shufflestr # NIL THEN
pat := y.ADR (shufflestr[0]);
ELSE
pat := y.ADR ("#?");
END;
DISPOSE (shufflepatprocstr);
IF ~b.DynAppend (shufflepatprocstr, pat^) THEN END;
IF (AngieMsg.code = 27) OR
~SetShufflePattern (ag.AngieGadgets
[ag.GDshufflepat].specialInfo
(I.StringInfo).buffer^) THEN
IF shufflepatprocstr # NIL THEN
pat := y.ADR (shufflepatprocstr[0]);
ELSE
pat := y.ADR ("#?");
END;
IF ~SetShufflePattern (pat^) THEN END;
END;
IF shufflestr # NIL THEN
pat := y.ADR (shufflestr[0]);
ELSE
pat := y.ADR ("#?");
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDshufflepat]^, ag.AngieWnd, NIL,
gt.stString, pat, u.done);
RETURN true;
END ShufflePatProc;
PROCEDURE ShufflePatKeyProc (): BOOLEAN;
BEGIN
IF I.ActivateGadget (ag.AngieGadgets [ag.GDshufflepat]^,
ag.AngieWnd, NIL) THEN END;
RETURN true;
END ShufflePatKeyProc;
PROCEDURE ShuffleBDropProc (): BOOLEAN;
BEGIN
shufflebackdrop := I.selected IN AngieGad.flags;
RETURN true;
END ShuffleBDropProc;
PROCEDURE ShuffleBDropKeyProc (): BOOLEAN;
BEGIN
shufflebackdrop := ~shufflebackdrop;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDshufflebdrop]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (shufflebackdrop), u.done);
RETURN true;
END ShuffleBDropKeyProc;
PROCEDURE ScrStepsProc (): BOOLEAN;
BEGIN
scrMoveSteps := AngieMsg.code;
RETURN true;
END ScrStepsProc;
PROCEDURE ScrStepsKeyProc (): BOOLEAN;
BEGIN
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
scrMoveSteps := SHORT (b.Min2 (50, scrMoveSteps+1));
ELSE
scrMoveSteps := SHORT (b.Max2 (1, scrMoveSteps-1));
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDscrsteps]^, ag.AngieWnd, NIL,
gt.slLevel, scrMoveSteps, u.done);
RETURN true;
END ScrStepsKeyProc;
PROCEDURE WinStepsProc (): BOOLEAN;
BEGIN
winMoveSteps := AngieMsg.code;
RETURN true;
END WinStepsProc;
PROCEDURE WinStepsKeyProc (): BOOLEAN;
BEGIN
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
winMoveSteps := SHORT (b.Min2 (50, winMoveSteps+1));
ELSE
winMoveSteps := SHORT (b.Max2 (1, winMoveSteps-1));
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDwinsteps]^, ag.AngieWnd, NIL,
gt.slLevel, winMoveSteps, u.done);
RETURN true;
END WinStepsKeyProc;
PROCEDURE HuntDefPubProc (): BOOLEAN;
BEGIN
setdefpubonhunt := I.selected IN AngieGad.flags;
RETURN true;
END HuntDefPubProc;
PROCEDURE HuntDefPubKeyProc (): BOOLEAN;
BEGIN
setdefpubonhunt := ~setdefpubonhunt;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDhuntdefpub]^, ag.AngieWnd, NIL,
gt.cbChecked, BoolToLBool (setdefpubonhunt), u.done);
RETURN true;
END HuntDefPubKeyProc;
CONST
newItemTxt ="(new entry)";
PROCEDURE AddProc (): BOOLEAN;
VAR
l1, l2: LONGINT;
BEGIN
l1 := b.DynTTLen (hotdefs);
SuspendHotKeyDisplay();
IF AddHotKey (0, newItemTxt, "", SelectedHotKey+1, insertMode) THEN END;
l2 := b.DynTTLen (hotdefs);
IF l1 < l2 THEN
INC (SelectedHotKey);
ELSE
I.DisplayBeep (ag.AngieWnd.wScreen);
END;
UpdateHotKeyDisplay ({fixType});
IF (SelectedHotKey >= 0) & (l1 < l2) THEN
IF I.ActivateGadget (ag.AngieGadgets [ag.GDdefinition]^,
ag.AngieWnd, NIL) THEN END;
END;
RETURN true;
END AddProc;
PROCEDURE DelProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
SuspendHotKeyDisplay();
DelHotKey (SelectedHotKey);
UpdateHotKeyDisplay ({fixType});
RETURN true;
END DelProc;
PROCEDURE UpProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
IF SelectedHotKey > 0 THEN
SuspendHotKeyDisplay();
IF SwapHotKeys (SelectedHotKey, SelectedHotKey-1) THEN
DEC (SelectedHotKey);
ELSE
I.DisplayBeep (ag.AngieWnd.wScreen);
END;
END;
UpdateHotKeyDisplay ({fixType});
RETURN true;
END UpProc;
PROCEDURE DownProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
IF SelectedHotKey < b.DynTTLen (hotdefs)-1 THEN
SuspendHotKeyDisplay();
IF SwapHotKeys (SelectedHotKey, SelectedHotKey+1) THEN
INC (SelectedHotKey);
ELSE
I.DisplayBeep (ag.AngieWnd.wScreen);
END;
END;
UpdateHotKeyDisplay ({fixType});
RETURN true;
END DownProc;
VAR
chaux: b.DynStrPtr;
PROCEDURE ChangeHotKeyType (type: LONGINT; text: ARRAY OF CHAR);
VAR
nd : HotKeyNodePtr;
succ: BOOLEAN;
oldtype: LONGINT;
(* $CopyArrays- *)
BEGIN
oldtype := 0;
succ := false;
IF SelectedHotKey < 0 THEN RETURN; END;
nd := GetHotKeyNode (SelectedHotKey);
IF IsValidId (type) THEN
type := AdaptIdToEntry (type, SelectedHotKey);
DISPOSE (chaux);
IF b.DynAppend (chaux, text) THEN
DISPOSE (nd.text);
nd.text := chaux; chaux := NIL;
END;
oldtype := nd.type;
nd.type := type;
co.DeleteCxObjAll (nd.cxobj); nd.cxobj := NIL;
IF PlainId (type) # noKeyActivate THEN
nd.cxobj := cx.HotKey (nd.node.name^, nb.port, type);
IF IsNoKeyScrActId (type) THEN y.SETREG (0, co.SetCxObjPri (nd.cxobj, 2)); END;
IF br # NIL THEN co.EnqueueCxObj (br, nd.cxobj); END;
succ := nd.cxobj # NIL;
ELSE
succ := co.ParseIX (nd.node.name^, DummyIX) = 0;
END;
IF (PlainId (oldtype) = noKeyActivate) OR (PlainId (type) = noKeyActivate) THEN
ResetNoActScrKeys();
END;
END;
IF ~succ THEN I.DisplayBeep (ag.AngieWnd.wScreen); END;
UpdateHotKeyDisplay ({});
RETURN;
END ChangeHotKeyType;
PROCEDURE TypeProc (): BOOLEAN;
VAR
type: LONGINT;
i : INTEGER;
str: e.STRPTR;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
str := ag.AngieGadgets [ag.GDtype].specialInfo (I.StringInfo).buffer;
i := 0;
WHILE (i < hotKeys) & (u.Stricmp (str^, hotnames[i]^) # 0) DO INC (i); END;
IF i >= hotKeys THEN i := custom; END;
type := i;
IF AngieMsg.code # 27 THEN
IF i # custom THEN str := y.ADR (""); END;
ChangeHotKeyType (AttrsOfId (GetHotKeyNode (SelectedHotKey).type) + type, str^);
END;
UpdateHotKeyDisplay ({fixType});
RETURN true;
END TypeProc;
PROCEDURE MTypeProc (): BOOLEAN;
VAR
str: e.STRPTR;
nd : HotKeyNodePtr;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
nd := GetHotKeyNode (SelectedHotKey);
IF (AngieMsg.code = PlainId (nd.type)) & (AngieMsg.code = custom) THEN
str := y.ADR (nd.text[0]);
ELSE
str := y.ADR ("");
END;
ChangeHotKeyType (AttrsOfId (nd.type) + AngieMsg.code, str^);
UpdateHotKeyDisplay ({fixType});
RETURN true;
END MTypeProc;
PROCEDURE TypeKeyProc (): BOOLEAN;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
IF I.ActivateGadget (ag.AngieGadgets [ag.GDtype]^,
ag.AngieWnd, NIL) THEN END;
RETURN true;
END TypeKeyProc;
PROCEDURE AttrsProc (): BOOLEAN;
VAR
nd: HotKeyNodePtr;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
nd := GetHotKeyNode (SelectedHotKey);
ChangeHotKeyType (PlainId (nd.type) + ASH (AngieMsg.code, 8), nd.text^);
RETURN true;
END AttrsProc;
PROCEDURE AttrsKeyProc (): BOOLEAN;
VAR
cyc: LONGINT;
nd : HotKeyNodePtr;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
nd := GetHotKeyNode (SelectedHotKey);
cyc := ASH (AttrsOfId (nd.type), -8);
IF {ie.lShift, ie.rShift} * AngieMsg.qualifier = {} THEN
INC (cyc, 1); IF cyc >= 8 THEN cyc := 0; END;
ELSE
DEC (cyc, 1); IF cyc < 0 THEN cyc := 7; END;
END;
gt.SetGadgetAttrs (ag.AngieGadgets [ag.GDattrs]^, ag.AngieWnd, NIL,
gt.cyActive, cyc, u.done);
ChangeHotKeyType (PlainId (nd.type) + ASH (cyc, 8), nd.text^);
RETURN true;
END AttrsKeyProc;
PROCEDURE ProperType (type: LONGINT): LONGINT;
VAR
i : INTEGER;
type1: LONGINT;
BEGIN
type1 := PlainId (type);
FOR i := 0 TO LEN (attrs)-1 DO
IF attrs[i].isProc (type) THEN INC (type1, attrs[i].const); END;
END;
RETURN type1;
END ProperType;
PROCEDURE MAttrsProc (): BOOLEAN;
VAR
nd: HotKeyNodePtr;
BEGIN
IF SelectedHotKey < 0 THEN RETURN true; END;
nd := GetHotKeyNode (SelectedHotKey);
ChangeHotKeyType (ProperType (PlainId (nd.type) + GetMenuAttrs ()), nd.text^);
RETURN true;
END MAttrsProc;
PROCEDURE BoolToInt (b: BOOLEAN): INTEGER;
BEGIN
IF b THEN RETURN 1; END;
RETURN 0;
END BoolToInt;
TYPE
BoolStrArr = ARRAY 2 OF b.LStrPtr;
CONST
boolstrs = BoolStrArr (y.ADR ("NO"), y.ADR ("YES"));
VAR
newdtt : b.DynTTPtr;
saveaux: b.DynStrPtr;
ad : ARRAY 2 OF CHAR;
do : wb.DiskObjectPtr;
dott : b.TTPtr;
arg : ARRAY 2 OF e.APTR;
wlk : b.WinLockPtr;
PROCEDURE SaveProcCleanUp(): BOOLEAN; (* NOTEZ-BIEN: Amiga-Oberon3.00 compiles
trash if this is located within SaveProc()
and you invoke SaveProc() using
'function pointer' indirection !! *)
BEGIN
IF do # NIL THEN
do.toolTypes := dott;
ic.FreeDiskObject (do); do := NIL;
END;
b.FreeDynTT (newdtt); DISPOSE (saveaux);
b.UnlockWindow (wlk);
RETURN true;
END SaveProcCleanUp;
PROCEDURE WriteStrTT (name, val: ARRAY OF CHAR): BOOLEAN;
(* $CopyArrays- *)
BEGIN
arg[0] := y.ADR (name[0]); arg[1] := y.ADR (val[0]);
IF saveaux # NIL THEN saveaux[0] := '\000'; END;
IF ~b.VDSPrintf (saveaux, "%s=%s", y.ADR (arg[0])) THEN RETURN false END;
IF ~b.DynAppendTT (newdtt, saveaux^, {}) THEN RETURN false; END;
RETURN true;
END WriteStrTT;
PROCEDURE WriteBoolTT (name: ARRAY OF CHAR; b: BOOLEAN): BOOLEAN;
(* $CopyArrays- *)
BEGIN
RETURN WriteStrTT (name, boolstrs [BoolToInt (b)]^);
END WriteBoolTT;
PROCEDURE WriteIntTT (name: ARRAY OF CHAR; val: LONGINT): BOOLEAN;
(* $CopyArrays- *)
BEGIN
arg[0] := y.ADR (name[0]); arg[1] := val;
IF saveaux # NIL THEN saveaux[0] := '\000'; END;
IF ~b.VDSPrintf (saveaux, "%s=%ld", y.ADR (arg[0])) THEN RETURN false END;
IF ~b.DynAppendTT (newdtt, saveaux^, {}) THEN RETURN false; END;
RETURN true;
END WriteIntTT;
PROCEDURE SaveProc (): BOOLEAN;
VAR
i,n: LONGINT;
j,k: INTEGER;
nd: HotKeyNodePtr;
pat: b.LStrPtr;
BEGIN
b.FreeDynTT (newdtt); DISPOSE (saveaux);
wlk := b.LockWindow (ag.AngieWnd, wlk);
do := ic.GetDiskObjectNew (prefsName);
IF do = NIL THEN RETURN SaveProcCleanUp(); END;
dott := do.toolTypes;
IF ~b.DynAppendTT (newdtt, doNotWaitStr, {}) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (cxPopUpStr, cxpopup) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteIntTT (cxPriorityStr, nb.pri) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (keyActivateStr, keyactivate) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (shuffleBackdropStr, shufflebackdrop) THEN RETURN SaveProcCleanUp() END;
IF shufflestr # NIL THEN pat := y.ADR (shufflestr[0]); ELSE pat := y.ADR ("#?") END;
IF ~WriteStrTT (shufflePatStr, pat^) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (huntAlwaysStr, huntwindowalways) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (huntWinToFrontStr, huntwindowwfr) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (huntSetDefPubModeStr, setdefpubonhunt) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteIntTT (stableTimeStr, stabletime) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteIntTT (snoopDelayStr, snoopdelay) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteBoolTT (incWinTaskPriStr, incwintaskpri) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteIntTT (scrMoveStepsStr, scrMoveSteps) THEN RETURN SaveProcCleanUp(); END;
IF ~WriteIntTT (winMoveStepsStr, winMoveSteps) THEN RETURN SaveProcCleanUp(); END;
FOR i := 0 TO b.DynTTLen (hotdefs)-1 DO
nd := GetHotKeyNode (i);
DISPOSE (saveaux);
IF ~b.VDSPrintf (saveaux, "%s=", y.ADR (hotnames[PlainId (nd.type)])) THEN
RETURN SaveProcCleanUp();
END;
ad[0] := "\000"; arg[0] := y.ADR (ad[0]);
FOR k := 0 TO LEN (attrs)-1 DO
IF attrs[k].isProc (nd.type) THEN
arg[1] := attrs[k].name;
IF ~b.VDSPrintf (saveaux, "%s%s", y.ADR (arg[0])) THEN RETURN SaveProcCleanUp(); END;
ad[0] := '|';
END;
END;
FOR n := 0 TO st.Length (saveaux^)-1 DO saveaux[n] := u.ToUpper (saveaux[n]); END;
IF ~b.VDSPrintf (saveaux, ":%s", y.ADR (nd.node.name)) THEN RETURN SaveProcCleanUp(); END;
IF PlainId (nd.type) = custom THEN
arg[1] := y.ADR (nd.text[0]);
IF ~b.VDSPrintf (saveaux, "\x1b%s", y.ADR (arg[1])) THEN RETURN SaveProcCleanUp(); END;
END;
IF ~b.DynAppendTT (newdtt, saveaux^, {}) THEN RETURN SaveProcCleanUp(); END;
END; (* FOR *)
IF dott # NIL THEN
i := 0;
WHILE dott[i] # NIL DO
LOOP
FOR j := 0 TO hotKeys-1 DO
IF b.CmpToolNames (hotnames[j]^ , dott[i]^) THEN EXIT; END;
END;
FOR j := 0 TO LEN (miscTTNames)-1 DO
IF b.CmpToolNames (miscTTNames[j]^, dott[i]^) THEN EXIT; END;
END;
IF ~b.DynAppendTT (newdtt, dott[i]^, {}) THEN RETURN SaveProcCleanUp(); END;
EXIT;
END; (* LOOP *)
INC (i);
END; (* WHILE *);
END;
IF ~b.DynAppendTT (newdtt, "", {b.createEmpty}) THEN RETURN SaveProcCleanUp(); END;
do.toolTypes := b.TTAPtr (newdtt);
y.SETREG (0, ic.PutDiskObject (prefsName, do));
RETURN SaveProcCleanUp();
END SaveProc;
PROCEDURE HideProc (): BOOLEAN;
BEGIN
RETURN false; (* signal: CloseWindow *)
END HideProc;
PROCEDURE AboutProc (): BOOLEAN;
VAR
act: BOOLEAN;
BEGIN
act := active;
ActivateBroker (false);
IF b.SimpleRequestArgs (ag.AngieWnd, LONGSET {b.lockWindow, b.ignoreTitle},
"", "%s\n\n %s - Commodity\n\n Written & © 1993 by\n"
" Franz Schwarz\n Mühlenstraße 2\n"
" D-78591 Durchhausen, Germany\n"
" Uucp: Franz_Schwarz@mil.ka.sub.org\n"
" Fido: 2:2476/506.18\n\n"
" GUI created with assistance of GadToolsBox 37.300\n\n"
"Since Angie is Giftware you are encouraged to send the\n"
"author a present, money, a postcard, etc. if you use it.",
"Terrific", y.ADR (nb.title)) = 0 THEN END;
ActivateBroker (act);
RETURN true;
END AboutProc;
PROCEDURE QuitProc (): BOOLEAN;
BEGIN
HALT (0);
RETURN true;
END QuitProc;
CONST
gadProcs = GadProcArrT (DefinitionProc, HotKeysProc, PriProc, DelayProc,
StableProc, PopProc, KeyActProc, IncWinTaskPriProc,
HuntAlwaysProc, HuntWinToFrontProc, TypeProc,
ShuffleBDropProc, ScrStepsProc, WinStepsProc,
HuntDefPubProc, AddProc, DelProc, UpProc, DownProc,
ShufflePatProc, AttrsProc);
CONST
gadKeyProcs = GadProcArrT (DefinitionKeyProc, HotKeysKeyProc,
PriKeyProc, DelayKeyProc, StableKeyProc,
PopKeyProc, KeyActKeyProc,
IncWinTaskPriKeyProc, HuntAlwaysKeyProc,
HuntWinToFrontKeyProc, TypeKeyProc,
ShuffleBDropKeyProc, ScrStepsKeyProc,
WinStepsKeyProc, HuntDefPubKeyProc,
AddProc, DelProc, UpProc, DownProc,
ShufflePatKeyProc, AttrsKeyProc);
TYPE
MenuPair = STRUCT
id : LONGINT;
proc: PROCEDURE (): BOOLEAN;
END;
menuPairArrT = ARRAY 7 OF MenuPair;
CONST
menuProcs = menuPairArrT (ag.MNsave, SaveProc, ag.MNabout, AboutProc,
ag.MNhide, HideProc, ag.MNquit, QuitProc,
MNfrontattr, MAttrsProc, MNnokeyscractattr, MAttrsProc,
MNrepeatattr, MAttrsProc);
PROCEDURE GUIMsgHandler();
VAR
m : I.IntuiMessagePtr;
i,j: LONGINT;
mi : I.MenuItemPtr;
BEGIN
LOOP
IF ag.AngieWnd = NIL THEN RETURN; END;
m := gt.GetIMsg (ag.AngieWnd.userPort);
IF m = NIL THEN RETURN; END;
AngieMsg := m^;
gt.ReplyIMsg (m);
IF I.refreshWindow IN AngieMsg.class THEN
gt.BeginRefresh (ag.AngieWnd);
gt.EndRefresh (ag.AngieWnd, e.true);
ELSIF I.closeWindow IN AngieMsg.class THEN
CloseGUI();
RETURN;
ELSIF I.vanillaKey IN AngieMsg.class THEN
LOOP
FOR i := 0 TO LEN (ag.AngieGadgets)-1 DO
IF u.ToUpper (CHR (AngieMsg.code)) = ag.AngieHotKeys [i] THEN
IF ~gadKeyProcs [i]() THEN CloseGUI(); RETURN; END;
EXIT;
END;
END; (* FOR *)
IF AngieMsg.code = 27 THEN CloseGUI(); RETURN; END; (* ESC key *)
IF u.ToUpper (CHR (AngieMsg.code)) = 'Z' THEN
I.ZipWindow (ag.AngieWnd);
EXIT;
END;
EXIT;
END; (* LOOP *)
ELSIF I.rawKey IN AngieMsg.class THEN
CASE AngieMsg.code OF
ag.rawCrsrUp, ag.rawCrsrDown: (* ListView cursor browsing *)
IF ~gadKeyProcs [ag.GDhotkeys]() THEN CloseGUI(); RETURN; END;
ELSE END;
ELSIF LONGSET {I.gadgetUp, I.gadgetDown} * AngieMsg.class # LONGSET {} THEN
AngieGad := AngieMsg.iAddress;
IF AngieGad # NIL THEN
i := AngieGad.gadgetID;
IF (i >= 0) & (i < LEN (gadProcs)) THEN
IF ~gadProcs [i]() THEN CloseGUI(); RETURN; END;
END;
END;
ELSIF I.menuPick IN AngieMsg.class THEN
LOOP
IF AngieMsg.code = I.menuNull THEN EXIT; END;
mi := I.ItemAddress (ag.AngieMenus^, AngieMsg.code);
i := gt.MenuItemUserData (mi);
LOOP
FOR j := 0 TO LEN (menuProcs)-1 DO
IF i = menuProcs[j].id THEN
IF ~menuProcs [j].proc() THEN CloseGUI(); RETURN; END;
EXIT;
END;
END; (* FOR *)
IF (i >= 0) & (i < hotKeys) THEN
AngieMsg.code := SHORT (i);
IF ~MTypeProc() THEN CloseGUI(); RETURN; END;
END;
EXIT;
END; (* LOOP *)
AngieMsg.code := mi.nextSelect;
END; (* LOOP *)
END;
END;
END GUIMsgHandler;
PROCEDURE DoScrActivateMagic (ev: ie.InputEventPtr);
VAR
lk : LONGINT;
w, actw : I.WindowPtr;
s : I.ScreenPtr;
nev : ie.InputEventPtr;
BEGIN
actw := NIL;
IF ev = NIL THEN RETURN; END;
lk := I.LockIBase (0);
LOOP
w := I.int.activeWindow;
IF (w # NIL) & (I.menuState IN w.flags) THEN EXIT; END;
s := I.int.activeScreen;
IF s = NIL THEN EXIT; END;
IF ~(g.vpHide IN s.viewPort.modes) THEN EXIT; END;
actw := GetBestWin ();
y.SETREG (0, e.SetTaskPri (chieftask, 100));
EXIT;
END;
I.UnlockIBase (lk);
IF actw # NIL THEN I.ActivateWindow (actw); END;
y.SETREG (0, e.SetTaskPri (chieftask, chiefpri));
nev := ev.nextEvent; ev.nextEvent := NIL;
co.AddIEvents (ev);
ev.nextEvent := nev;
END DoScrActivateMagic;
PROCEDURE MsgHandler;
VAR
flgs : LONGSET;
msg : e.APTR;
msgid : LONGINT;
msgtype : LONGSET;
ev : ie.InputEventPtr;
qualifier : SET;
BEGIN
LOOP
flgs := e.Wait (LONGSET {d.ctrlC, nb.port.sigBit, dinfosig, guiwndsig});
IF dinfosig IN flgs THEN
IF huntwindowalways OR incwintaskpri OR (IncTask # NIL) THEN
DoIntuiAction (sendHuntSigd);
END;
END;
IF (guiwndsig IN flgs) & (guiwndsig # d.ctrlC) THEN
GUIMsgHandler();
END;
IF nb.port.sigBit IN flgs THEN
LOOP
msg := e.GetMsg (nb.port);
IF msg = NIL THEN EXIT; END;
ev := NIL; qualifier := {};
msgid := co.CxMsgID (msg);
msgtype := co.CxMsgType (msg);
IF msgtype = LONGSET {co.cxmIEvent} THEN
ev := co.CxMsgData (msg);
IF ev # NIL THEN qualifier := ev.qualifier; END;
END;
IF (msgtype = LONGSET {co.cxmIEvent}) & (msgid = scrActivateMagic) THEN
DoScrActivateMagic (ev);
msgtype := LONGSET {};
END;
e.ReplyMsg (msg);
IF msgtype = LONGSET {co.cxmIEvent} THEN
IF PlainId (msgid) = popGUI THEN
IF OpenGUI() THEN END;
ELSIF ~(~IsRepeatId (msgid) & (ie.repeat IN qualifier)) THEN
DoIntuiAction (msgid);
END;
ELSIF msgtype = LONGSET {co.cxmCommand} THEN
CASE msgid OF
co.cmdKill:
HALT (0); |
co.cmdEnable:
ActivateBroker (true); |
co.cmdDisable:
ActivateBroker (false);
y.SETREG (0, SecureSetTaskPri (IncTask, OldPri)); IncTask := NIL; |
co.cmdAppear, co.cmdUnique:
IF OpenGUI() THEN END; |
co.cmdDisappear:
CloseGUI();
ELSE END;
END;
END; (* LOOP *)
END;
IF d.ctrlC IN flgs THEN HALT (5); END;
END;
END MsgHandler;
BEGIN
Init();
MsgHandler();
CLOSE
CleanUp();
END Angie.