ui/src/nt/NTMsgs.m3


Copyright (C) 1994, Digital Equipment Corp.
 by Steve Glassman, Mark Manasse and Greg Nelson 
<*PRAGMA LL*>

UNSAFE MODULE NTMsgs;

IMPORT Axis, Ctypes, M3toC, NT, NTClient, NTClientF, NTScreenType, Point, Rect,
       Region, RTParamsWin32, Split, Thread, TrestleClass, TrestleComm,
       TrestleOnNT, VBT, VBTClass, WinDef, WinNT, WinUser, Word;
IMPORT Fmt, NTDebug;

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;

PROCEDURE DefaultAllMessages() =
  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 *>
PROCEDURE CreateNTWindow (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 *>
PROCEDURE Create (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;

PROCEDURE NullWindow (<* 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;

PROCEDURE GetVBT(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;

PROCEDURE ExtendOwns (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;

PROCEDURE ExtendSel (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;

PROCEDURE FixSel (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.