Copyright (C) 1994, Digital Equipment Corp.
by Steve Glassman, Mark Manasse and Greg Nelson
<*PRAGMA LL*> UNSAFE MODULEIMPORT Fmt, NTDebug;; IMPORT Axis, Ctypes, M3toC, NT, NTClient, NTClientF, NTScreenType, Point, Rect, Region, RTParamsWin32, Split, Thread, TrestleClass, TrestleComm, TrestleOnNT, VBT, VBTClass, WinDef, WinNT, WinUser, Word; NTMsgs
VAR mu := NEW(MUTEX); cv := NEW(Thread.Condition); <* LL = my *> cnt := 0; (* count of active message loops *) creating := FALSE; (* TRUE if in Create *) vCreate: VBT.T := NIL; (* IF creating then vCreate = Create(ch) *) VAR defaultAllMessages := FALSE; <* LL = mu *> VAR hAccelTable: WinNT.HANDLE; windowclassName, nullWindowclassName: Ctypes.CharStar; hInst: WinDef.HINSTANCE; nShowCmd: Ctypes.int; PROCEDUREDefaultAllMessages () = BEGIN LOCK mu DO defaultAllMessages := TRUE END; END DefaultAllMessages; TYPE Closure = Thread.Closure OBJECT conn : NTClient.T; ch : VBT.T; st : NTScreenType.T; x, y: INTEGER; iconic: BOOLEAN; OVERRIDES apply := Loop; END; <* LL = VBT.mu *> PROCEDURECreateNTWindow (conn : NTClient.T; ch : VBT.T; st : NTScreenType.T; x, y : INTEGER; iconic: BOOLEAN ) RAISES {TrestleComm.Failure} = BEGIN LOCK conn DO EVAL (Thread.Fork(NEW(Closure, conn := conn, ch := ch, st := st, x := x, y := y, iconic := iconic))); REPEAT Thread.Wait(conn, cv); UNTIL NARROW(ch.upRef, NTClientF.Child).hwnd # NT.CNULL; END; END CreateNTWindow; <* LL = VBT.mu *> PROCEDURECreate (conn : NTClient.T; ch : VBT.T; st : NTScreenType.T; x, y : INTEGER; iconic: BOOLEAN ) = VAR s : ARRAY Axis.T OF VBT.SizeRange; cs : WinUser.CREATESTRUCT; title: Ctypes.CharStar; ur : NTClientF.Child; hwnd : WinDef.HWND; dec: TrestleClass.Decoration := VBT.GetProp(ch, TYPECODE( TrestleClass.Decoration)); BEGIN NT.BAssert(dec # NIL); VBTClass.Rescreen(ch, st); s := VBTClass.GetShapes(ch); LOCK conn DO ur := ch.upRef; IF iconic THEN title := M3toC.TtoS(dec.iconTitle) ELSE title := M3toC.TtoS(dec.windowTitle) END; ur.sh := s[Axis.T.Hor]; ur.sv := s[Axis.T.Ver]; ur.conn := conn; END; LOCK mu DO creating := TRUE; vCreate := ch; END; hwnd := WinUser.CreateWindow( windowclassName, title, WinUser.WS_OVERLAPPEDWINDOW, x, y, s[Axis.T.Hor].pref, s[Axis.T.Ver].pref, NT.CNULL, NT.CNULL, hInst, ADR(cs)); LOCK conn DO ur.hwnd := hwnd; END; NT.BAssert(hwnd # NT.CNULL); EVAL (WinUser.SetWindowLong( hwnd, WinUser.GWL_USERDATA, LOOPHOLE(ch, WinNT.LONG))); TRY IF dec # NIL THEN NTClientF.SetDecoration(conn, ch, ur, ur.hwnd, NIL, dec); END; EXCEPT | TrestleComm.Failure => NT.Assert(0); (* should transfer failure to CreateNTWindow *) END; EVAL WinUser.ShowWindow(hwnd, nShowCmd); (* ??? *) NT.Assert(WinUser.UpdateWindow(hwnd)); LOCK mu DO creating := FALSE END; END Create; VAR nullHwnd := NT.CNULL; PROCEDURENullWindow (<* UNUSED *> trsl: NTClient.T): WinDef.HWND = VAR cs: WinUser.CREATESTRUCT; BEGIN IF nullHwnd = NT.CNULL THEN nullHwnd := WinUser.CreateWindow( nullWindowclassName, NT.CNULL, WinUser.WS_DISABLED, WinUser.CW_USEDEFAULT, WinUser.CW_USEDEFAULT, WinUser.CW_USEDEFAULT, WinUser.CW_USEDEFAULT, NT.CNULL, NT.CNULL, hInst, ADR(cs)); NT.BAssert(nullHwnd # NT.CNULL); END; RETURN nullHwnd; END NullWindow; PROCEDUREGetVBT (hwnd: WinDef.HWND): VBT.T = VAR v: VBT.T := LOOPHOLE(WinUser.GetWindowLong(hwnd, WinUser.GWL_USERDATA), VBT.T); BEGIN IF v # NIL THEN RETURN v ELSE LOCK mu DO NT.BAssert(creating); RETURN vCreate; END; END; END GetVBT; PROCEDUREExtendOwns (VAR sa: NTClientF.OwnsArray; s: VBT.Selection) = VAR n := NUMBER(sa^); na: NTClientF.OwnsArray; BEGIN IF s.sel > LAST(sa^) THEN na := NEW(NTClientF.OwnsArray, MAX(2 * n, s.sel + 1)); SUBARRAY(na^, 0, n) := sa^; FOR i := n TO LAST(na^) DO na[i] := FALSE END; sa := na END END ExtendOwns; PROCEDUREExtendSel (VAR sa: NTClientF.SelArray; s: VBT.Selection) = VAR n := NUMBER(sa^); na: NTClientF.SelArray; BEGIN IF s.sel > LAST(sa^) THEN na := NEW(NTClientF.SelArray, MAX(2 * n, s.sel + 1)); SUBARRAY(na^, 0, n) := sa^; FOR i := n TO LAST(na^) DO na[i] := NTClientF.SelectionRecord{} END; sa := na END END ExtendSel; PROCEDUREFixSel (v: VBT.T; sel: VBT.Selection; set: BOOLEAN) = VAR ur : NTClientF.Child := v.upRef; conn := ur.conn; BEGIN LOCK conn DO ExtendOwns(ur.owns, sel); ExtendSel(conn.sel, sel); ur.owns[sel.sel] := set; IF set THEN conn.sel[sel.sel].v := v ELSIF conn.sel[sel.sel].v = v THEN conn.sel[sel.sel].v := NIL; END; END; VBTClass.Misc(v, VBT.MiscRec{VBT.Lost, VBT.NullDetail, 0, sel}) END FixSel; TYPE Last = RECORD x, y : INTEGER := 0; root : WinDef.HWND; time : WinDef.LONG := 0; button : VBT.Modifier := VBT.Modifier.Shift; (* non button value *) clickCount: CARDINAL := 0; safetyRadius, doubleClickInterval: CARDINAL := 0; END;
last{x,y} = position of last mouseclick; lastRoot = root window of last mouseclick; lastTime = time of last mouseClick; lastClickCount = clickcount of last mouseclick, as defined in the VBT interface; lastButton = button that last went up or down.
VAR
last:= Last{root := NT.CNULL};
(* should be one per trestle connection? *)
<* MSCWIN *>
PROCEDURE WindowProc (hwnd : WinDef.HWND;
message: WinDef.UINT;
wParam : WinDef.WPARAM;
lParam : WinDef.LPARAM ): WinDef.LRESULT =
VAR
res : WinDef.LRESULT := 0;
v := GetVBT(hwnd);
ur : NTClientF.Child := v.upRef;
vbtmu: BOOLEAN;
BEGIN
LOCK mu DO vbtmu := creating; END;
TRY
CASE message OF
| WinUser.WM_ACTIVATE =>
RETURN WinUser.DefWindowProc(hwnd, message, wParam, lParam);
| WinUser.WM_CHAR => (* NYI *)
| WinUser.WM_DESTROY =>
IF vbtmu THEN
NTClientF.Delete(ur.conn, v, v.upRef);
ELSE
LOCK VBT.mu DO NTClientF.Delete(ur.conn, v, v.upRef); END;
END;
WinUser.PostQuitMessage(0);
| WinUser.WM_ERASEBKGND => (* do nothing *)
| WinUser.WM_GETMINMAXINFO =>
VAR szs: ARRAY Axis.T OF VBT.SizeRange;
BEGIN
IF vbtmu THEN
szs := VBTClass.GetShapes(v)
ELSE
LOCK VBT.mu DO szs := VBTClass.GetShapes(v) END
END;
WITH lpmmi = LOOPHOLE(lParam, WinUser.LPMINMAXINFO) DO
lpmmi.ptMaxSize.x := szs[Axis.T.Hor].hi;
lpmmi.ptMaxSize.y := szs[Axis.T.Ver].hi;
lpmmi.ptMinTrackSize.x := szs[Axis.T.Hor].lo;
lpmmi.ptMinTrackSize.y := szs[Axis.T.Ver].lo;
lpmmi.ptMaxTrackSize.x := szs[Axis.T.Hor].hi;
lpmmi.ptMaxTrackSize.y := szs[Axis.T.Ver].hi;
END;
END;
| WinUser.WM_KILLFOCUS => FixSel(v, VBT.KBFocus, FALSE);
| WinUser.WM_LBUTTONDOWN, WinUser.WM_LBUTTONUP,
WinUser.WM_RBUTTONDOWN, WinUser.WM_RBUTTONUP,
WinUser.WM_MBUTTONDOWN, WinUser.WM_MBUTTONUP =>
IF vbtmu THEN
ButtonEvent(
hwnd, message, WinDef.LOWORD(lParam), WinDef.HIWORD(lParam),
wParam, v, ur, ur.conn, last)
ELSE
LOCK VBT.mu DO
ButtonEvent(
hwnd, message, WinDef.LOWORD(lParam),
WinDef.HIWORD(lParam), wParam, v, ur, ur.conn, last)
END;
END;
| WinUser.WM_MOUSEACTIVATE => RETURN WinUser.MA_ACTIVATE;
| WinUser.WM_MOUSEMOVE =>
(* check everywhere cage for fast path *)
IF vbtmu THEN
IF NOT ur.everywhereCage THEN
MouseMoveEvent(WinDef.LOWORD(lParam), WinDef.HIWORD(lParam),
wParam, v, ur, ur.conn)
END;
ELSE
LOCK VBT.mu DO
IF NOT ur.everywhereCage THEN
MouseMoveEvent(
WinDef.LOWORD(lParam), WinDef.HIWORD(lParam), wParam, v,
ur, ur.conn)
END;
END;
END;
| WinUser.WM_PAINT =>
VAR rc: WinDef.RECT;
BEGIN
IF NT.True(WinUser.GetUpdateRect(hwnd, ADR(rc), NT.F)) THEN
NT.Assert(WinUser.ValidateRect(hwnd, ADR(rc)));
IF vbtmu THEN
VBTClass.Repaint(v, Region.FromRect(NT.ToRect(rc)));
ELSE
LOCK VBT.mu DO
VBTClass.Repaint(v, Region.FromRect(NT.ToRect(rc)));
END;
END;
END;
END;
| WinUser.WM_SETFOCUS => FixSel(v, VBT.KBFocus, TRUE);
| WinUser.WM_SYSCOMMAND =>
WITH res = WinUser.DefWindowProc(hwnd, message, wParam, lParam) DO
LOCK ur.conn DO NTClientF.SetTitle(ur.conn, v, ur); END;
END;
| WinUser.WM_WINDOWPOSCHANGED =>
VAR
rc : WinDef.RECT;
new: Rect.T;
BEGIN
NT.Assert(WinUser.GetClientRect(hwnd, ADR(rc)));
new := NT.ToRect(rc);
IF vbtmu THEN
IF v.domain # new THEN
VBTClass.Reshape(v, new, Rect.Empty);
ELSE
VBTClass.Misc(
v, VBT.MiscRec{VBT.Moved, VBT.NullDetail, 0, VBT.NilSel})
END;
ELSE
LOCK VBT.mu DO
IF v.domain # new THEN
VBTClass.Reshape(v, new, Rect.Empty);
ELSE
VBTClass.Misc(v, VBT.MiscRec{VBT.Moved, VBT.NullDetail,
0, VBT.NilSel})
END;
END;
END;
END;
(* -----------------------------------------------------------------
The following are informational messages which we might use *)
| WinUser.WM_ACTIVATEAPP =>
| WinUser.WM_CREATE =>
| WinUser.WM_QUERYNEWPALETTE =>
(* ----------------------------------------------------------------
The following are messages which we might handle, but for now
let the DefWindowProc take them *)
| WinUser.WM_CANCELMODE, WinUser.WM_CLOSE, WinUser.WM_ICONERASEBKGND,
WinUser.WM_PAINTICON, WinUser.WM_PALETTECHANGED,
WinUser.WM_PALETTEISCHANGING, WinUser.WM_SETCURSOR,
WinUser.WM_SHOWWINDOW, WinUser.WM_WINDOWPOSCHANGING =>
RETURN WinUser.DefWindowProc(hwnd, message, wParam, lParam);
(* -----------------------------------------------------------------
The following are messages which the DefWindowProc should
handle *)
| WinUser.WM_ENTERIDLE, WinUser.WM_ENTERMENULOOP,
WinUser.WM_ENTERSIZEMOVE_UNDOCUMENTED, WinUser.WM_INITMENU,
WinUser.WM_INITMENUPOPUP, WinUser.WM_EXITMENULOOP,
WinUser.WM_EXITSIZEMOVE_UNDOCUMENTED, WinUser.WM_GETTEXT,
WinUser.WM_GETTEXTLENGTH, WinUser.WM_KEYDOWN, WinUser.WM_KEYUP,
WinUser.WM_DEADCHAR, WinUser.WM_MENUSELECT, WinUser.WM_NCCREATE,
WinUser.WM_NCDESTROY, WinUser.WM_NCCALCSIZE,
WinUser.WM_NCHITTEST, WinUser.WM_NCPAINT, WinUser.WM_NCACTIVATE,
WinUser.WM_GETDLGCODE, WinUser.WM_NCMOUSEMOVE,
WinUser.WM_NCLBUTTONDOWN, WinUser.WM_NCLBUTTONUP,
WinUser.WM_NCLBUTTONDBLCLK, WinUser.WM_NCRBUTTONDOWN,
WinUser.WM_NCRBUTTONUP, WinUser.WM_NCRBUTTONDBLCLK,
WinUser.WM_NCMBUTTONDOWN, WinUser.WM_NCMBUTTONUP,
WinUser.WM_NCMBUTTONDBLCLK, WinUser.WM_QUERYOPEN,
WinUser.WM_SETTEXT, WinUser.WM_SYSCHAR, WinUser.WM_SYSDEADCHAR,
WinUser.WM_SYSKEYDOWN, WinUser.WM_SYSKEYUP =>
RETURN WinUser.DefWindowProc(hwnd, message, wParam, lParam);
(* ----------------------------------------------------------------
The following are messages which should only occur during window
initialization *)
| WinUser.WM_MOVE, WinUser.WM_SIZE => NT.BAssert(vbtmu);
(* The following are "dangerous" messages which should not
happen *)
| WinUser.WM_LBUTTONDBLCLK, WinUser.WM_MBUTTONDBLCLK,
WinUser.WM_RBUTTONDBLCLK, (* only happen if CS_DBLCLKS set in
window class *)
WinUser.WM_QUIT (* from PostQuitMessage, eaten by GetMessage *) =>
Crash();
(* All other messages should not happen, but if they do (and it
bothers you) then DefaultAllMessages should be called *)
ELSE
VAR def: BOOLEAN;
BEGIN
LOCK mu DO def := defaultAllMessages END;
IF NOT def THEN Crash(); END;
RETURN WinUser.DefWindowProc(hwnd, message, wParam, lParam);
END;
END;
EXCEPT
| TrestleComm.Failure => RETURN 0;
END;
RETURN res;
END WindowProc;
CONST
MapModifiers = ARRAY OF
VBT.Modifiers{
VBT.Modifiers{}, VBT.Modifiers{VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.MouseR, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Shift},
VBT.Modifiers{VBT.Modifier.Shift, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Shift, VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.Shift, VBT.Modifier.MouseR,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Control},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.MouseR,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.Shift},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.Shift,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.Shift,
VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.Control, VBT.Modifier.Shift,
VBT.Modifier.MouseR, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.MouseR,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Shift},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Shift,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Shift,
VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Shift,
VBT.Modifier.MouseR, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.MouseR, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.Shift},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.Shift, VBT.Modifier.MouseL},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.Shift, VBT.Modifier.MouseR},
VBT.Modifiers{VBT.Modifier.MouseM, VBT.Modifier.Control,
VBT.Modifier.Shift, VBT.Modifier.MouseR,
VBT.Modifier.MouseL}};
PROCEDURE Owns (ur: NTClientF.Child; s: VBT.Selection): BOOLEAN =
BEGIN
RETURN s.sel < NUMBER(ur.owns^) AND ur.owns[s.sel]
END Owns;
<* LL = VBT.mu *>
PROCEDURE MouseMoveEvent (x, y : INTEGER;
modifiers: WinDef.WPARAM;
v : VBT.T;
ur : NTClientF.Child;
trsl : NTClient.T)
RAISES {TrestleComm.Failure} =
VAR
pt := Point.T{x, y};
cage := ur.cage;
gone := NOT Rect.Member(pt, v.domain);
BEGIN
NTDebug.PInt(
MMove v:, LOOPHOLE(v, INTEGER)); NTDebug.PText(Fmt.F((%s, %s), Fmt.Int(x), Fmt.Int(y))); NTDebug.PBool(gone:, gone); NTDebug.PRect(, cage.rect); NTDebug.PText(Fmt.F(inout: {%s %s}, Fmt.Bool(FALSE IN cage.inOut), Fmt.Bool(TRUE IN cage.inOut))); NTDebug.NewLine();
IF gone IN cage.inOut AND Rect.Member(pt, cage.rect) THEN
RETURN
END; (* fast path return *)
(* mouse escape *)
VAR
cd : VBT.PositionRec;
xRoot, yRoot: INTEGER;
owns := Owns(ur, VBT.KBFocus);
ownsNT := ur.isNTFocus OR ur.inside AND ur.underNTFocus;
lost := owns AND NOT ownsNT;
takeFocus := NOT owns AND ownsNT AND ur.recentlyOutside;
BEGIN
NTClientF.ValidateNW(trsl, ur, v.st);
xRoot := ur.nw.h + x;
yRoot := ur.nw.v + y;
cd.time := WinUser.GetMessageTime();
cd.modifiers := MapModifiers[modifiers];
cd.cp.pt.h := x;
cd.cp.pt.v := y;
cd.cp.gone := gone;
cd.cp.offScreen := FALSE;
cd.cp.screen := 0;
IF cd.cp.gone AND v = trsl.current THEN
trsl.current := NIL;
DeliverPosition(trsl, cd, xRoot, yRoot, v, trsl.mouseFocus)
ELSE
VAR oc := trsl.current;
BEGIN
IF NOT cd.cp.gone AND v # NIL THEN
trsl.current := v
ELSE
oc := NIL
END;
DeliverPosition(trsl, cd, xRoot, yRoot, v, oc, trsl.mouseFocus)
END
END;
IF ur # NIL AND lost THEN
LOCK trsl DO
ExtendOwns(ur.owns, VBT.KBFocus);
ur.owns[VBT.KBFocus.sel] := FALSE;
IF trsl.sel[VBT.KBFocus.sel].v = v THEN
trsl.sel[VBT.KBFocus.sel].v := NIL
END
END;
VBTClass.Misc(
v, VBT.MiscRec{VBT.Lost, VBT.NullDetail, 0, VBT.KBFocus})
ELSIF takeFocus THEN
LOCK trsl DO ur.recentlyOutside := FALSE END;
VBTClass.Misc(v, VBT.MiscRec{VBT.TakeSelection, VBT.NullDetail,
cd.time, VBT.KBFocus})
END;
END;
END MouseMoveEvent;
<* LL = VBT.mu *>
PROCEDURE ButtonEvent ( hwnd : WinDef.HWND;
message : WinDef.UINT;
x, y : INTEGER;
modifiers: WinDef.WPARAM;
v : VBT.T;
ur : NTClientF.Child;
trsl : NTClient.T;
VAR last : Last )
RAISES {TrestleComm.Failure} =
VAR
mf := trsl.mouseFocus;
cd : VBT.MouseRec;
time := WinUser.GetMessageTime();
button : VBT.Modifier;
press : BOOLEAN;
xRoot, yRoot: INTEGER;
CONST
NonButtons = VBT.Modifiers{FIRST(VBT.Modifier).. LAST(VBT.Modifier)}
- VBT.Buttons;
BEGIN
NTClientF.ValidateNW(trsl, ur, v.st);
xRoot := ur.nw.h + x;
yRoot := ur.nw.v + y;
CASE message OF
| WinUser.WM_LBUTTONUP =>
button := VBT.Modifier.MouseL;
press := FALSE;
| WinUser.WM_LBUTTONDOWN =>
button := VBT.Modifier.MouseL;
press := TRUE;
| WinUser.WM_RBUTTONUP =>
button := VBT.Modifier.MouseR;
press := FALSE;
| WinUser.WM_RBUTTONDOWN =>
button := VBT.Modifier.MouseR;
press := TRUE;
| WinUser.WM_MBUTTONUP =>
button := VBT.Modifier.MouseM;
press := FALSE;
| WinUser.WM_MBUTTONDOWN =>
button := VBT.Modifier.MouseM;
press := TRUE;
ELSE
NT.Assert(0);
END;
IF hwnd = last.root
AND Word.Minus(time, last.time) <= last.doubleClickInterval
AND ABS(last.x - x) <= last.safetyRadius
AND ABS(last.y - y) <= last.safetyRadius AND last.button = button THEN
INC(last.clickCount)
ELSE
last.clickCount := 0;
last.root := hwnd;
last.x := x;
last.y := y;
last.button := button
END;
last.time := time;
cd.modifiers := MapModifiers[modifiers];
cd.whatChanged := button;
IF press THEN
IF (cd.modifiers - VBT.Modifiers{button}) <= NonButtons THEN
cd.clickType := VBT.ClickType.FirstDown;
trsl.mouseFocus := v;
ELSE
cd.clickType := VBT.ClickType.OtherDown
END
ELSE
IF cd.modifiers <= NonButtons + VBT.Modifiers{cd.whatChanged} THEN
cd.clickType := VBT.ClickType.LastUp;
trsl.mouseFocus := NIL
ELSE
cd.clickType := VBT.ClickType.OtherUp
END
END;
cd.time := time;
cd.cp.pt.h := x;
cd.cp.pt.v := y;
cd.cp.offScreen := FALSE;
LOCK trsl DO
cd.cp.gone := cd.cp.offScreen;
ur.cageCovered := TRUE;
END;
TRY
cd.cp.screen := 0;
cd.clickCount := last.clickCount;
DeliverPosition(trsl, VBT.PositionRec{cd.cp, cd.time, cd.modifiers},
xRoot, yRoot, trsl.current, mf);
VBTClass.Mouse(v, cd);
FINALLY
LOCK trsl DO ur.cageCovered := FALSE END
END;
LOCK v DO trsl.setcage(v) END;
IF mf # NIL AND mf # v THEN
cd.cp.offScreen := FALSE;
cd.cp.pt.h := xRoot;
cd.cp.pt.v := yRoot;
cd.cp.gone := TRUE;
IF NOT cd.cp.offScreen THEN
VAR mfur: NTClientF.Child := mf.upRef;
BEGIN
TrestleOnNT.Enter(trsl);
TRY
NTClientF.ValidateNW(trsl, mfur, mf.st);
DEC(cd.cp.pt.h, mfur.nw.h);
DEC(cd.cp.pt.v, mfur.nw.v)
FINALLY
TrestleOnNT.Exit(trsl)
END
END
END;
VBTClass.Mouse(mf, cd)
END;
TrestleOnNT.Enter(trsl);
TRY
FOR s := FIRST(trsl.sel^) TO LAST(trsl.sel^) DO
WITH sr = trsl.sel[s] DO
IF s = VBT.KBFocus.sel THEN
IF sr.v = v AND ur.isNTFocus THEN
EVAL WinUser.SetFocus(ur.hwnd);
sr.ts := time
END
ELSIF sr.v = v THEN
NT.Assert(0); (* NYI *)
sr.ts := time
END
END
END
FINALLY
TrestleOnNT.Exit(trsl)
END
END ButtonEvent;
PROCEDURE DeliverPosition ( t : NTClient.T;
READONLY cd : VBT.PositionRec;
h, v : INTEGER;
w, s1, s2: VBT.T := NIL) =
<*FATAL Split.NotAChild*>
(* Deliver the position in cd to all the children of t, starting with s1,
including s2, and ending with w. *)
VAR
goneCd := cd;
others: BOOLEAN;
ch : VBT.T;
BEGIN
goneCd.cp.gone := TRUE;
LOCK t DO others := t.otherCages; t.otherCages := FALSE END;
IF s1 # NIL AND s1 # w THEN DoPosition(t, s1, goneCd, h, v) END;
IF others THEN
ch := Split.Succ(t, NIL);
WHILE ch # NIL DO
IF ch # s1 AND ch # w THEN DoPosition(t, ch, goneCd, h, v) END;
ch := Split.Succ(t, ch)
END
ELSIF s2 # NIL AND s2 # w AND s2 # s1 THEN
DoPosition(t, s2, goneCd, h, v)
END;
IF w # NIL THEN VBTClass.Position(w, cd) END
END DeliverPosition;
PROCEDURE DoPosition (<*UNUSED*> t : NTClient.T;
w : VBT.T;
VAR cd : VBT.PositionRec;
<*UNUSED*> h, v: INTEGER ) =
VAR cg := VBTClass.Cage(w);
BEGIN
IF (cg.screen = cd.cp.screen OR cg.screen = VBT.AllScreens)
AND TRUE IN cg.inOut THEN
IF Rect.Equal(cg.rect, Rect.Full) THEN RETURN END;
END
END DoPosition;
PROCEDURE Loop (cl: Closure): REFANY =
VAR
msg : WinUser.MSG;
lpmsg: WinUser.LPMSG := ADR(msg);
BEGIN
<* LL = VBT.mu *>
LOCK mu DO INC(cnt); END;
Create(cl.conn, cl.ch, cl.st, cl.x, cl.y, cl.iconic);
Thread.Broadcast(cv);
<* LL = 0 *>
(* WM_QUIT returns 0 *)
WHILE (0 # WinUser.GetMessage(lpmsg, NT.CNULL, 0, 0)) DO
IF 0 = WinUser.TranslateAccelerator(msg.hwnd, hAccelTable, lpmsg) THEN
EVAL WinUser.TranslateMessage(lpmsg);
EVAL WinUser.DispatchMessage(lpmsg);
END;
END;
LOCK mu DO DEC(cnt); IF cnt = 0 THEN Thread.Broadcast(cv) END; END;
RETURN NIL
END Loop;
PROCEDURE Init () =
VAR
wc : WinUser.WNDCLASS;
lpwc: WinUser.LPWNDCLASS := ADR(wc);
BEGIN
hInst := RTParamsWin32.hInstance;
nShowCmd := RTParamsWin32.nShowCmd;
hAccelTable := WinUser.LoadAccelerators(hInst, windowclassName);
(* other styles to consider: CS_GLOBALCLASS, CS_OWNDC, CS_PARENTDC,
CS_SAVEBITS *)
wc.style := WinUser.CS_HREDRAW + WinUser.CS_VREDRAW;
wc.lpfnWndProc := WindowProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := BYTESIZE(VBT.T);
(* hang the VBT off of the hwnd *)
wc.hInstance := hInst;
wc.hIcon := WinUser.LoadIcon(NT.CNULL, WinUser.IDI_APPLICATION);
wc.hCursor := WinUser.LoadCursor(NT.CNULL, WinUser.IDC_ARROW);
wc.hbrBackground := NT.CNULL;
wc.lpszMenuName := NT.CNULL;
wc.lpszClassName := windowclassName;
NT.Assert(WinUser.RegisterClass(lpwc));
wc.lpfnWndProc := WinUser.DefWindowProc;
wc.lpszClassName := nullWindowclassName;
NT.Assert(WinUser.RegisterClass(lpwc));
END Init;
<* UNUSED *>
PROCEDURE Cleanup () =
BEGIN
NT.Assert(WinUser.DestroyAcceleratorTable(hAccelTable));
(* what about null window? *)
END Cleanup;
EXCEPTION Fatal;
PROCEDURE Crash () =
<* FATAL Fatal *>
BEGIN
RAISE Fatal;
END Crash;
BEGIN
windowclassName := M3toC.CopyTtoS("DEC SRC Trestle VBT");
nullWindowclassName := M3toC.CopyTtoS("DEC SRC Trestle NullWindow");
END NTMsgs.