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 *> PROCEDUREWindowProc (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}}; PROCEDUREOwns (ur: NTClientF.Child; s: VBT.Selection): BOOLEAN = BEGIN RETURN s.sel < NUMBER(ur.owns^) AND ur.owns[s.sel] END Owns; <* LL = VBT.mu *> PROCEDUREMouseMoveEvent (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 *> PROCEDUREButtonEvent ( 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; PROCEDUREDeliverPosition ( 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; PROCEDUREDoPosition (<*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; PROCEDURELoop (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; PROCEDUREInit () = 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 *> PROCEDURECleanup () = BEGIN NT.Assert(WinUser.DestroyAcceleratorTable(hAccelTable)); (* what about null window? *) END Cleanup; EXCEPTION Fatal; PROCEDURECrash () = <* FATAL Fatal *> BEGIN RAISE Fatal; END Crash; BEGIN windowclassName := M3toC.CopyTtoS("DEC SRC Trestle VBT"); nullWindowclassName := M3toC.CopyTtoS("DEC SRC Trestle NullWindow"); END NTMsgs.