ui/src/winvbt/WinTrestle.m3


Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
                                                                           
       Created on Mon Jan 16 10:05:17 PST 1995 by najork                   

UNSAFE MODULE WinTrestle;

IMPORT AddrRefTbl, Axis, Batch, BatchRep, BatchUtil, Ctypes, Fmt, KeyboardKey,
       Latin1Key, M3toC, PaintExt, PaintPrivate, Path, PathPrivate, Point,
       PolyRegion, ProperSplit, Rect, Region, RTCollectorSRC, RTHeapDep,
       RTHeapRep, RTParams, RTLinker, ScrnColorMap, ScrnCursor, ScrnFont,
       ScrnPixmap, Split, Text, Thread, Trapezoid, Trestle, TrestleComm,
       TrestleClass, TrestleImpl, VBT, VBTClass, VBTRep, WinAux, WinContext,
       WinDef, WinGDI, WinLL, WinScreenType, WinScreenTypePrivate,
       WinScrnColorMap, WinScrnCursor, WinScrnFont, WinScrnPaintOp,
       WinScrnPixmap, WinUser, Word;

IMPORT IO;

EXCEPTION FatalError;

CONST
  False = 0;
  True  = 1;

CONST
  DesktopID = 0; (* The ScreenID of the Windows desktop. *)

REVEAL
  T = Trestle.T BRANDED "WinTrestle.T" OBJECT
    screen    : WinScreenType.T;
    coverage  : CARDINAL         := 0;
    current   : VBT.T            := NIL;
      (* The child that is touched by the pointer, or NIL if there is no
         such child. *)
    mouseFocus: VBT.T            := NIL;
      (* The child that has received a FirstDown but no corresponding
         LastUp, or NIL if there is no such child. *)
    hwnd    : WinDef.HWND;
    timerId : WinDef.UINT;
    lastPos          := WinDef.POINT {-1, -1};
    anyCageSet       := TRUE;
    vbts: AddrRefTbl.T;
      (* "vbts" is a mapping from window handles to VBTs. For each pair
         "(a,v)" in "vbts", "v.upRef.hwnd = a" holds. LL = self. *)
    dead: BOOLEAN := FALSE;
      (* Indicates whether T has been killed. It might be that we don't
         need this field. *)
  OVERRIDES
    redisplay        := Redisplay;
    beChild          := BeChild;
    replace          := Replace;
    setcage          := SetCage;
    setcursor        := SetCursor;
    paintbatch       := PaintBatch;
    sync             := Sync;
    capture          := Capture;
    screenOf         := ScreenOf;
    newShape         := NewShape;
    acquire          := Acquire;
    release          := Release;
    put              := Put;
    forge            := Forge;
    readUp           := ReadUp;
    writeUp          := WriteUp;
    attach           := Attach;
    decorate         := Decorate;
    iconize          := Iconize;
    overlap          := Overlap;
    moveNear         := MoveNear;
    installOffscreen := InstallOffScreen;
    setColorMap      := SetColorMap;
    getScreens       := GetScreens;
    captureScreen    := CaptureScreen;
    allCeded         := AllCeded;
    tickTime         := TickTime;
    trestleId        := TrestleID;
    windowId         := WindowID;
    updateChalk      := UpdateChalk;
    updateBuddies    := UpdateBuddies;
  END;

REVEAL
  Child = PubChild BRANDED OBJECT
    last        : Last;
    cageCovered := FALSE;
      (* TRUE during delivery of a button click,
         to avoid setting the cage twice. *)
    decorated := FALSE;
       (* TRUE if the window is normal, FALSE if override-redirect;
          only valid after w is created. (same as in xvbt) *)
  END;

PROCEDURE Redisplay (self: T) =

  PROCEDURE SetShape (trsl: T; v: VBT.T) =
    CONST
    VAR
      mustReshape             := FALSE;
      sizeChange   : BOOLEAN;
      width, height: CARDINAL := 0;
      ur           : Child    := v.upRef;
      s                       := VBTClass.GetShapes(v);
      sh                      := s[Axis.T.Hor];
      sv                      := s[Axis.T.Ver];
      status       : WinDef.BOOL;
      rect         : WinDef.RECT;
    BEGIN
      SetSizeHints (width, height, v.st, sh, sv);
      TRY
        Enter(trsl);
        TRY
          (* If the window is not yet installed, bail out ... *)
          IF ur.hwnd = NIL THEN
            RETURN;
          END;

          IF sh = ur.sh AND sv = ur.sv THEN
            RETURN;
          END;
          ur.sh := sh;
          ur.sv := sv;

          (* Determine the current size of the window. In xvbt, this
             information is cached in XClientF.Child *)
          status := WinUser.GetClientRect (ur.hwnd, ADR(rect));
          <* ASSERT status = True *>
          sizeChange := width # rect.right - rect.left OR
                        height # rect.bottom - rect.top;

          IO.Put ("sizeChange = " & Fmt.Bool (sizeChange) &
            "  target size: " & Fmt.Int (width) & " x " & Fmt.Int (height) &
            "  current size: " & Fmt.Int (rect.right - rect.left) & " x "
            & Fmt.Int (rect.bottom - rect.top) & "\n");
          IF sizeChange AND width # 0 AND height # 0 THEN

            (* There are two procedures for changing the size of a Windows
               window: "SetWindowPos" and "MoveWindow". Both seems to perform
               a series of "SendMessage" calls.  So, if the message-loop
               thread is blocked on VBT.mu (which this thread is holding
               right now), and we called these procudures, we would deadlock.

               We solve the problem by "posting" a client message, thereby
               causing the message-loop thread to do the resizing
               asynchronously (and without holding any locks). *)

            REPEAT
              status := WinUser.PostMessage (ur.hwnd, RESHAPE_VBT,
                                             width, height);
              IF status = False THEN
                Thread.Pause (0.05d0);
              END;
            UNTIL status = True;
          END;
        FINALLY
          Exit(trsl);
          IF mustReshape THEN
            Reshape (v, width, height);
          END;
        END;
      EXCEPT
        TrestleComm.Failure => (* skip *)
      END;
      IO.Put ("Exiting SetShape\n");
    END SetShape;

  <*FATAL Split.NotAChild*>
  VAR
    v := Split.Succ (self, NIL);
  BEGIN
    WHILE v # NIL DO
      IF VBTClass.HasNewShape (v) AND v.st # NIL THEN
        SetShape (self, v);
      END;
      v := Split.Succ (self, v);
    END;
  END Redisplay;

PROCEDURE BeChild (self: T; ch: VBT.T) =
  BEGIN
    IF ch.upRef = NIL THEN
      ch.upRef := NEW(Child);
    END;
    WITH ur = NARROW(ch.upRef, Child) DO
      ur.ch := ch;
    END;
    ch.parent := self;
  END BeChild;

PROCEDURE Replace (self: T; ch, new: VBT.T) =
  <* FATAL FatalError *>
  VAR
    ur: Child := ch.upRef;
    status : WinDef.BOOL;
  BEGIN
    IF new # NIL THEN
      RAISE FatalError
    END;
    TRY
      Enter(self);
      TRY
        IF ur.offScreen THEN
          <* ASSERT FALSE *> (* not yet implemented *)
        ELSE
          status := WinUser.PostMessage (ur.hwnd, WinUser.WM_CLOSE, 0, 0);
          <* ASSERT status = True *>
        END
      FINALLY
        Exit(self)
      END
    EXCEPT
      TrestleComm.Failure => (* skip *)
    END;
    Delete (self, ch, ur);
  END Replace;
SetCage is called with locking level VBT.mu. It turns out that sometimes self is locked as well (see the comment of the Iconize procedure). So, we don't try to lock self. This is not quite correct, but harmless, since interference will only cause us to err on the conservative side.

PROCEDURE SetCage (self: T; <* UNUSED *>v: VBT.T) =
  BEGIN
    self.anyCageSet := TRUE;
  END SetCage;

PROCEDURE SetCursor (self: T; v: VBT.T) =
  VAR
    ur: Child := v.upRef;
  BEGIN
    IF ur.hwnd = NIL THEN
      RETURN;
    END;
    WITH cs = v.getcursor() DO
      TRY
        Enter (self);
        TRY
          WinScrnCursor.SetCursor (cs);
        FINALLY
          Exit (self);
        END;
      EXCEPT
        TrestleComm.Failure => (* skip *)
      END;
    END;
  END SetCursor;

CONST ComSize = ADRSIZE (PaintPrivate.CommandRec);

TYPE PC = PaintPrivate.PaintCommand;

PROCEDURE PaintBatch (self: T; v: VBT.T; ba: Batch.T) =
  VAR
    ur    : Child           := v.upRef;
    hdc   := ur.hdc;
    cmdP  := LOOPHOLE (ADR (ba.b[0]), PaintPrivate.CommandPtr);
    endP  : PaintPrivate.CommandPtr := ba.next;
    st    : WinScreenType.T := v.st;
    status: WinDef.BOOL;
  BEGIN
    IF ba.clip.west >= ba.clip.east OR st = NIL THEN
      Batch.Free (ba);
      RETURN;
    END;
    IF ba.clipped = BatchUtil.ClipState.Unclipped THEN
      BatchUtil.Clip (ba);
    END;
    TRY
      Enter (self);
      TRY
        WHILE cmdP < endP DO
          CASE cmdP.command OF
          | PC.TintCom =>
            cmdP := TintCom (cmdP, endP, hdc, st);
          | PC.TextureCom =>
            cmdP := TextureCom (cmdP, endP, hdc, st);
          | PC.PixmapCom =>
            cmdP := PixmapCom (cmdP, endP, hdc, st);
          | PC.ScrollCom =>
            cmdP := ScrollCom (cmdP, hdc, ur, st);
          | PC.TrapCom =>
            cmdP := TrapCom (cmdP, endP, hdc, st);
          | PC.TextCom =>
            cmdP := TextCom (cmdP, cmdP, endP, hdc, st);
          | PC.ExtensionCom =>
            cmdP := ExtensionCom (cmdP, endP, hdc, self, st);
          | PC.RepeatCom =>
            INC (cmdP, ComSize);
          ELSE
            RETURN;
          END
        END
      FINALLY
        Batch.Free(ba);
        Exit (self)
      END
    EXCEPT
      TrestleComm.Failure =>     (* skip *)
    END
  END PaintBatch;
*************************************************************************** Painting Tints ***************************************************************************

PROCEDURE TintCom (cmdP, endP: PaintPrivate.CommandPtr;
                   hdc       : WinDef.HDC;
                   st        : WinScreenType.T): PaintPrivate.CommandPtr =
  BEGIN
    WITH op   = LOOPHOLE (cmdP, PaintPrivate.TintPtr)^,
         ctxt = WinContext.PushTint (hdc, st, op.op) DO
      FillRect (hdc, op.clip);
      INC (cmdP, ADRSIZE (op));
      WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
        FillRect (hdc, cmdP.clip);
        INC (cmdP, ComSize);
      END;
      WinContext.Pop (ctxt);
    END;
    RETURN cmdP;
  END TintCom;

PROCEDURE FillRect (hdc: WinDef.HDC; READONLY r: Rect.T) =
  VAR
    rc    : WinDef.RECT;
    pen   : WinDef.HPEN;
    oldPen: WinDef.HPEN;
    status: WinDef.BOOL;
  BEGIN
    IF r.west < r.east THEN
      rc := FromRect(r);

      (*
       * One would assume that
       *     EVAL WinUser.FillRect (hdc, ADR(rc), hbr);
       * should be sufficient here. However, "WinUser.FillRect" ignores the
       * current raster operation mode for some reason.
       *)

      (* Load an invisible pen into the DC *)
      oldPen := WinGDI.SelectObject (hdc,
                                     WinGDI.GetStockObject (WinGDI.NULL_PEN));
      <* ASSERT oldPen # NIL *>

      (* "WinGDI.Rectangle" uses both the current pen and the current brush *)
      status := WinGDI.Rectangle (hdc, r.west, r.north, r.east+1, r.south+1);
      <* ASSERT status = True *>

      pen := WinGDI.SelectObject (hdc, oldPen);
      <* ASSERT pen # NIL *>
    END;
  END FillRect;

* Debugging gear

PROCEDURE StrokeRect (hdc: WinDef.HDC; READONLY r: Rect.T) =
  VAR
    rc    : WinDef.RECT;
    oldBr : WinDef.HBRUSH;
    oldPen: WinDef.HPEN;
    status: WinDef.BOOL;
  BEGIN
    IF r.west < r.east THEN
      rc := FromRect(r);

      oldPen := WinGDI.SelectObject (hdc,
                                     WinGDI.GetStockObject (WinGDI.BLACK_PEN));
      <* ASSERT oldPen # NIL *>
      oldBr := WinGDI.SelectObject (hdc,
                                    WinGDI.GetStockObject (WinGDI.NULL_BRUSH));
      <* ASSERT oldBr # NIL *>
      (* "WinGDI.Rectangle" uses both the current pen and the current brush *)
      status := WinGDI.Rectangle (hdc, r.west, r.north, r.east+1, r.south+1);
      <* ASSERT status = True *>
      oldBr := WinGDI.SelectObject (hdc, oldBr);
      oldPen := WinGDI.SelectObject (hdc, oldPen);
    END;
  END StrokeRect;

* More debugging gear

PROCEDURE MarkPoint (hdc: WinDef.HDC; READONLY a: Point.T) =
  VAR
    oldPen: WinDef.HGDIOBJ;
  BEGIN
    oldPen := WinGDI.SelectObject (hdc,
                                   WinGDI.GetStockObject (WinGDI.BLACK_PEN));
    <* ASSERT oldPen # NIL *>
    DrawLine(hdc, Point.T{a.h - 2, a.v}, Point.T{a.h + 2, a.v});
    DrawLine(hdc, Point.T{a.h, a.v - 2}, Point.T{a.h, a.v + 2});
    oldPen := WinGDI.SelectObject (hdc, oldPen);
  END MarkPoint;
*************************************************************************** Painting textures ***************************************************************************

PROCEDURE TextureCom (cmdP, endP: PaintPrivate.CommandPtr;
                      hdc       : WinDef.HDC;
                      st        : WinScreenType.T): PaintPrivate.CommandPtr =
  BEGIN
    WITH op   = LOOPHOLE (cmdP, PaintPrivate.PixmapPtr)^,
         ctxt = WinContext.PushTexture (hdc, st, op.op, op.pm, op.delta) DO

      FillRect (hdc, op.clip);
      INC (cmdP, ADRSIZE(op));
      WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
        FillRect (hdc, cmdP.clip);
        INC (cmdP, ComSize);
      END;

      WinContext.Pop (ctxt);
    END;
    RETURN cmdP;
  END TextureCom;
*************************************************************************** Painting pixmaps ***************************************************************************

For now, I try to treat pixmaps just like textures. This might not work for color pixmaps, and might not work for every PaintOp.

This code has not been tested for every possible PaintOp and for color. It seems to work with PaintOp.BgFg and with PaintOp.TransparentFg. I should run a fullsuite of tests once I got rudimentary color working.

Note that the Win32 specification states that WinGDI.SetBrushOrgEx works only for x and y coordinates between 0 and 7, and that I assume it to work for arbitrary coordinates. Under NT, this seems to be ok, but there is no guarantee that it will work under Windows 95.

PROCEDURE Bin (i: Word.T): TEXT =
  BEGIN
    RETURN Fmt.Pad (Fmt.Int (i, 2), 32, '0');
  END Bin;

PROCEDURE PixmapCom (cmdP, endP: PaintPrivate.CommandPtr;
                     hdc       : WinDef.HDC;
                     st        : WinScreenType.T): PaintPrivate.CommandPtr =
  VAR
    fastPath : BOOLEAN;
    oldOrg   : WinDef.POINT;
    status   : WinDef.BOOL;
    comdc    : WinDef.HDC;
    bitmap   : WinDef.HBITMAP;
    oldBitmap: WinDef.HBITMAP;
    pm       : PaintPrivate.Pixmap;
    delta    : Point.T;
    pst      : WinScreenType.T;
    apm      : PaintPrivate.Pixmap := pm;
    color    : WinDef.COLORREF;
    brush    : WinDef.HBRUSH;
    auxBrush : WinDef.HBRUSH;
    oldBrush : WinDef.HBRUSH;
    brop     : INTEGER;
    frop     : INTEGER;
    pat0     : INTEGER;
    pat1     : INTEGER;
  BEGIN
    WITH op   = LOOPHOLE (cmdP, PaintPrivate.PixmapPtr)^ DO

      IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER(st.optable^) THEN
        WITH tbl = st.optable[op.op] DO
          IF tbl.bop.mode = WinScrnPaintOp.Mode.Tran AND
             tbl.fop.mode = WinScrnPaintOp.Mode.Opaq THEN
            fastPath := FALSE;
            brop := 0;
            frop := tbl.trop;
          ELSIF tbl.bop.mode = WinScrnPaintOp.Mode.Opaq AND
                tbl.fop.mode = WinScrnPaintOp.Mode.Tran THEN
            fastPath := FALSE;
            brop := tbl.trop;
            frop := 0;
          ELSIF tbl.bop.mode = WinScrnPaintOp.Mode.Tran AND
                tbl.fop.mode = WinScrnPaintOp.Mode.Swap THEN
            fastPath := FALSE;
            brop := 0;
            frop := tbl.trop;
          ELSIF tbl.bop.mode = WinScrnPaintOp.Mode.Swap AND
                tbl.fop.mode = WinScrnPaintOp.Mode.Tran THEN
            fastPath := FALSE;
            brop := tbl.trop;
            frop := 0;
          ELSIF tbl.bop.mode = WinScrnPaintOp.Mode.Opaq AND
                tbl.fop.mode = WinScrnPaintOp.Mode.Swap THEN
            fastPath := FALSE;
            brop := 16_00B8074A;
            frop := 16_006A01E9;
          ELSIF tbl.bop.mode = WinScrnPaintOp.Mode.Swap AND
                tbl.fop.mode = WinScrnPaintOp.Mode.Opaq THEN
            fastPath := FALSE;
            brop := 16_009A0709;
            frop := 16_00E20746;
          ELSE
            fastPath := TRUE;
          END;
        END;
      ELSE
        fastPath := TRUE;
      END;

      IF NOT fastPath THEN

        (* Create a compatible device context *)
        comdc := WinGDI.CreateCompatibleDC (NIL);
        (* Create a bitmap that can hold the rectangle covered by op.clip *)
        bitmap := WinGDI.CreateCompatibleBitmap (comdc,
                                                 op.clip.east - op.clip.west,
                                                 op.clip.south - op.clip.north);
        (* Select the bitmap into "comdc". *)
        oldBitmap := WinGDI.SelectObject (comdc, bitmap);

        (* Map point ("op.clip.west","op.clip.north") of page space to point
           (0,0) of device space. Since the device is a bitmap of width
           "op.clip.east - op.clip.west" and height "op.clip.south -
           op.clip.north", the rectangle "op.clip" of page space is mapped
           onto the device. *)
        status := WinGDI.SetWindowOrgEx (comdc, op.clip.west, op.clip.north, NIL);
        status := WinGDI.SetViewportOrgEx (comdc, 0, 0, NIL);

        (* I dabbled a bit around with "SetWorldTransform", but could
           not get it to work. Anyways, "SetWordTransform" is supported
           under NT, but not under Chicago. *)

        (* Select the pixmap into a pattern brush *)
        pm := op.pm;
        delta := op.delta;
        IF pm < 0 THEN
          pm := WinScrnPixmap.SolidPixmap - pm;
          pst := st.bits;
        ELSE
          pst := st;
        END;
        IF delta # Point.Origin THEN
          WITH pmb = WinScrnPixmap.PixmapDomain (st, apm) DO
            IF NOT Rect.IsEmpty (pmb) THEN
              delta := Rect.Mod (delta, pmb);
            END;
          END;
        END;
        IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER(st.optable^) AND
          pst.pmtable # NIL AND pm < NUMBER (pst.pmtable^) THEN
          WITH tbl = st.optable[op.op] DO

            brush := WinGDI.CreatePatternBrush (pst.pmtable[pm].hbmp);
            <* ASSERT brush # NIL *>

            (* Set the pattern brush origin. The Windows way to do this is
               confusing in two respects: (1) One has to set the origin BEFORE
               selecting the brush into the device context, and (2) the origin
               is specified in device space, not in world/page space. *)

            status := WinGDI.SetBrushOrgEx (comdc,
                                            delta.h - op.clip.west,
                                            delta.v - op.clip.north,
                                            NIL);
            <* ASSERT status = True *>

            auxBrush := WinGDI.SelectObject (comdc, brush);
            <* ASSERT auxBrush # NIL *>

            (* In Windows, '0' pixels of the bitmap in the pattern brush are
               drawn in the current text color, so the text color should be
               "tbl.bop.col". '1' pixels are drawn in the current background
               color, so this color should be "tbl.fop.col". Counterintuive?
               Well, after all, this is Windows! *)

            (* Draw the pixels which are 0 in "pst.pmtable[pm].hbmp" as black
               (all 0's), and the pixels which are 1 as white (all 1's) into
               "comdc". *)

            (* Setting the colors of comdc seems to have no effect. *)
            color := WinGDI.SetTextColor (comdc, WinGDI.RGB(0,0,0));
            <* ASSERT color # WinGDI.CLR_INVALID *>
            color := WinGDI.SetBkColor (comdc, WinGDI.RGB(255,255,255));
            <* ASSERT color # WinGDI.CLR_INVALID *>

            color := WinGDI.SetTextColor (hdc, WinGDI.RGB(0,0,0));
            <* ASSERT color # WinGDI.CLR_INVALID *>
            color := WinGDI.SetBkColor (hdc, WinGDI.RGB(255,255,255));
            <* ASSERT color # WinGDI.CLR_INVALID *>

            pat0 := tbl.bop.col;
            pat1 := tbl.fop.col;

          END;
        ELSE
          brop := 0;
          frop := 0;
        END;

        (* Fill comdc, using the pattern brush *)
        FillRect (comdc, op.clip);

        oldBrush := WinGDI.GetCurrentObject (hdc, WinGDI.OBJ_BRUSH);

        IF brop # 0 THEN
          WITH b = WinGDI.CreateSolidBrush (pat0) DO
            auxBrush := WinGDI.SelectObject (hdc, b);
            <* ASSERT auxBrush # NIL *>
          END;
          (* Bit-Blit comdc onto hdc, using the ternary raster operation trop. *)
          status := WinGDI.BitBlt (hdc,
                                   op.clip.west,
                                   op.clip.north,
                                   op.clip.east - op.clip.west,
                                   op.clip.south - op.clip.north,
                                   comdc,
                                   op.clip.west,
                                   op.clip.north,
                                   brop);
        END;

        IF frop # 0 THEN
          WITH b = WinGDI.CreateSolidBrush (pat1) DO
            auxBrush := WinGDI.SelectObject (hdc, b);
            <* ASSERT auxBrush # NIL *>
          END;
          <* ASSERT status = True *>
          status := WinGDI.BitBlt (hdc,
                                   op.clip.west,
                                   op.clip.north,
                                   op.clip.east - op.clip.west,
                                   op.clip.south - op.clip.north,
                                   comdc,
                                   op.clip.west,
                                   op.clip.north,
                                   frop);
          <* ASSERT status = True *>
        END;

        INC (cmdP, ADRSIZE(op));
        WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
commented out for the time being status := WinGDI.BitBlt (hdc, cmdP.clip.west, cmdP.clip.north, cmdP.clip.east - cmdP.clip.west, cmdP.clip.south - cmdP.clip.north, comdc, cmdP.clip.west, cmdP.clip.north, trop);
          <* ASSERT status = True *>
          INC (cmdP, ComSize);
        END;

        (* Clean up. *)
        brush := WinGDI.SelectObject (hdc, oldBrush);
        <* ASSERT brush # NIL *>
        status := WinGDI.DeleteObject (brush);
        <* ASSERT status = True *>

        status := WinGDI.DeleteDC (comdc);
        <* ASSERT status = True *>
        status := WinGDI.DeleteObject (bitmap);
        <* ASSERT status = True *>

      ELSE

        WITH ctxt = WinContext.PushTexture (hdc, st, op.op, op.pm, op.delta) DO
          FillRect (hdc, op.clip);
          INC (cmdP, ADRSIZE(op));
          WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
            FillRect (hdc, cmdP.clip);
            INC (cmdP, ComSize);
          END;
          WinContext.Pop (ctxt);
        END;
      END;
    END;
*** WITH op = LOOPHOLE(cmdP, PaintPrivate.PixmapPtr), ctxt = WinContext.PushPixmap ( hdc, st, op.op, op.pm, op.delta, mode, src) DO INC (cmdP, ADRSIZE(op^)); IF mode = XGC.XMode.UseCopyPlane THEN VAR delta := op.delta; BEGIN IF NOT WinScrnPixmap.IsLazy (st, op.pm) THEN delta := Point.Add (delta, Rect.NorthWest ( WinScrnPixmap.PixmapDomain (st, op.pm))); END; CopyPlane(dpy, src, w, gc, op.clip, delta); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO CopyPlane (dpy, src, w, gc, cmdP.clip, delta); INC (cmdP, ComSize); END END ELSIF mode = XGC.XMode.UseCopyArea THEN VAR delta := op.delta; BEGIN IF NOT XScrnPxmp.IsLazy(st, op.pm) THEN delta := Point.Add (delta, Rect.NorthWest ( WinScrnPixmap.PixmapDomain (st, op.pm))); END; EVAL CopyArea(dpy, src, w, gc, op.clip, delta); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO EVAL CopyArea(dpy, src, w, gc, cmdP.clip, delta); INC(cmdP, ComSize); END END ELSE WITH dom = Rect.Add(WinScrnPixmap.PixmapDomain(st, op.pm), op.delta) DO FillRect (dpy, w, gc, Rect.Meet (op.clip, dom)); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO FillRect (dpy, w, gc, Rect.Meet (cmdP.clip, dom)); INC(cmdP, ComSize); END END END END; **
RETURN cmdP;
  END PixmapCom;
*************************************************************************** Scrolling ***************************************************************************

PROCEDURE ScrollCom (cmdP: PaintPrivate.CommandPtr;
                     hdc : WinDef.HDC;
        <* UNUSED *> ur  : Child;
                     st  : WinScreenType.T): PaintPrivate.CommandPtr =
  VAR
    trop: Ctypes.int;
  BEGIN
    WITH op = LOOPHOLE (cmdP, PaintPrivate.ScrollPtr)^ DO
      IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER (st.optable^) THEN
        trop := st.optable[op.op].trop;
      ELSE
        trop := 16_00AA0029;  (* Ternary raster op code for NO-OP *)
      END;

      INC (cmdP, ADRSIZE (op));
      IF CopyRectWithinDC (hdc, trop, op.clip, op.delta) THEN

* At this point, the xvbt counterpart has the following code: * * XScrollQueue.Insert (ur.scrollQ, op^); * IF Region.OverlapRect (Rect.Sub (op.clip, op.delta), ur.badR) * AND NOT Region.SubsetRect (op.clip, ur.badR) THEN * ur.badR := Region.Join (Region.MeetRect (op.clip, * Region.Add (ur.badR, * op.delta)), * ur.badR) * END;

      END;
    END;
    RETURN cmdP;
  END ScrollCom;

PROCEDURE CopyRectWithinDC (         hdc  : WinDef.HDC;
                                     trop : WinDef.DWORD;
                            READONLY clip : Rect.T;
                            READONLY delta: Point.T): BOOLEAN =
  VAR
    status: WinDef.BOOL;
  BEGIN
    IF clip.west < clip.east + 1 AND clip.north < clip.south + 1 THEN
      status := WinGDI.BitBlt (hdc,
                               clip.west,
                               clip.north,
                               clip.east - clip.west,
                               clip.south - clip.north,
                               hdc,
                               clip.west - delta.h,
                               clip.north - delta.v,
                               trop);
      <* ASSERT status = True *>
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END CopyRectWithinDC;
*************************************************************************** Painting Trapezoids ***************************************************************************

PROCEDURE TrapCom (cmdP, endP: PaintPrivate.CommandPtr;
                   hdc       : WinDef.HDC;
                   st        : WinScreenType.T): PaintPrivate.CommandPtr =
  BEGIN
    WITH op   = LOOPHOLE (cmdP, PaintPrivate.TrapPtr)^,
         ctxt = WinContext.PushTexture (hdc, st, op.op, op.pm, op.delta) DO

      IF op.m1.n < 0 THEN
        op.m1.n := -op.m1.n;
        op.m1.d := -op.m1.d;
      ELSIF op.m1.n = 0 THEN
        INC (cmdP, ADRSIZE(op));
        RETURN cmdP;
      END;
      IF op.m2.n < 0 THEN
        op.m2.n := -op.m2.n;
        op.m2.d := -op.m2.d;
      ELSIF op.m2.n = 0 THEN
        INC (cmdP, ADRSIZE(op));
        RETURN cmdP;
      END;

      Trap (hdc, op, op.clip);
      INC (cmdP, ADRSIZE(op));

      WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
        Trap (hdc, op, cmdP.clip);
        INC (cmdP, ComSize);
      END;
    END;
    RETURN cmdP;
  END TrapCom;

PROCEDURE Trap (         hdc : WinDef.HDC;
                READONLY tr  : PaintPrivate.TrapRec;
                READONLY clip: Rect.T) =

  PROCEDURE HW (READONLY m: Trapezoid.Rational;
                READONLY p: Point.T;
                         v: INTEGER): INTEGER =
    (* Return ceiling of the h-coordinate of the intersection of the
       trapezoid edge determined by (m, p) with the horizontal line at height
       v. *)
    BEGIN
      RETURN p.h + (m.d * (v - p.v) + m.n - 1) DIV m.n;
    END HW;

  PROCEDURE HF (READONLY m: Trapezoid.Rational;
                READONLY p: Point.T;
                         v: INTEGER): INTEGER =
    (* Return fractional part of (ceiling - actual) of intersection above *)
    BEGIN
      RETURN -m.d * (v - p.v) MOD m.n;
    END HF;

  VAR
    vlo, vhi, hw1, hw2, hf1, hf2, mw1, mw2, mf1, mf2, lft, rit: INTEGER;
    empty                                                     : BOOLEAN;
  BEGIN
    IF clip.west >= clip.east THEN
      RETURN;
    END;
    vlo := clip.north;
    vhi := clip.south;
    IF tr.m1.d = 0 AND tr.m2.d = 0 THEN
      FillRect (hdc,
                Rect.Meet (clip, Rect.FromEdges (tr.p1.h, tr.p2.h, vlo, vhi)));
      RETURN;
    END;
    hw1 := HW (tr.m1, tr.p1, vlo);
    IF hw1 >= clip.east AND HW (tr.m1, tr.p1, vhi - 1) >= clip.east THEN
      RETURN;
    END;
    hw2 := HW (tr.m2, tr.p2, vlo);
    IF hw2 <= clip.west AND HW (tr.m2, tr.p2, vhi - 1) <= clip.west THEN
      RETURN;
    END;
    hf1 := HF (tr.m1, tr.p1, vlo);
    hf2 := HF (tr.m2, tr.p2, vlo);
    mw1 := tr.m1.d DIV tr.m1.n;
    mf1 := tr.m1.d MOD tr.m1.n;
    mw2 := tr.m2.d DIV tr.m2.n;
    mf2 := tr.m2.d MOD tr.m2.n;
    empty := TRUE;           (* set to false as soon as something is painted *)
    WHILE vlo # vhi DO
      lft := MAX (hw1, clip.west);
      rit := MIN (hw2, clip.east);
      IF lft < rit THEN
        FillRect (hdc, Rect.FromEdges (lft, rit, vlo, vlo + 1));
        empty := FALSE;
      ELSIF lft > rit AND NOT empty THEN
        (* Generated some painting and then found [lft ..  rit) empty by more
           than one pixel; hence all the remaining lines will be empty, hence:
         *)
        RETURN;
      END;
      (* Advance to next scan line: *)
      INC (vlo);
      INC (hw1, mw1);
      DEC (hf1, mf1);
      IF hf1 < 0 THEN
        INC (hf1, tr.m1.n);
        INC (hw1)
      END;
      INC (hw2, mw2);
      DEC (hf2, mf2);
      IF hf2 < 0 THEN
        INC (hf2, tr.m2.n);
        INC (hw2);
      END;
    END;
  END Trap;
*************************************************************************** Painting Text ***************************************************************************

PROCEDURE TextCom (cmd       : PaintPrivate.CommandPtr;
                   pAdr, endP: PaintPrivate.CommandPtr;
                   hdc       : WinDef.HDC;
                   st        : WinScreenType.T): PaintPrivate.CommandPtr =
  TYPE
    Mode = {PaintBackground, LeaveBackground};
  VAR
    pr        : PolyRegion.T;
    brush, oldBrush : WinDef.HBRUSH;
    oldFont   : WinDef.HFONT;
    oldColor  : WinDef.COLORREF;
    oldBgColor: WinDef.COLORREF;
    oldBgMode : Ctypes.int;
    mode      : Mode;
    status    : WinDef.BOOL;
  BEGIN
    WITH op      = LOOPHOLE (cmd, PaintPrivate.TextPtr),
         clipped = PaintPrivate.Prop.Clipped IN op.props DO

      (* This chunk of code replaces XGC.ResolveTextGC.
       * Unresolved:
       *   - mode determination: In xvbt, the mode depends on the "fill_style"
       *     of the XScrnTpRep.OpRecord: "X.FillOpaqueStippled" sets the mode
       *     to "UseImageString" (ie "PaintBackground"), otherwise it is
       *     is "UseDrawString" (ie "LeaveBackground").
       *   - raster operations for text
       *)
      oldFont := WinGDI.SelectObject (hdc, WinScrnFont.FromFont (op.fnt));
      <* ASSERT oldFont # NIL *>

      IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER(st.optable^) THEN
        WITH tbl = st.optable[op.op] DO
          (* The brush is used for erasing the background *)
          brush := WinGDI.CreateSolidBrush (tbl.bop.col);
          <* ASSERT brush # NIL *>
          oldBrush := WinGDI.SelectObject (hdc, brush);
          <* ASSERT oldBrush # NIL *>
          oldColor := WinGDI.SetTextColor (hdc, tbl.fop.col);
          <* ASSERT oldColor # WinGDI.CLR_INVALID *>

          IF FALSE THEN
            oldBgColor := WinGDI.SetBkColor (hdc, tbl.bop.col);
            <* ASSERT oldBgColor # WinGDI.CLR_INVALID *>
            oldBgMode := WinGDI.SetBkMode (hdc, WinGDI.OPAQUE);
            <* ASSERT oldBgMode # 0 *>
            mode := Mode.PaintBackground;
          ELSE
            oldBgMode := WinGDI.SetBkMode (hdc, WinGDI.TRANSPARENT);
            <* ASSERT oldBgMode # 0 *>
            mode := Mode.LeaveBackground;
          END;
        END;
      ELSE
        (* don't draw anything *)
      END;

      WITH subbed = (mode = Mode.PaintBackground)
           AND PaintPrivate.Prop.FontSub IN op.props DO
        INC (pAdr, op.szOfRec * ADRSIZE(Word.T));
        IF NOT clipped THEN
          IF op.clip.west < op.clip.east THEN
            IF subbed THEN
              FillRect (hdc, op.clip)
            END;
            PaintString(hdc, st, op)
          END
        ELSE
          pr := PolyRegion.Empty;
          PolyRegion.JoinRect (pr, op.clip);
          WHILE  pAdr < endP AND pAdr.command = PC.RepeatCom DO
            IF PolyRegion.OverlapRect (pr, pAdr.clip) THEN
              WITH rgn = PolyRegion.ToRegion (pr) DO
                IF NOT Region.IsEmpty (rgn) THEN
                  SetClipRegion (hdc, rgn);
                  IF subbed THEN
                    FillRect (hdc, rgn.r)
                  END;
                  PaintString (hdc, st, op);
                  UnsetClipRegion (hdc);
                END
              END;
              pr := PolyRegion.Empty
            END;
            PolyRegion.JoinRect (pr, pAdr.clip);
            INC (pAdr, ComSize);
          END;
          WITH rgn = PolyRegion.ToRegion (pr) DO
            IF NOT Region.IsEmpty (rgn) THEN
              SetClipRegion (hdc, rgn);
              IF subbed THEN
                FillRect (hdc, rgn.r)
              END;
              PaintString (hdc, st, op);
              UnsetClipRegion (hdc);
            END;
          END;
        END;
      END;
    END;

    (* Free up things *)
    IF brush # NIL THEN
      oldBrush := WinGDI.SelectObject (hdc, oldBrush);
      <* ASSERT oldBrush = brush *>
      status := WinGDI.DeleteObject (brush);
      <* ASSERT status = True *>
    END;

    oldFont := WinGDI.SelectObject (hdc, oldFont);
    <* ASSERT oldFont # NIL *>

    RETURN pAdr;
  END TextCom;

CONST
  ValidRect = Rect.T{west := -32768, east := 32768, north := -32768,
                     south := 32768};

PROCEDURE PaintString (hdc: WinDef.HDC;
                       st : WinScreenType.T;
                       op : PaintPrivate.TextPtr) =

  PROCEDURE FontIdToScrnFont (st: WinScreenType.T; id: INTEGER): ScrnFont.T =
    BEGIN
      FOR i := FIRST(st.fonts^) TO LAST(st.fonts^) DO
        IF st.fonts[i].id = id THEN
          RETURN st.fonts[i];
        END;
      END;
      <* ASSERT FALSE *>
    END FontIdToScrnFont;

  VAR
    i     := 0;
    newi  : INTEGER;
    dlp   : UNTRACED REF VBT.Displacement :=
                                     op + ADRSIZE(PaintPrivate.TextRec);
    endp  : UNTRACED REF VBT.Displacement :=
                                     dlp + ADRSIZE(VBT.Displacement) * op.dlsz;
    txtp  := LOOPHOLE (endp, Ctypes.char_star);
    blank := M3toC.TtoS(" ");
    delta : Ctypes.int;
    status: Ctypes.int;
  BEGIN
    WITH sz = op.txtsz,
         ascent = FontIdToScrnFont (st, op.fnt).metrics.ascent,
         pt = Point.T {op.refpt.h, op.refpt.v - ascent} DO

      (* If the string is empty, or the text is of-screen, exit *)
      IF sz = 0 OR NOT Rect.Member (pt, ValidRect) THEN
        RETURN;
      END;

      (* Set the current position, and tell windows to move the current
         position upon each call to "TextOut" and "ExtTextOut". *)
      status := WinGDI.SetTextAlign (hdc, WinGDI.TA_UPDATECP);
      <* ASSERT status # WinGDI.GDI_ERROR *>
      status := WinGDI.MoveToEx (hdc, pt.h, pt.v, NIL);
      <* ASSERT status = True *>

      WHILE i < sz DO

        delta := 0;
        WHILE dlp # endp AND dlp.index = i DO
          INC (delta, dlp.dh);
          dlp := dlp + ADRSIZE (VBT.Displacement);
        END;

        (* Emit a blank character of width "delta" *)
        IF delta > 0 THEN
          status := WinGDI.ExtTextOut(hdc, 0, 0, 0, NIL, blank, 1, ADR(delta));
          <* ASSERT status = True *>
        END;

        IF dlp = endp OR dlp.index >= sz THEN
          newi := sz;
        ELSE
          newi := dlp.index
        END;

        (* Draw characters "i" to "newi" - 1 *)
        status := WinGDI.TextOut (hdc, 0, 0, txtp + i, newi - i);
        <* ASSERT status = True *>
        i := newi;
      END;
    END;
  END PaintString;
*************************************************************************** Extensions: Stroking and filling polygons; drawing simple lines. The xvbt version also handles pictures ***************************************************************************

PROCEDURE ExtensionCom (cmdP, endP: PaintPrivate.CommandPtr;
                        hdc       : WinDef.HDC;
                        trsl      : T;
                        st        : WinScreenType.T): PaintPrivate.CommandPtr =
  <* FATAL Path.Malformed *>
  VAR
    op := LOOPHOLE (cmdP, PaintPrivate.ExtensionPtr);
  BEGIN
    INC (cmdP, op.szOfRec * ADRSIZE(Word.T));
    CASE op.subCommand OF
    | PaintExt.FillCommand, PaintExt.StrokeCommand, PaintExt.LineCommand =>
      VAR
        fillP   := LOOPHOLE (op, PaintExt.FillPtr);
        strokeP := LOOPHOLE (op, PaintExt.StrokePtr);
        lineP   := LOOPHOLE (op, PaintExt.LinePtr);
        pathP   : PaintExt.PathPtr;
        path    : Path.T;
        pr      : PolyRegion.T;
        ctxt    : WinContext.T;
      BEGIN
        IF op.subCommand = PaintExt.LineCommand THEN
          ctxt := WinContext.PushStroke (
                      hdc, st, op.op, op.pm,
                      Point.Add(op.delta, lineP.delta),
                      lineP.width, lineP.end, VBT.JoinStyle.Round);
          IF op.delta # Point.Origin THEN
            lineP.p := Point.Add(lineP.p, op.delta);
            lineP.q := Point.Add(lineP.q, op.delta)
          END
        ELSE
          IF op.subCommand = PaintExt.FillCommand THEN
            pathP := ADR(fillP.path);
            ctxt := WinContext.PushFill (
                        hdc, st, op.op, op.pm,
                        Point.Add(op.delta, fillP.delta),
                        fillP.wind);
          ELSIF op.subCommand = PaintExt.StrokeCommand THEN
            pathP := ADR(strokeP.path);
            ctxt := WinContext.PushStroke (
                        hdc, st, op.op, op.pm,
                        Point.Add(op.delta, strokeP.delta),
                        strokeP.width, strokeP.end, strokeP.join);
          END;
          path := NEW(Path.T);
          path.curveCount := pathP.curveCount;
          path.start := pathP + ADRSIZE(pathP^);
          path.next := cmdP;
          path.end := cmdP;
          path.current := cmdP;
          IF op.delta # Point.Origin THEN
            path := Path.Translate(path, op.delta);
          END;
          IF path.curveCount # 0 THEN
            path := Path.Flatten(path);
          END;
        END;
        pr := PolyRegion.Empty;
        PolyRegion.JoinRect(pr, op.clip);
        WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
          IF PolyRegion.OverlapRect(pr, cmdP.clip) THEN
            WITH rgn = PolyRegion.ToRegion(pr) DO
              IF NOT Region.IsEmpty(rgn) THEN
                SetClipRegion (hdc, rgn);
                IF op.subCommand = PaintExt.LineCommand THEN
                  DrawLine (hdc, lineP.p, lineP.q);
                ELSIF op.subCommand = PaintExt.FillCommand THEN
                  FillPath(trsl, hdc, path)
                ELSE
                  StrokePath(trsl, hdc, path)
                END
              END
            END;
            pr := PolyRegion.Empty
          END;
          PolyRegion.JoinRect(pr, cmdP.clip);
          INC (cmdP, ComSize);
        END;
        WITH rgn = PolyRegion.ToRegion(pr) DO
          IF NOT Region.IsEmpty(rgn) THEN
            SetClipRegion (hdc, rgn);
            IF op.subCommand = PaintExt.LineCommand THEN
              DrawLine (hdc, lineP.p, lineP.q);
            ELSIF op.subCommand = PaintExt.FillCommand THEN
              FillPath(trsl, hdc, path)
            ELSE
              StrokePath(trsl, hdc, path)
            END
          END
        END;

        WinContext.Pop (ctxt);
      END;
    | PaintExt.PictureCommand =>
      <* ASSERT FALSE *>  (* pictures are not implemented in WinTrestle *)
    ELSE
      (* skip all "repeat" commands *)
      WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO
        INC(cmdP, ComSize);
      END;
    END;

    RETURN cmdP;
  END ExtensionCom;
This function could move into a module WinWrap

PROCEDURE DrawLine (hdc: WinDef.HDC; a, b: Point.T) =
  VAR
    points := ARRAY [0..1] OF WinDef.POINT {
                                  WinDef.POINT {a.h, a.v},
                                  WinDef.POINT {b.h, b.v}};
    status: WinDef.BOOL;
  BEGIN
    status := WinGDI.Polyline (hdc, ADR(points[0]), 2);
    <* ASSERT status = True *>
  END DrawLine;

TYPE
  StrokeMap = Path.MapObject OBJECT
    trsl: T;
    hdc : WinDef.HDC;
    a   : Points;
    n   : CARDINAL := 0;
  OVERRIDES
    line  := StrokeLine;
    move  := StrokeMove;
    close := StrokeLine
  END;
  Points = UNTRACED REF ARRAY OF WinDef.POINT;

PROCEDURE StrokePath (trsl: T;
                      hdc : WinDef.HDC;
                      path: Path.T) RAISES {TrestleComm.Failure} =
  VAR
    sm := NEW(StrokeMap, trsl := trsl, hdc := hdc, a := NEW (Points, 50));
    <*FATAL Path.Malformed*>
  BEGIN
    Path.Map (path, sm);
    IF sm.n # 0 THEN
      EmitStroke (sm)
    END;
    DISPOSE (sm.a);
    IF trsl.dead THEN
      RAISE TrestleComm.Failure
    END
  END StrokePath;

PROCEDURE StrokeMove (self: StrokeMap; READONLY p: Point.T) =
  BEGIN
    IF self.n # 0 THEN
      EmitStroke (self)
    END;
    self.a[0].x := p.h;
    self.a[0].y := p.v;
    self.n := 1
  END StrokeMove;

PROCEDURE StrokeLine (                    self: StrokeMap;
                      <*UNUSED*> READONLY p   : Point.T;
                                 READONLY q   : Point.T    ) =
  VAR
    m := NUMBER(self.a^);
  BEGIN
    IF self.n = m THEN
      VAR
        newa := NEW(Points, 2 * m);
      BEGIN
        SUBARRAY (newa^, 0, m) := self.a^;
        DISPOSE (self.a);
        self.a := newa;
      END;
    END;
    self.a[self.n].x := q.h;
    self.a[self.n].y := q.v;
    INC (self.n)
  END StrokeLine;

PROCEDURE EmitStroke (sm: StrokeMap) =
  VAR
    status: WinDef.BOOL;
  BEGIN
    IF sm.n = 1 THEN
      sm.a[1] := sm.a[0];
      sm.n := 2
    END;
    IF NOT sm.trsl.dead THEN
      status := WinGDI.Polyline (sm.hdc, ADR(sm.a[0]), sm.n);
      <* ASSERT status = True *>
    END;
    sm.n := 0;
  END EmitStroke;

TYPE
  FillMap = Path.MapObject OBJECT
    trsl         : T;
    a            : Points;
    n            : CARDINAL := 0;
    origin, start: Point.T;
  OVERRIDES
    line  := FillLine;
    move  := FillMove;
    close := FillLine
  END;

PROCEDURE FillPath (trsl: T;
                    hdc : WinDef.HDC;
                    path: Path.T) RAISES {TrestleComm.Failure} =
  <*FATAL Path.Malformed*>
  VAR
    sm := NEW(FillMap, trsl := trsl, a := NEW(Points, 50));
    status: WinDef.BOOL;
  BEGIN
    TRY
      Path.Map (path, sm);
      IF sm.n # 0 THEN
        FillMove (sm, sm.start);
        IF trsl.dead THEN
          RAISE TrestleComm.Failure
        END;
        (* We leave the "polygon fill mode" at its default value of "WINDING".
           This means that complex polygons can contain "islands". *)
        status := WinGDI.Polygon (hdc, ADR(sm.a[0]), sm.n);
        <* ASSERT status = True *>
      END;
    FINALLY
      DISPOSE (sm.a)
    END;
  END FillPath;

PROCEDURE FillMove (self: FillMap; READONLY p: Point.T) =
  BEGIN
    IF self.n = 0 THEN
      self.origin := p
    ELSE
      FillLine (self, Point.Origin, self.start);
      FillLine (self, self.start, self.origin)
    END;
    FillLine (self, self.origin, p);
    self.start := p
  END FillMove;

PROCEDURE FillLine (                    self: FillMap;
                    <*UNUSED*> READONLY p   : Point.T;
                               READONLY q   : Point.T  ) =
  VAR
    m := NUMBER(self.a^);
  BEGIN
    IF self.n = m THEN
      VAR
        newa := NEW (Points, 2 * m);
      BEGIN
        SUBARRAY (newa^, 0, m) := self.a^;
        DISPOSE (self.a);
        self.a := newa
      END
    END;
    self.a[self.n].x := q.h;
    self.a[self.n].y := q.v;
    INC(self.n)
  END FillLine;
Windows maintains batches of paint requests on a per-thread (as opposed to per-window) basis. Batches are flushed by calling GdiFlush. Since Sync can be called by a thread different from the ones that do the painting, it is not sufficient for Sync to call GdiFlush. Instead, we call GdiFlush from Exit, and make Sync a no-op.

The brute-force solition would be to switch off Windows-batching all together.

PROCEDURE Sync (<* UNUSED *> self: T;
                <* UNUSED *> v   : VBT.T;
                <* UNUSED *> wait: BOOLEAN) =
  BEGIN
    (* do nothing *)
  END Sync;
Capture combines XPaint.Capture and XPaint.CapturePM. The X code does some pretty elaborate stuff to determine a ``bad region'' br. I don't do any of that. I guess that the sticky point is what happens if I try to capture a minimized window.

PROCEDURE Capture (            self: T;
                               v   : VBT.T;
                   READONLY    rect: Rect.T;
                   VAR (*out*) br  : Region.T): ScrnPixmap.T =
  VAR
    ur    : Child := v.upRef;
    dstDc : WinDef.HDC;
    oldBmp: WinDef.HBITMAP;
    dstBmp: WinDef.HBITMAP;
    status: WinDef.BOOL;
  BEGIN
    IF rect.west >= rect.east OR v.st = NIL THEN
      br := Region.FromRect(rect);
      RETURN NIL;
    END;

    TRY
      Enter(self);
      TRY
        br := Region.Empty;

        dstDc := WinGDI.CreateCompatibleDC (ur.hdc);
        <* ASSERT dstDc # NIL *>

        dstBmp := WinGDI.CreateCompatibleBitmap (ur.hdc,
                                                 rect.east - rect.west,
                                                 rect.south - rect.north);
        <* ASSERT dstBmp # NIL *>

        oldBmp := WinGDI.SelectObject (dstDc, dstBmp);
        <* ASSERT oldBmp # NIL *>

        status := WinGDI.BitBlt ((* hdcDest *) dstDc,
                                 (* nXDest  *) 0,
                                 (* nYDest  *) 0,
                                 (* nWidth  *) rect.east - rect.west,
                                 (* nHeight *) rect.south - rect.north,
                                 (* hdcSrc  *) ur.hdc,
                                 (* nXSrc   *) rect.west,
                                 (* nYSrc   *) rect.north,
                                 (* dwRop   *) WinGDI.SRCCOPY);
        <* ASSERT status = True *>

        status := WinGDI.DeleteDC (dstDc);
        <* ASSERT status = True *>

        RETURN WinScrnPixmap.NewPixmap (v.st, dstBmp, rect, v.st.depth);
      FINALLY
        Exit(self);
      END;
    EXCEPT
      TrestleComm.Failure =>
        br := Region.FromRect(rect);
        RETURN NIL;
    END;
  END Capture;

PROCEDURE ScreenOf (         self: T;
                             v   : VBT.T;
                    READONLY pt  : Point.T): Trestle.ScreenOfRec =
  VAR
    ur : Child               := v.upRef;
    st : WinScreenType.T     := v.st;
    res: Trestle.ScreenOfRec;
  BEGIN
    res.trsl := self;
    IF st = NIL OR ur = NIL OR ur.offScreen THEN
      res.id := Trestle.NoScreen
    ELSE
      TRY
        Enter(self);
        TRY
          res.id := DesktopID;
          res.dom := st.rootDom;
          IF ur.hwnd # NIL THEN
            res.q := Point.Add (pt, NorthWest(ur));
          ELSE
            res.q := pt;
          END
        FINALLY
          Exit(self);
        END
      EXCEPT
        TrestleComm.Failure =>
        res.id := Trestle.NoScreen;
      END
    END;
    RETURN res;
  END ScreenOf;
Note: The Trestle self must not be locked by the calling thread.

PROCEDURE NewShape (self: T; ch: VBT.T) =
  BEGIN
    IF ch.st # NIL THEN
      VBT.Mark(self);
    END;
  END NewShape;

PROCEDURE Fmt_Selection (s: VBT.Selection): TEXT =
  BEGIN
    IF    s = VBT.NilSel  THEN RETURN "VBT.NilSel"
    ELSIF s = VBT.Forgery THEN RETURN "VBT.Forgery"
    ELSIF s = VBT.KBFocus THEN RETURN "VBT.KBFocus"
    ELSIF s = VBT.Target  THEN RETURN "VBT.Target"
    ELSIF s = VBT.Source  THEN RETURN "VBT.Source"
    ELSE                       RETURN "Selection{" & Fmt.Int(s.sel) & "}";
    END;
  END Fmt_Selection;

PROCEDURE Acquire (self: T;
                   v   : VBT.T;
                   w   : VBT.T;
                   s   : VBT.Selection;
                   ts  : VBT.TimeStamp)
    RAISES {VBT.Error} =
  BEGIN
    IO.Put ("Called WinTrestle.Acquire:  s = " & Fmt_Selection (s) &
            "  ts= " & Fmt.Int (ts) & "\n");

IO.Put (WARNING: WinTrestle.Acquire is not yet implemented \n);

  END Acquire;

PROCEDURE Release (self: T; v: VBT.T; w: VBT.T; s: VBT.Selection) =
  BEGIN
    IO.Put ("WARNING: WinTrestle.Release is not yet implemented \n");
  END Release;

PROCEDURE Put (         self  : T;
                        ch    : VBT.T;
                        w     : VBT.T;
                        s     : VBT.Selection;
                        ts    : VBT.TimeStamp;
                        type  : VBT.MiscCodeType;
               READONLY detail: VBT.MiscCodeDetail)
    RAISES {VBT.Error}=
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END Put;

PROCEDURE Forge (         self  : T;
                          ch    : VBT.T;
                          w     : VBT.T;
                          type  : VBT.MiscCodeType;
                 READONLY detail: VBT.MiscCodeDetail)
    RAISES {VBT.Error} =
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END Forge;

PROCEDURE ReadUp(self: T;
                 ch  : VBT.T;
                 w   : VBT.T;
                 s   : VBT.Selection;
                 ts  : VBT.TimeStamp;
                 tc  : CARDINAL): VBT.Value RAISES {VBT.Error} =
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END ReadUp;

PROCEDURE WriteUp (self: T;
                   ch  : VBT.T;
                   w   : VBT.T;
                   s   : VBT.Selection;
                   ts  : VBT.TimeStamp;
                   val : VBT.Value;
                   tc  : CARDINAL) RAISES {VBT.Error} =
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END WriteUp;

PROCEDURE Attach (self: T; v: VBT.T) RAISES {TrestleComm.Failure} =
  BEGIN
    LOCK v DO
      LOCK self DO
        ProperSplit.Insert (self, NIL, v);
      END;
    END;
  END Attach;
----------------------------------------------------------------------------- The decorate method is introduced by TrestleClass.Public. It is called when the decoration of v has changed from old to new. There is no specification. -----------------------------------------------------------------------------

PROCEDURE Decorate (self: T; v: VBT.T; old, new: TrestleClass.Decoration)
    RAISES {TrestleComm.Failure} =
  BEGIN
    TYPECASE v.upRef OF
    | NULL =>
      (* do nothing *)
    | Child (ch) =>  (* v is indeed a top-level window *)
      Enter (trsl);
      TRY
        SetDecoration (trsl, ch.hwnd, old, new);
      FINALLY
        Exit (trsl);
      END;
    ELSE
      (* do nothing *)
    END;
  END Decorate;
Iconize is called with VBT.mu being locked. We lock trsl to protect the window handle. Then we call WinUser.ShowWindow, which causes a synchronous call to WindowProc, giving it the WM_WINDOWPOSCHANGED message. This in turn causes a call to VBTClass.Reshape, which eventually leads to a call to SetCage. If we were to lock trsl again in SetCage (as the X version does), we would deadlock ...

PROCEDURE Iconize (self: T; v: VBT.T) RAISES {TrestleComm.Failure} =
  VAR
    status : WinDef.BOOL;
    ur     : Child := v.upRef;
  BEGIN
    TRY WinLL.Assert(VBT.mu);
      IF v.st # NIL THEN
        (* Window is already mapped onto the screen *)
        (*Enter(trsl); *)
        TRY
          (* The Windows term "minimize" corresponds to the X term "iconize".
             The Windows term "hide" corresponds to the X term "unmap". *)
          IF ur.decorated THEN
            EVAL WinUser.ShowWindow (ur.hwnd, WinUser.SW_MINIMIZE);
          ELSE
            EVAL WinUser.ShowWindow (ur.hwnd, WinUser.SW_HIDE);
          END;
        FINALLY
          (*Exit(trsl);*)
        END;
      ELSE
        CreateWindow (trsl, v, NIL, Point.T {50, 50}, TRUE);
      END;
    FINALLY WinLL.Retract (VBT.mu) END;
  END Iconize;

PROCEDURE Overlap (                   trsl: T;
                                      v   : VBT.T;
                   <*UNUSED*>         id  : Trestle.ScreenID;
                             READONLY nw  : Point.T)
    RAISES {TrestleComm.Failure} =
  BEGIN
    InnerOverlap(trsl, v, nw, TRUE)
  END Overlap;
Interface procedure. LL = VBT.mu. Makes WinLL assertion.

PROCEDURE MoveNear (self: T; v, w: VBT.T) RAISES {TrestleComm.Failure} =
  VAR
    trsl: Trestle.T;
    ch  : Child;
    st  : WinScreenType.T;
    nw  := Point.T {50, 50};
  BEGIN
      (* The beginning of this procedure is a bit different from its
         counterpart in xvbt. The xvbt version has a (pretty mysterious)
         loop here. *)

      IF w # NIL THEN
        IF NOT TrestleImpl.RootChild (w, trsl, w) THEN
          w := NIL;  (* w is not installed in any trestle *)
        ELSE
          <* ASSERT self = trsl *>  (* ... just a little sanity check *)
        END;
      END;
      (* Assert: w = NIL OR w.parent = self *)

      IF w = v THEN
        w := NIL;
      END;
      (* Assert: w = NIL OR (v # w AND w.parent = self) *)

      IF w # NIL THEN
        ch := w.upRef;
        IF w.st = NIL OR ch.offScreen THEN
          w := NIL;
        END;
      END;
      (* w is NIL, or a different on-screen VBT with welldefined screen type *)

      IF w # NIL THEN
        st := w.st;
        Enter (self);
        TRY
          nw := Point.Add (nw, NorthWest (ch));
        FINALLY
          Exit (self);
        END;
      END;

      InnerOverlap (self, v, nw, w # NIL);

  END MoveNear;

TYPE
  CreateOffscreenRec = REF RECORD
    trsl : T;
    v    : VBT.T;
    st   : WinScreenType.T;
    w, h : CARDINAL;
  END;

PROCEDURE InstallOffScreen (self          : T;
                            v             : VBT.T;
                            width, height : CARDINAL;
                            prefst        : VBT.ScreenType)
    RAISES {TrestleComm.Failure} =
  VAR
    st : WinScreenType.T;
  BEGIN
    (* Determine the screen type *)
    IF prefst.depth = 1 THEN
      st := trsl.screen.bits;
    ELSE
      st := trsl.screen;
    END;
    TYPECASE prefst OF
    | NULL =>
    | WinScreenType.T (wst) => IF wst.trsl = trsl THEN st := wst END;
    ELSE
    END;

    (* Rescreen the VBT *)
    VBTClass.Rescreen(v, st);

    (* Ask the Trestle thread to create the invisible window *)
    LOCK v DO
      WITH cr = NEW (CreateOffscreenRec,
                     trsl := self,
                     v    := v,
                     st   := st,
                     w    := width,
                     h    := height),
           lParam = LOOPHOLE (cr, WinDef.LONG) DO
        EVAL WinUser.SendMessage(self.hwnd, CREATE_OFFSCREEN_VBT, 0, lParam);
      END;
    END;

    (* Reshape the VBT *)
    VBTClass.Reshape (v, Rect.FromSize(width, height), Rect.Empty);
  END InstallOffScreen;
----------------------------------------------------------------------------- TrestleClass.Public introduces a method setColorMap. There is no specification for this method. The X version of Trestle binds a procedure XClient.SetColorMap to the method.

Trestle.SetColorMap is the only place within Trestle that calls this method. Trestle.SetColorMap is dead code, it is neither exported nor used within Trestle.m3. So, it appears to be safe to not provide an implementation. -----------------------------------------------------------------------------

PROCEDURE SetColorMap (self: T; v: VBT.T; cm: ScrnColorMap.T) =
  BEGIN
    <* ASSERT FALSE *>  (* not yet implemented *)
  END SetColorMap;

PROCEDURE GetScreens (self: T): Trestle.ScreenArray =
  BEGIN
    LOCK self DO
      WITH res = NEW (Trestle.ScreenArray, 1) DO
        res[0] := Trestle.Screen{
                      id    := DesktopID,
                      dom   := self.screen.rootDom,
                      delta := Point.Origin,
                      type  := self.screen};
        RETURN res
      END;
    END;
  END GetScreens;

PROCEDURE CaptureScreen (              self: T;
                                       id  : VBT.ScreenID;
                         READONLY      clip: Rect.T;
                         VAR (* out *) br  : Region.T): ScrnPixmap.T
    RAISES {TrestleComm.Failure} =
  VAR
    st    := trsl.screen;
    rect  := Rect.Meet (clip, st.rootDom);
    hwnd  : WinDef.HWND;
    srcDc : WinDef.HDC;
    dstDc : WinDef.HDC;
    oldBmp: WinDef.HBITMAP;
    dstBmp: WinDef.HBITMAP;
    status: WinDef.BOOL;
  BEGIN
    br := Region.Difference (Region.FromRect (clip), Region.FromRect (rect));

    IF rect.west >= rect.east THEN
      RETURN NIL;
    END;

    Enter(self);
    TRY
      hwnd := WinUser.GetDesktopWindow ();

      srcDc := WinUser.GetDC (hwnd);
      <* ASSERT srcDc # NIL *>

      dstDc := WinGDI.CreateCompatibleDC (srcDc);
      <* ASSERT dstDc # NIL *>

      dstBmp := WinGDI.CreateCompatibleBitmap (srcDc,
                                               rect.east - rect.west,
                                               rect.south - rect.north);
      <* ASSERT dstBmp # NIL *>

      oldBmp := WinGDI.SelectObject (dstDc, dstBmp);
      <* ASSERT oldBmp # NIL *>

      status := WinGDI.BitBlt ((* hdcDest *) dstDc,
                               (* nXDest  *) 0,
                               (* nYDest  *) 0,
                               (* nWidth  *) rect.east - rect.west,
                               (* nHeight *) rect.south - rect.north,
                               (* hdcSrc  *) srcDc,
                               (* nXSrc   *) rect.west,
                               (* nYSrc   *) rect.north,
                               (* dwRop   *) WinGDI.SRCCOPY);
      <* ASSERT status = True *>

      status := WinUser.ReleaseDC (hwnd, srcDc);
      <* ASSERT status = True *>

      status := WinGDI.DeleteDC (dstDc);
      <* ASSERT status = True *>

      RETURN WinScrnPixmap.NewPixmap (st, dstBmp, rect, st.depth);
    FINALLY
      Exit(self);
    END;
  END CaptureScreen;

PROCEDURE AllCeded (self: T): BOOLEAN RAISES {TrestleComm.Failure} =
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END AllCeded;

PROCEDURE TickTime (self: T): INTEGER =
  BEGIN
    <* ASSERT FALSE *> (* not yet implemented *)
  END TickTime;

PROCEDURE TrestleID (self: T; v: VBT.T): TEXT =
  BEGIN
    RETURN "Default Trestle"
  END TrestleID;

PROCEDURE WindowID (self: T; v: VBT.T): TEXT =
  BEGIN
    WITH num = LOOPHOLE(WinAux.WindowHandle(v), Ctypes.int) DO
      RETURN Fmt.Unsigned (num, base := 16);
    END;
  END WindowID;
----------------------------------------------------------------------------- These methods are used by Shared Trestle. According to msm, we can make them no-ops in Windows world,where we don't have network transparency, much less sharing. -----------------------------------------------------------------------------

PROCEDURE UpdateChalk (t: T; v: VBT.T; chalk: TEXT) =
  BEGIN
    (* do nothing *)
  END UpdateChalk;

PROCEDURE UpdateBuddies (         self      : T;
                                  v         : VBT.T;
                         READONLY trsls, ids: ARRAY OF TEXT) =
  BEGIN
    (* do nothing *)
  END UpdateBuddies;
***************************************************************************

VAR
  trsl : T  := NIL;
  trslThread: Thread.T;  (* for debugging purposes ... *)

PROCEDURE Connect (): Trestle.T RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN trsl;
  END Connect;

PROCEDURE DoConnect (<*UNUSED*> self     : TrestleClass.ConnectClosure;
                     <*UNUSED*> inst     : TEXT;
                     <*UNUSED*> localOnly: BOOLEAN;
                     VAR (*OUT*) t       : Trestle.T): BOOLEAN =
  BEGIN
    TRY
      t := Connect();
      RETURN TRUE
    EXCEPT
      TrestleComm.Failure =>
      t := NIL;
      RETURN FALSE
    END
  END DoConnect;

PROCEDURE Init () =
  BEGIN
    TrestleClass.RegisterConnectClosure(
      NEW(TrestleClass.ConnectClosure, apply := DoConnect))
  END Init;
***************************************************************************

<*INLINE*> PROCEDURE Enter (trsl: T) RAISES {TrestleComm.Failure} =
  BEGIN
    Thread.Acquire(trsl);
    IF trsl.dead THEN
      Thread.Release(trsl);
      RAISE TrestleComm.Failure;
    END
  END Enter;

<*INLINE*> PROCEDURE Exit (trsl: T; deltaCoverage: [-1 .. 1] := 0)
    RAISES {TrestleComm.Failure} =
  BEGIN
    TRY
      IF trsl.dead THEN
        RAISE TrestleComm.Failure
      END;
      AdjustCoverage(trsl, deltaCoverage);
    FINALLY
      Thread.Release(trsl);
    END;
  END Exit;

PROCEDURE AdjustCoverage (trsl: T; d: [-1 .. 1]) =
  <* FATAL FatalError *>
  BEGIN
    INC (trsl.coverage, d);
    IF trsl.coverage = 0 THEN
      IF WinGDI.GdiFlush() = False THEN
        RAISE FatalError;
      END;
    END;
    (* The X version of AdjustCoverage also checks the event queue to see
       if it contains any events, and if so, signals waiting threads.
       Since Windows uses a callback model in place of an event-queue model,
       we do not have to poll the queue here. *)
  END AdjustCoverage;

PROCEDURE Delete (trsl: T; ch: VBT.T; ur: Child) =
  VAR
    code := VBT.Deleted;
  BEGIN
    IF ur = NIL THEN
      RETURN;
    END;
    LOCK trsl DO
      (* Disassociate the window from any VBT *)
      EVAL trsl.vbts.put (ur.hwnd, NIL);

FOR s := FIRST(trsl.sel^) TO LAST(trsl.sel^) DO IF trsl.sel[s].v = ch THEN trsl.sel[s].v := NIL END END;

IF trsl.dead THEN code := VBT.Disconnected END;

ur.xcage := X.None

    END;
    ProperSplit.Delete(trsl, ur);
    VBTClass.Misc(ch, VBT.MiscRec{code, VBT.NullDetail, 0, VBT.NilSel});
    VBT.Discard(ch)
  END Delete;

PROCEDURE SetDecoration (trsl    : T;
                         hwnd    : WinDef.HWND;
                         old, new: TrestleClass.Decoration) =
  (* The decorations for hwnd have changed from old to new; this procedure
     relays this change to Windows. LL = trsl. *)
  BEGIN
    IF new = NIL OR hwnd = NIL THEN
      RETURN;
    END;
    IF WinUser.IsIconic (hwnd) = 0 THEN
      (* window is not iconized *)
      IF old = NIL OR NOT Text.Equal (old.windowTitle, new.windowTitle) THEN
        SetWindowText (hwnd, new.windowTitle);
      END;
    ELSE
      (* window is iconized *)
      IF old = NIL OR NOT Text.Equal (old.iconTitle, new.iconTitle) THEN
        SetWindowText (hwnd, new.iconTitle);
      END;
    END;
    (* The X version also uses the fields "inst" and "applName" *)
  END SetDecoration;

PROCEDURE SetWindowText (hwnd: WinDef.HWND; title: TEXT) =
  VAR
    status: WinDef.BOOL;
  BEGIN
    status := WinUser.SetWindowText (hwnd, M3toC.TtoS (title));
    <* ASSERT status # 0 *>
  END SetWindowText;

PROCEDURE Reshape (ch: VBT.T; width, height: CARDINAL; sendMoved := FALSE) =
  (* Reshape ch to new width and height.  If this is a no-op, but sendMoved
     is true, then send a miscellaneous code.  LL = VBT.mu *)
  BEGIN
    IF (ch.domain.east # width) OR (ch.domain.south # height) THEN
      WITH new = Rect.FromSize(width, height) DO
        VBTClass.Reshape(ch, new, Rect.Meet(ch.domain, new))
      END
    ELSIF sendMoved THEN
      VBTClass.Misc(
        ch, VBT.MiscRec{VBT.Moved, VBT.NullDetail, 0, VBT.NilSel})
    END
  END Reshape;

PROCEDURE SetSizeHints (VAR      width, height: CARDINAL;
                                 st           : WinScreenType.T;
                        READONLY sh, sv       : VBT.SizeRange) =
  VAR
    max_width  := MAX(MIN(sh.hi - 1, Rect.HorSize(st.rootDom)), sh.lo);
    max_height := MAX(MIN(sv.hi - 1, Rect.VerSize(st.rootDom)), sv.lo);
  BEGIN
    IF sh.pref # 0 THEN
      width := MIN (sh.pref, max_width)
    ELSIF sh.hi > 1 AND sh.hi <= width THEN
      width := max_width
    END;
    IF sv.pref # 0 THEN
      height := MIN (sv.pref, max_height)
    ELSIF sv.hi > 1 AND sv.hi <= height THEN
      height := max_height
    END;
  END SetSizeHints;
NorthWest serves a similar purpose as the ValidateNW function in the X version. The X counterpart of WinTrestle.T maintains a cache nw for the northwest corner), and a flag nwValid that indicates whether the cache entry is valid. ValidateNW will contact the X server only if the cache entry is stale.

I assume that the call to GetWindowRect is cheap enough to use it liberally. Given that, the code gets a lot simpler.

PROCEDURE NorthWest (ch: Child): Point.T =
  VAR
    status    :  WinDef.BOOL;
    screenPos := WinDef.POINT {0, 0};
  BEGIN
    status := WinUser.ClientToScreen (ch.hwnd, ADR (screenPos));
    <* ASSERT status = True *>
    RETURN Point.T {screenPos.x, screenPos.y};
  END NorthWest;
Private procedure. LL = VBT.mu. WinLL assertion made by caller. In comparison to the X version, I did some pretty heavy folding here ...

PROCEDURE InnerOverlap (         trsl         : T;
                                 v            : VBT.T;
                        READONLY nw           : Point.T;
                                 knownPosition: BOOLEAN)
    RAISES {TrestleComm.Failure} =
  VAR
    status: WinDef.BOOL;
    ur    : Child := v.upRef;
    flags         := WinUser.SWP_NOSIZE;
  BEGIN
    IF v.st # NIL THEN
      (* The VBT is already mapped onto the screen *)
      IF NOT knownPosition THEN
        flags := Word.Or (flags, WinUser.SWP_NOMOVE);
      END;
      Enter(trsl);
      TRY
        status := WinUser.SetWindowPos (ur.hwnd,
                                        WinUser.HWND_TOP,
                                        nw.h, nw.v, 0, 0,
                                        flags);
        <* ASSERT status = True *>
      FINALLY
        Exit(trsl)
      END;
    ELSE
      (* The VBT is not yet mapped onto the screen *)
      CreateWindow (trsl, v, trsl.screen, nw, FALSE);
    END;
  END InnerOverlap;

VAR
  hInst               : WinDef.HINSTANCE;
  hAccelTable         : WinDef.HANDLE;
  windowclassName     := M3toC.CopyTtoS("Trestle VBT");

VAR
  titlebar_y  := WinUser.GetSystemMetrics (WinUser.SM_CYSCREEN) -
                 WinUser.GetSystemMetrics (WinUser.SM_CYFULLSCREEN) - 1;
  nonclient_x := 2 * WinUser.GetSystemMetrics (WinUser.SM_CXFRAME);
  nonclient_y := 2 * WinUser.GetSystemMetrics (WinUser.SM_CYFRAME) +
                     titlebar_y;
  screen_x    := 2 * WinUser.GetSystemMetrics (WinUser.SM_CXFRAME) +
                     WinUser.GetSystemMetrics (WinUser.SM_CXSCREEN);
  screen_y    := 2 * WinUser.GetSystemMetrics (WinUser.SM_CYFRAME) +
                     WinUser.GetSystemMetrics (WinUser.SM_CYSCREEN);

<*CALLBACK*> PROCEDURE WindowProc (hwnd   : WinDef.HWND;
                                   message: WinDef.UINT;
                                   wParam : WinDef.WPARAM;
                                   lParam : WinDef.LPARAM  ): WinDef.LRESULT =
  BEGIN
    <* ASSERT Thread.Self() = trslThread *>
PrintMessageType(message);
    CASE message OF
    | CREATE_VBT =>
      CONST
        DefaultWidth  = 133.0;  (* millimeters *)
        DefaultHeight = 100.0;
      VAR
        cl     := LOOPHOLE (lParam, CreateRec);
        trsl   : T               := cl.trsl;
        v      : VBT.T           := cl.v;
        st     : WinScreenType.T := cl.st;
        nw     : Point.T         := cl.nw;
        iconic : BOOLEAN         := cl.iconic;
        dec    : TrestleClass.Decoration;
        ur     : Child           := v.upRef;
        s      : ARRAY Axis.T OF VBT.SizeRange;
        title  : TEXT;
        cs     : WinUser.CREATESTRUCT;
        status : WinDef.BOOL;
        msg    : WinUser.MSG;
        width  : CARDINAL;
        height : CARDINAL;
      BEGIN
        TRY WinLL.Assert(VBT.mu);

          (* We make some part of the creation process a critical section.
             This allows us to squirrel away "v", so that GetVBT can use it
             when being called from WindowProc during WinUser.CreateWindow *)

          VBTClass.Rescreen (v, st);

          width := ROUND(VBT.MMToPixels(v, DefaultWidth, Axis.T.Hor));
          height := ROUND(VBT.MMToPixels(v, DefaultHeight, Axis.T.Ver));
          VAR
            s  := VBTClass.GetShapes(v);
            sh := s[Axis.T.Hor];
            sv := s[Axis.T.Ver];
          BEGIN
            ur.sh := sh;
            ur.sv := sv;
            SetSizeHints(width, height, v.st, sh, sv);
          END;

          dec := VBT.GetProp (v, TYPECODE(TrestleClass.Decoration));

          LOCK trsl DO
            ur.trsl := trsl;
            ur.decorated := dec # NIL;

            (* create the window *)
            IF dec = NIL THEN
              ur.hwnd := WinUser.CreateWindowEx (
                             WinUser.WS_EX_TOPMOST,
                             windowclassName,
                             NIL,
                             WinUser.WS_POPUP,
                             nw.h, nw.v,
                             width, height,
                             NIL, NIL, hInst,
                             ADR (cs));
            ELSE
              IF iconic THEN
                title := dec.iconTitle;
              ELSE
                title := dec.windowTitle;
              END;
              ur.hwnd := WinUser.CreateWindow (
                             windowclassName,
                             M3toC.CopyTtoS (title),
                             WinUser.WS_OVERLAPPEDWINDOW,
                             nw.h, nw.v,
                             width + nonclient_x, height + nonclient_y,
                             NIL, NIL, hInst,
                             ADR (cs));

            END;
            <* ASSERT ur.hwnd # NIL *>

            (* Cache the device context in the "Child" record. Note that we
               can do this only because we declared the device context to be
               private ("CS_OWNDC"). *)
            ur.hdc := WinUser.GetDC (ur.hwnd);
            <* ASSERT ur.hdc # NIL *>

            WinScrnColorMap.InstallDefaultPalette (v);

            VAR
              status : WinDef.BOOL;
              rect   : WinDef.RECT;
            BEGIN
              status := WinUser.GetClientRect (ur.hwnd, ADR(rect));
              <* ASSERT status = True *>
              IO.Put ("requested size = " &
                      Fmt.Int(width) & " x " & Fmt.Int(height) & "\n");
              IO.Put ("client rect = " &
                      Fmt.Int(rect.right - rect.left) & " x " &
                      Fmt.Int(rect.bottom - rect.top) & "\n");
            END;

            (* update "trsl.vbts" to map "v.upRef.hwnd" to "v" *)
            EVAL trsl.vbts.put (ur.hwnd, v);

            IF dec # NIL THEN
              SetDecoration (trsl, ur.hwnd, NIL, dec);
            END;
          END;

          EVAL WinUser.ShowWindow (ur.hwnd, WinUser.SW_SHOWDEFAULT);

          (* Update the window (repaint its client area) *)
          status := WinUser.UpdateWindow (ur.hwnd);
          <* ASSERT status # 0 *>

        FINALLY WinLL.Retract(VBT.mu) END;
        RETURN 0;
      END;
    | CREATE_OFFSCREEN_VBT =>
      VAR
        cl    := LOOPHOLE (lParam, CreateOffscreenRec);
        trsl  : T               := cl.trsl;
        v     : VBT.T           := cl.v;
        st    : WinScreenType.T := cl.st;
        width : CARDINAL        := cl.w;
        height: CARDINAL        := cl.h;
        ur    : Child;
        cs    : WinUser.CREATESTRUCT;
        status: WinDef.BOOL;
      BEGIN
        TRY WinLL.Assert(VBT.mu);

          (* We make some part of the creation process a critical section.
             This allows us to squirrel away "v", so that GetVBT can use it
             when being called from WindowProc during WinUser.CreateWindow *)

          LOCK trsl DO
            ur := v.upRef;
            ur.trsl := trsl;
            ur.decorated := FALSE;

            (* create the window *)
            ur.hwnd := WinUser.CreateWindow (
                           windowclassName,
                           NIL,
                           WinUser.WS_BORDER,
                           0, 0, width, height,
                           NIL, NIL, hInst,
                           ADR (cs));
            <* ASSERT ur.hwnd # NIL *>

            (* update "trsl.vbts" to map "v.upRef.hwnd" to "v" *)
            EVAL trsl.vbts.put (ur.hwnd, v);
          END;

          EVAL WinUser.ShowWindow (ur.hwnd, WinUser.SW_HIDE);

          (* Update the window (repaint its client area) *)
          status := WinUser.UpdateWindow (ur.hwnd);
          <* ASSERT status # 0 *>

        FINALLY WinLL.Retract(VBT.mu) END;
        RETURN 0;
      END;
    | RESHAPE_VBT =>
      (* These messages should be delivered asynchronously, via "PostMessage".
         In this case, the locking-level is 0. *)
      CONST
        Flags = WinUser.SWP_NOMOVE + WinUser.SWP_NOZORDER +
                WinUser.SWP_NOACTIVATE;
      VAR
        status : WinDef.BOOL;
      BEGIN
        status := WinUser.SetWindowPos (hwnd,
                                        NIL, 0, 0,  (* all ignored *)
                                        wParam, lParam,
                                        Flags);
        RETURN 0;
      END;
    | WinUser.WM_GETMINMAXINFO =>
      (* If "trsl.hwnd" is NIL, then we are right now in the process of
         creating the "null window" that represents the Trestle. In this
         case, we simply return. *)
      IF trsl.hwnd = NIL THEN
        RETURN 0;
      END;

      (* This code is taken almost verbatim from Steve. It determines the
         shape of the VBT corresponding to hwnd, and tells Windows to
         constrain the window accordingly. *)
      VAR
        sizes: ARRAY Axis.T OF VBT.SizeRange;
        v    := GetVBT (trsl, hwnd);
      BEGIN
        IF v = NIL THEN
          RETURN 0;
        END;

        TRY WinLL.Acquire(VBT.mu);
          sizes := VBTClass.GetShapes (v);
        FINALLY  WinLL.Release(VBT.mu) END;

        WITH min_x = sizes[Axis.T.Hor].lo + nonclient_x,
             min_y = sizes[Axis.T.Ver].lo + nonclient_y,
             max_x = MIN (sizes[Axis.T.Hor].hi - 1 + nonclient_x, screen_x),
             max_y = MIN (sizes[Axis.T.Ver].hi - 1 + nonclient_y, screen_y),
             MinMaxInfoPtr = LOOPHOLE (lParam, WinUser.LPMINMAXINFO) DO
          (* lParam points to a windows structure. So, assigning to this
             structure changes a Windows data structure. In effect, lParam
             is an OUT parameter. *)
          MinMaxInfoPtr.ptMaxSize.x      := max_x;
          MinMaxInfoPtr.ptMaxSize.y      := max_y;
          MinMaxInfoPtr.ptMinTrackSize.x := min_x;
          MinMaxInfoPtr.ptMinTrackSize.y := min_y;
          MinMaxInfoPtr.ptMaxTrackSize.x := max_x;
          MinMaxInfoPtr.ptMaxTrackSize.y := max_y;
        END;
      END;
      RETURN 0;
    | WinUser.WM_PAINT =>
      (* Repaint the damaged portion of the window *)
      VAR
        r     : WinDef.RECT;
        status: WinDef.BOOL;
        v     := GetVBT (trsl, hwnd);
      BEGIN
        IF WinUser.GetUpdateRect (hwnd, ADR(r), False) = True THEN
          status := WinUser.ValidateRect (hwnd, ADR(r));
               (* a candidate for WinWrap module ... *)
          <* ASSERT status = True *>
          TRY WinLL.Acquire(VBT.mu);
            VBTClass.Repaint (v, Region.FromRect (ToRect (r)));
          FINALLY  WinLL.Release(VBT.mu) END;
        END;
      END;
      RETURN 0;
    | WinUser.WM_WINDOWPOSCHANGED =>
      (* This code is taken almost verbatim from Steve ... *)
      VAR
        rc    : WinDef.RECT;
        new   : Rect.T;
        v     : VBT.T := GetVBT (trsl, hwnd);
        status: WinDef.BOOL;
      BEGIN
        (*** If the VBT is already deleted, bail out ***)
        IF v = NIL THEN
          RETURN 0;
        END;

        status := WinUser.GetClientRect (hwnd, ADR(rc));
           (* a candidate for WinWrap module ... *)
        <* ASSERT status = True *>
        new := ToRect (rc);
        TRY WinLL.Acquire (VBT.mu);
          IF v.domain # new THEN
            VBTClass.Reshape (v, new, Rect.Meet(v.domain, new));
          ELSE
            VBTClass.Misc (v, VBT.MiscRec{VBT.Moved, VBT.NullDetail,
                                          0, VBT.NilSel});
          END;
        FINALLY WinLL.Release (VBT.mu) END;
      END;
      RETURN 0;
    | WinUser.WM_ACTIVATE =>
      (* This is derived from "XMessenger.EnterLeave".  The original
         procedure does a lot more ... *)
      VAR
        v    := GetVBT (trsl, hwnd);
        time := WinUser.GetMessageTime () + 1;
      BEGIN
        IF WinDef.LOWORD (wParam) = WinUser.WA_INACTIVE THEN
          VBTClass.Misc(v,
                        VBT.MiscRec{VBT.Lost, VBT.NullDetail, 0, VBT.KBFocus})
        ELSE
          VBTClass.Misc(v, VBT.MiscRec{VBT.TakeSelection, VBT.NullDetail,
                                       time, VBT.KBFocus});
        END;
      END;
      RETURN 0;
    | WinUser.WM_SETCURSOR =>
      VAR
        v := GetVBT (trsl, hwnd);
      BEGIN
        IF WinDef.LOWORD (lParam) = WinUser.HTCLIENT THEN
          LOCK VBT.mu DO
            WinScrnCursor.SetCursor (v.getcursor());
          END;
          RETURN 0;
        ELSE
          RETURN WinUser.DefWindowProc (hwnd, message, wParam, lParam);
        END;
      END;
    | WinUser.WM_QUERYNEWPALETTE =>
      VAR
        v       := GetVBT (trsl, hwnd);
        ur      : Child := v.upRef;
        numCols : INTEGER;
        status  : WinDef.BOOL;
        oldPal  : WinDef.HPALETTE;
      BEGIN
        IF ur.hpal # NIL THEN
          oldPal := WinGDI.SelectPalette (ur.hdc, ur.hpal, False);
          <* ASSERT oldPal # NIL *>

          status := WinGDI.UnrealizeObject (ur.hpal);
          <* ASSERT status = True *>

          numCols := WinGDI.RealizePalette (ur.hdc);
          <* ASSERT numCols # WinGDI.GDI_ERROR *>
        END;
      END;
      RETURN True;
    | WinUser.WM_KEYDOWN =>
      (* need to update the per-Trestle modifier set *)
      (* need to translate the Windows virtual key into a Trestle KeySym *)
      WITH v = GetVBT (trsl, hwnd),
           keysym = VirtualKeyToKeySym (wParam),
           time = WinUser.GetMessageTime(),
           modifiers = VBT.Modifiers{} DO
        LOCK VBT.mu DO
          VBTClass.Key (v, VBT.KeyRec {keysym, time, TRUE, modifiers});
        END;
      END;
      RETURN 0;
    | WinUser.WM_KEYUP =>
      (* need to update the per-Trestle modifier set *)
      (* need to translate the Windows virtual key into a Trestle KeySym *)
      WITH v = GetVBT (trsl, hwnd),
           keysym = VirtualKeyToKeySym (wParam),
           time = WinUser.GetMessageTime(),
           modifiers = VBT.Modifiers{} DO
        LOCK VBT.mu DO
          VBTClass.Key (v, VBT.KeyRec {keysym, time, FALSE, modifiers});
        END;
      END;
      RETURN 0;
    | WinUser.WM_LBUTTONDOWN =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Left, Transition.Press);
        RETURN 0;
      END;
    | WinUser.WM_LBUTTONUP =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Left, Transition.Release);
        RETURN 0;
      END;
    | WinUser.WM_MBUTTONDOWN =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Middle, Transition.Press);
        RETURN 0;
      END;
    | WinUser.WM_MBUTTONUP =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Middle, Transition.Release);
        RETURN 0;
      END;
    | WinUser.WM_RBUTTONDOWN =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Right, Transition.Press);
        RETURN 0;
      END;
    | WinUser.WM_RBUTTONUP =>
      LOCK VBT.mu DO
        ButtonEvent (hwnd, lParam, wParam, Button.Right, Transition.Release);
        RETURN 0;
      END;
    | WinUser.WM_MOUSEMOVE =>
      LOCK VBT.mu DO
        DeliverMousePos (hwnd, lParam, wParam);
        RETURN 0;
      END;
    | WinUser.WM_TIMER =>
      VAR
        status   : WinDef.BOOL;
        screenPos: WinDef.POINT;
        lParam   : WinDef.LPARAM;
      BEGIN
        (* It would seem that I should acquire VBT.mu. For some reason,
           however, I am deadlocking if I do so. *)
        IF trsl.mouseFocus = NIL THEN
          status := WinUser.GetCursorPos (ADR (screenPos));
          <* ASSERT status = True *>
          lParam := LOOPHOLE (WinDef.POINTS {screenPos.x, screenPos.y},
                              WinDef.LPARAM);
          DeliverMousePos (hwnd, lParam, 0);
        END;
      END;
      RETURN 0;
    | WinUser.WM_DESTROY =>
      (* Delete "hwnd" from the window-handle-to-vbt map of the trestle. *)
      VAR
        junk: REFANY;
      BEGIN
        LOCK trsl DO
          EVAL trsl.vbts.delete (hwnd, junk);
        END;
      END;
      RETURN WinUser.WM_DESTROY;
    ELSE
      RETURN WinUser.DefWindowProc (hwnd, message, wParam, lParam);
    END;
  END WindowProc;

PROCEDURE DumpSystemPalette (hdc : WinDef.HDC) =
  VAR
    num1, num2 : INTEGER;
    entries : REF ARRAY OF WinGDI.PALETTEENTRY;
  BEGIN
    (* Determine size of system palette *)
    num1 := WinGDI.GetSystemPaletteEntries (hdc, 0, 256, NIL);
    <* ASSERT num1 # 0 *>

    (* Get the system palette entries *)
    entries := NEW (REF ARRAY OF WinGDI.PALETTEENTRY, num1);
    num2 := WinGDI.GetSystemPaletteEntries (hdc, 0, num1, ADR(entries[0]));
    <* ASSERT num2 = num1 *>

    FOR i := 0 TO num2 - 1 DO
      IO.Put ("entry[" & Fmt.Int (i) &"] = {" &
              Fmt.Int (entries[i].peRed) & "," &
              Fmt.Int (entries[i].peGreen) & "," &
              Fmt.Int (entries[i].peBlue) & "," &
              Fmt.Int (entries[i].peFlags) & "}\n");
    END;
  END DumpSystemPalette;

PROCEDURE VirtualKeyToKeySym (vk: [0 .. 255]): VBT.KeySym =
  VAR
    shifted := Word.And (WinUser.GetKeyState (WinUser.VK_SHIFT), 16_8000) # 0;
  BEGIN
    IF NOT shifted THEN
      CASE vk OF
      | (* 01 *) WinUser.VK_LBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 02 *) WinUser.VK_RBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 03 *) WinUser.VK_CANCEL   => RETURN KeyboardKey.Cancel;
      | (* 04 *) WinUser.VK_MBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 08 *) WinUser.VK_BACK     => RETURN KeyboardKey.BackSpace;
      | (* 09 *) WinUser.VK_TAB      => RETURN KeyboardKey.Tab;
      | (* 0C *) WinUser.VK_CLEAR    => RETURN KeyboardKey.Clear;
      | (* 0D *) WinUser.VK_RETURN   => RETURN KeyboardKey.Return;

      | (* 10 *) WinUser.VK_SHIFT    => RETURN KeyboardKey.Shift_L;   (* simplification *)
      | (* 11 *) WinUser.VK_CONTROL  => RETURN KeyboardKey.Control_L; (* simplification *)
      | (* 12 *) WinUser.VK_MENU     => RETURN KeyboardKey.Menu;
      | (* 13 *) WinUser.VK_PAUSE    => RETURN KeyboardKey.Pause;
      | (* 14 *) WinUser.VK_CAPITAL  => RETURN KeyboardKey.Caps_Lock;
      | (* 1B *) WinUser.VK_ESCAPE   => RETURN KeyboardKey.Escape;

      | (* 20 *) WinUser.VK_SPACE    => RETURN Latin1Key.space;
      | (* 21 *) WinUser.VK_PRIOR    => RETURN KeyboardKey.Prior;
      | (* 22 *) WinUser.VK_NEXT     => RETURN KeyboardKey.Next;
      | (* 23 *) WinUser.VK_END      => RETURN KeyboardKey.End;
      | (* 24 *) WinUser.VK_HOME     => RETURN KeyboardKey.Home;
      | (* 25 *) WinUser.VK_LEFT     => RETURN KeyboardKey.Left;
      | (* 26 *) WinUser.VK_UP       => RETURN KeyboardKey.Up;
      | (* 27 *) WinUser.VK_RIGHT    => RETURN KeyboardKey.Right;
      | (* 28 *) WinUser.VK_DOWN     => RETURN KeyboardKey.Down;
      | (* 29 *) WinUser.VK_SELECT   => RETURN KeyboardKey.Select;
      | (* 2A *) WinUser.VK_PRINT    => RETURN KeyboardKey.Print;
      | (* 2B *) WinUser.VK_EXECUTE  => RETURN KeyboardKey.Execute;
      | (* 2C *) WinUser.VK_SNAPSHOT => RETURN KeyboardKey.VoidSymbol;
      | (* 2D *) WinUser.VK_INSERT   => RETURN KeyboardKey.Insert;
      | (* 2E *) WinUser.VK_DELETE   => RETURN KeyboardKey.Delete;
      | (* 2F *) WinUser.VK_HELP     => RETURN KeyboardKey.Help;

      | 16_30 => RETURN Latin1Key.zero;
      | 16_31 => RETURN Latin1Key.one;
      | 16_32 => RETURN Latin1Key.two;
      | 16_33 => RETURN Latin1Key.three;
      | 16_34 => RETURN Latin1Key.four;
      | 16_35 => RETURN Latin1Key.five;
      | 16_36 => RETURN Latin1Key.six;
      | 16_37 => RETURN Latin1Key.seven;
      | 16_38 => RETURN Latin1Key.eight;
      | 16_39 => RETURN Latin1Key.nine;

      | 16_41 => RETURN Latin1Key.a;
      | 16_42 => RETURN Latin1Key.b;
      | 16_43 => RETURN Latin1Key.c;
      | 16_44 => RETURN Latin1Key.d;
      | 16_45 => RETURN Latin1Key.e;
      | 16_46 => RETURN Latin1Key.f;
      | 16_47 => RETURN Latin1Key.g;
      | 16_48 => RETURN Latin1Key.h;
      | 16_49 => RETURN Latin1Key.i;
      | 16_4A => RETURN Latin1Key.j;
      | 16_4B => RETURN Latin1Key.k;
      | 16_4C => RETURN Latin1Key.l;
      | 16_4D => RETURN Latin1Key.m;
      | 16_4E => RETURN Latin1Key.n;
      | 16_4F => RETURN Latin1Key.o;
      | 16_50 => RETURN Latin1Key.p;
      | 16_51 => RETURN Latin1Key.q;
      | 16_52 => RETURN Latin1Key.r;
      | 16_53 => RETURN Latin1Key.s;
      | 16_54 => RETURN Latin1Key.t;
      | 16_55 => RETURN Latin1Key.u;
      | 16_56 => RETURN Latin1Key.v;
      | 16_57 => RETURN Latin1Key.w;
      | 16_58 => RETURN Latin1Key.x;
      | 16_59 => RETURN Latin1Key.y;
      | 16_5A => RETURN Latin1Key.z;

      | (* 60 *) WinUser.VK_NUMPAD0   => RETURN KeyboardKey.KP_0;
      | (* 61 *) WinUser.VK_NUMPAD1   => RETURN KeyboardKey.KP_1;
      | (* 62 *) WinUser.VK_NUMPAD2   => RETURN KeyboardKey.KP_2;
      | (* 63 *) WinUser.VK_NUMPAD3   => RETURN KeyboardKey.KP_3;
      | (* 64 *) WinUser.VK_NUMPAD4   => RETURN KeyboardKey.KP_4;
      | (* 65 *) WinUser.VK_NUMPAD5   => RETURN KeyboardKey.KP_5;
      | (* 66 *) WinUser.VK_NUMPAD6   => RETURN KeyboardKey.KP_6;
      | (* 67 *) WinUser.VK_NUMPAD7   => RETURN KeyboardKey.KP_7;
      | (* 68 *) WinUser.VK_NUMPAD8   => RETURN KeyboardKey.KP_8;
      | (* 69 *) WinUser.VK_NUMPAD9   => RETURN KeyboardKey.KP_9;
      | (* 6A *) WinUser.VK_MULTIPLY  => RETURN KeyboardKey.KP_Multiply;
      | (* 6B *) WinUser.VK_ADD       => RETURN KeyboardKey.KP_Add;
      | (* 6C *) WinUser.VK_SEPARATOR => RETURN KeyboardKey.KP_Separator;
      | (* 6D *) WinUser.VK_SUBTRACT  => RETURN KeyboardKey.KP_Subtract;
      | (* 6E *) WinUser.VK_DECIMAL   => RETURN KeyboardKey.KP_Decimal;
      | (* 6F *) WinUser.VK_DIVIDE    => RETURN KeyboardKey.KP_Divide;

      | (* 70 *) WinUser.VK_F1        => RETURN KeyboardKey.F1;
      | (* 71 *) WinUser.VK_F2        => RETURN KeyboardKey.F2;
      | (* 72 *) WinUser.VK_F3        => RETURN KeyboardKey.F3;
      | (* 73 *) WinUser.VK_F4        => RETURN KeyboardKey.F4;
      | (* 74 *) WinUser.VK_F5        => RETURN KeyboardKey.F5;
      | (* 75 *) WinUser.VK_F6        => RETURN KeyboardKey.F6;
      | (* 76 *) WinUser.VK_F7        => RETURN KeyboardKey.F7;
      | (* 77 *) WinUser.VK_F8        => RETURN KeyboardKey.F8;
      | (* 78 *) WinUser.VK_F9        => RETURN KeyboardKey.F9;
      | (* 79 *) WinUser.VK_F10       => RETURN KeyboardKey.F10;
      | (* 7A *) WinUser.VK_F11       => RETURN KeyboardKey.F11;
      | (* 7B *) WinUser.VK_F12       => RETURN KeyboardKey.F12;
      | (* 7C *) WinUser.VK_F13       => RETURN KeyboardKey.F13;
      | (* 7D *) WinUser.VK_F14       => RETURN KeyboardKey.F14;
      | (* 7E *) WinUser.VK_F15       => RETURN KeyboardKey.F15;
      | (* 7F *) WinUser.VK_F16       => RETURN KeyboardKey.F16;
      | (* 80 *) WinUser.VK_F17       => RETURN KeyboardKey.F17;
      | (* 81 *) WinUser.VK_F18       => RETURN KeyboardKey.F18;
      | (* 82 *) WinUser.VK_F19       => RETURN KeyboardKey.F19;
      | (* 83 *) WinUser.VK_F20       => RETURN KeyboardKey.F20;
      | (* 84 *) WinUser.VK_F21       => RETURN KeyboardKey.F21;
      | (* 85 *) WinUser.VK_F22       => RETURN KeyboardKey.F22;
      | (* 86 *) WinUser.VK_F23       => RETURN KeyboardKey.F23;
      | (* 87 *) WinUser.VK_F24       => RETURN KeyboardKey.F24;

      | (* 90 *) WinUser.VK_NUMLOCK   => RETURN KeyboardKey.Num_Lock;
      | (* 91 *) WinUser.VK_SCROLL    => RETURN KeyboardKey.Scroll_Lock;

      | (* A0 *) WinUser.VK_LSHIFT    => RETURN KeyboardKey.Shift_L;
      | (* A1 *) WinUser.VK_RSHIFT    => RETURN KeyboardKey.Shift_R;
      | (* A2 *) WinUser.VK_LCONTROL  => RETURN KeyboardKey.Control_L;
      | (* A3 *) WinUser.VK_RCONTROL  => RETURN KeyboardKey.Control_R;
      | (* A4 *) WinUser.VK_LMENU     => RETURN KeyboardKey.Alt_L;
      | (* A5 *) WinUser.VK_RMENU     => RETURN KeyboardKey.Alt_R;

      (* The next few codes are device-specific ... *)

      | 16_BA => RETURN Latin1Key.semicolon;
      | 16_BB => RETURN Latin1Key.equal;
      | 16_BC => RETURN Latin1Key.comma;
      | 16_BD => RETURN Latin1Key.minus;
      | 16_BE => RETURN Latin1Key.period;
      | 16_BF => RETURN Latin1Key.slash;
      | 16_C0 => RETURN Latin1Key.grave;
      | 16_DB => RETURN Latin1Key.bracketleft;
      | 16_DC => RETURN Latin1Key.backslash;
      | 16_DD => RETURN Latin1Key.bracketright;
      | 16_DE => RETURN Latin1Key.apostrophe;

      | (* F6 *) WinUser.VK_ATTN      => RETURN KeyboardKey.VoidSymbol;
      | (* F7 *) WinUser.VK_CRSEL     => RETURN KeyboardKey.VoidSymbol;
      | (* F8 *) WinUser.VK_EXSEL     => RETURN KeyboardKey.VoidSymbol;
      | (* F9 *) WinUser.VK_EREOF     => RETURN KeyboardKey.VoidSymbol;
      | (* FA *) WinUser.VK_PLAY      => RETURN KeyboardKey.VoidSymbol;
      | (* FB *) WinUser.VK_ZOOM      => RETURN KeyboardKey.VoidSymbol;
      | (* FC *) WinUser.VK_NONAME    => RETURN KeyboardKey.VoidSymbol;
      | (* FD *) WinUser.VK_PA1       => RETURN KeyboardKey.VoidSymbol;
      | (* FE *) WinUser.VK_OEM_CLEAR => RETURN KeyboardKey.VoidSymbol;

      ELSE
        RETURN KeyboardKey.VoidSymbol;
      END;

    ELSE

      CASE vk OF
      | (* 01 *) WinUser.VK_LBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 02 *) WinUser.VK_RBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 03 *) WinUser.VK_CANCEL   => RETURN KeyboardKey.Cancel;
      | (* 04 *) WinUser.VK_MBUTTON  => RETURN KeyboardKey.VoidSymbol;
      | (* 08 *) WinUser.VK_BACK     => RETURN KeyboardKey.BackSpace;
      | (* 09 *) WinUser.VK_TAB      => RETURN KeyboardKey.Tab;
      | (* 0C *) WinUser.VK_CLEAR    => RETURN KeyboardKey.Clear;
      | (* 0D *) WinUser.VK_RETURN   => RETURN KeyboardKey.Return;

      | (* 10 *) WinUser.VK_SHIFT    => RETURN KeyboardKey.Shift_L;   (* simplification *)
      | (* 11 *) WinUser.VK_CONTROL  => RETURN KeyboardKey.Control_L; (* simplification *)
      | (* 12 *) WinUser.VK_MENU     => RETURN KeyboardKey.Menu;
      | (* 13 *) WinUser.VK_PAUSE    => RETURN KeyboardKey.Pause;
      | (* 14 *) WinUser.VK_CAPITAL  => RETURN KeyboardKey.Caps_Lock;
      | (* 1B *) WinUser.VK_ESCAPE   => RETURN KeyboardKey.Escape;

      | (* 20 *) WinUser.VK_SPACE    => RETURN Latin1Key.space;
      | (* 21 *) WinUser.VK_PRIOR    => RETURN KeyboardKey.Prior;
      | (* 22 *) WinUser.VK_NEXT     => RETURN KeyboardKey.Next;
      | (* 23 *) WinUser.VK_END      => RETURN KeyboardKey.End;
      | (* 24 *) WinUser.VK_HOME     => RETURN KeyboardKey.Home;
      | (* 25 *) WinUser.VK_LEFT     => RETURN KeyboardKey.Left;
      | (* 26 *) WinUser.VK_UP       => RETURN KeyboardKey.Up;
      | (* 27 *) WinUser.VK_RIGHT    => RETURN KeyboardKey.Right;
      | (* 28 *) WinUser.VK_DOWN     => RETURN KeyboardKey.Down;
      | (* 29 *) WinUser.VK_SELECT   => RETURN KeyboardKey.Select;
      | (* 2A *) WinUser.VK_PRINT    => RETURN KeyboardKey.Print;
      | (* 2B *) WinUser.VK_EXECUTE  => RETURN KeyboardKey.Execute;
      | (* 2C *) WinUser.VK_SNAPSHOT => RETURN KeyboardKey.VoidSymbol;
      | (* 2D *) WinUser.VK_INSERT   => RETURN KeyboardKey.Insert;
      | (* 2E *) WinUser.VK_DELETE   => RETURN KeyboardKey.Delete;
      | (* 2F *) WinUser.VK_HELP     => RETURN KeyboardKey.Help;

      | 16_30 => RETURN Latin1Key.parenright;
      | 16_31 => RETURN Latin1Key.exclam;
      | 16_32 => RETURN Latin1Key.at;
      | 16_33 => RETURN Latin1Key.numbersign;
      | 16_34 => RETURN Latin1Key.dollar;
      | 16_35 => RETURN Latin1Key.percent;
      | 16_36 => RETURN Latin1Key.asciicircum;
      | 16_37 => RETURN Latin1Key.ampersand;
      | 16_38 => RETURN Latin1Key.asterisk;
      | 16_39 => RETURN Latin1Key.parenleft;

      | 16_41 => RETURN Latin1Key.A;
      | 16_42 => RETURN Latin1Key.B;
      | 16_43 => RETURN Latin1Key.C;
      | 16_44 => RETURN Latin1Key.D;
      | 16_45 => RETURN Latin1Key.E;
      | 16_46 => RETURN Latin1Key.F;
      | 16_47 => RETURN Latin1Key.G;
      | 16_48 => RETURN Latin1Key.H;
      | 16_49 => RETURN Latin1Key.I;
      | 16_4A => RETURN Latin1Key.J;
      | 16_4B => RETURN Latin1Key.K;
      | 16_4C => RETURN Latin1Key.L;
      | 16_4D => RETURN Latin1Key.M;
      | 16_4E => RETURN Latin1Key.N;
      | 16_4F => RETURN Latin1Key.O;
      | 16_50 => RETURN Latin1Key.P;
      | 16_51 => RETURN Latin1Key.Q;
      | 16_52 => RETURN Latin1Key.R;
      | 16_53 => RETURN Latin1Key.S;
      | 16_54 => RETURN Latin1Key.T;
      | 16_55 => RETURN Latin1Key.U;
      | 16_56 => RETURN Latin1Key.V;
      | 16_57 => RETURN Latin1Key.W;
      | 16_58 => RETURN Latin1Key.X;
      | 16_59 => RETURN Latin1Key.Y;
      | 16_5A => RETURN Latin1Key.Z;

      | (* 60 *) WinUser.VK_NUMPAD0   => RETURN KeyboardKey.KP_0;
      | (* 61 *) WinUser.VK_NUMPAD1   => RETURN KeyboardKey.KP_1;
      | (* 62 *) WinUser.VK_NUMPAD2   => RETURN KeyboardKey.KP_2;
      | (* 63 *) WinUser.VK_NUMPAD3   => RETURN KeyboardKey.KP_3;
      | (* 64 *) WinUser.VK_NUMPAD4   => RETURN KeyboardKey.KP_4;
      | (* 65 *) WinUser.VK_NUMPAD5   => RETURN KeyboardKey.KP_5;
      | (* 66 *) WinUser.VK_NUMPAD6   => RETURN KeyboardKey.KP_6;
      | (* 67 *) WinUser.VK_NUMPAD7   => RETURN KeyboardKey.KP_7;
      | (* 68 *) WinUser.VK_NUMPAD8   => RETURN KeyboardKey.KP_8;
      | (* 69 *) WinUser.VK_NUMPAD9   => RETURN KeyboardKey.KP_9;
      | (* 6A *) WinUser.VK_MULTIPLY  => RETURN KeyboardKey.KP_Multiply;
      | (* 6B *) WinUser.VK_ADD       => RETURN KeyboardKey.KP_Add;
      | (* 6C *) WinUser.VK_SEPARATOR => RETURN KeyboardKey.KP_Separator;
      | (* 6D *) WinUser.VK_SUBTRACT  => RETURN KeyboardKey.KP_Subtract;
      | (* 6E *) WinUser.VK_DECIMAL   => RETURN KeyboardKey.KP_Decimal;
      | (* 6F *) WinUser.VK_DIVIDE    => RETURN KeyboardKey.KP_Divide;

      | (* 70 *) WinUser.VK_F1        => RETURN KeyboardKey.F1;
      | (* 71 *) WinUser.VK_F2        => RETURN KeyboardKey.F2;
      | (* 72 *) WinUser.VK_F3        => RETURN KeyboardKey.F3;
      | (* 73 *) WinUser.VK_F4        => RETURN KeyboardKey.F4;
      | (* 74 *) WinUser.VK_F5        => RETURN KeyboardKey.F5;
      | (* 75 *) WinUser.VK_F6        => RETURN KeyboardKey.F6;
      | (* 76 *) WinUser.VK_F7        => RETURN KeyboardKey.F7;
      | (* 77 *) WinUser.VK_F8        => RETURN KeyboardKey.F8;
      | (* 78 *) WinUser.VK_F9        => RETURN KeyboardKey.F9;
      | (* 79 *) WinUser.VK_F10       => RETURN KeyboardKey.F10;
      | (* 7A *) WinUser.VK_F11       => RETURN KeyboardKey.F11;
      | (* 7B *) WinUser.VK_F12       => RETURN KeyboardKey.F12;
      | (* 7C *) WinUser.VK_F13       => RETURN KeyboardKey.F13;
      | (* 7D *) WinUser.VK_F14       => RETURN KeyboardKey.F14;
      | (* 7E *) WinUser.VK_F15       => RETURN KeyboardKey.F15;
      | (* 7F *) WinUser.VK_F16       => RETURN KeyboardKey.F16;
      | (* 80 *) WinUser.VK_F17       => RETURN KeyboardKey.F17;
      | (* 81 *) WinUser.VK_F18       => RETURN KeyboardKey.F18;
      | (* 82 *) WinUser.VK_F19       => RETURN KeyboardKey.F19;
      | (* 83 *) WinUser.VK_F20       => RETURN KeyboardKey.F20;
      | (* 84 *) WinUser.VK_F21       => RETURN KeyboardKey.F21;
      | (* 85 *) WinUser.VK_F22       => RETURN KeyboardKey.F22;
      | (* 86 *) WinUser.VK_F23       => RETURN KeyboardKey.F23;
      | (* 87 *) WinUser.VK_F24       => RETURN KeyboardKey.F24;

      | (* 90 *) WinUser.VK_NUMLOCK   => RETURN KeyboardKey.Num_Lock;
      | (* 91 *) WinUser.VK_SCROLL    => RETURN KeyboardKey.Scroll_Lock;

      | (* A0 *) WinUser.VK_LSHIFT    => RETURN KeyboardKey.Shift_L;
      | (* A1 *) WinUser.VK_RSHIFT    => RETURN KeyboardKey.Shift_R;
      | (* A2 *) WinUser.VK_LCONTROL  => RETURN KeyboardKey.Control_L;
      | (* A3 *) WinUser.VK_RCONTROL  => RETURN KeyboardKey.Control_R;
      | (* A4 *) WinUser.VK_LMENU     => RETURN KeyboardKey.Alt_L;
      | (* A5 *) WinUser.VK_RMENU     => RETURN KeyboardKey.Alt_R;

      (* The next few codes are device-specific ... *)

      | 16_BA => RETURN Latin1Key.colon;
      | 16_BB => RETURN Latin1Key.plus;
      | 16_BC => RETURN Latin1Key.less;
      | 16_BD => RETURN Latin1Key.underscore;
      | 16_BE => RETURN Latin1Key.greater;
      | 16_BF => RETURN Latin1Key.question;
      | 16_C0 => RETURN Latin1Key.asciitilde;
      | 16_DB => RETURN Latin1Key.braceleft;
      | 16_DC => RETURN Latin1Key.bar;
      | 16_DD => RETURN Latin1Key.braceright;
      | 16_DE => RETURN Latin1Key.quotedbl;

      | (* F6 *) WinUser.VK_ATTN      => RETURN KeyboardKey.VoidSymbol;
      | (* F7 *) WinUser.VK_CRSEL     => RETURN KeyboardKey.VoidSymbol;
      | (* F8 *) WinUser.VK_EXSEL     => RETURN KeyboardKey.VoidSymbol;
      | (* F9 *) WinUser.VK_EREOF     => RETURN KeyboardKey.VoidSymbol;
      | (* FA *) WinUser.VK_PLAY      => RETURN KeyboardKey.VoidSymbol;
      | (* FB *) WinUser.VK_ZOOM      => RETURN KeyboardKey.VoidSymbol;
      | (* FC *) WinUser.VK_NONAME    => RETURN KeyboardKey.VoidSymbol;
      | (* FD *) WinUser.VK_PA1       => RETURN KeyboardKey.VoidSymbol;
      | (* FE *) WinUser.VK_OEM_CLEAR => RETURN KeyboardKey.VoidSymbol;
      ELSE
        RETURN KeyboardKey.VoidSymbol;
      END;
    END;
  END VirtualKeyToKeySym;

TYPE
  Button = {None, Left, Middle, Right};
  Transition = {Press, Release};
  Last = RECORD
           x, y                : INTEGER     := 0;
           time                : WinDef.LONG := 0;
           button              : Button      := Button.None;
           clickCount          : CARDINAL    := 0;
           safetyRadius        : CARDINAL    := 3;
           doubleClickInterval : CARDINAL    := 500;

keysym : X.KeySym := X.None; xcompstatus := X.XComposeStatus{NIL, 0};

         END;
last{x,y} = position 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.

PROCEDURE ButtonEvent (hwnd  : WinDef.HWND;
                       lParam: WinDef.LPARAM;
                       wParam: WinDef.WPARAM;
                       button: Button;
                       trans : Transition)
    RAISES {TrestleComm.Failure} =
  VAR
    oldFocus  := trsl.mouseFocus;
    time      := WinUser.GetMessageTime ();
    clientPos := WinDef.POINT {WinDef.LOWORD (lParam), WinDef.HIWORD (lParam)};
    screenPos := clientPos;
    focusPos  := clientPos;
    status    : WinDef.BOOL;
    v         : VBT.T;
    ur        : Child;
    cd        : VBT.MouseRec;
  CONST
    NonButtons = VBT.Modifiers{FIRST(VBT.Modifier).. LAST(VBT.Modifier)}
                   - VBT.Buttons;
  BEGIN
    status := WinUser.ClientToScreen (hwnd, ADR (screenPos));
    <* ASSERT status = True *>

    (* If "hwnd" refers to the window that has captured the mouse (as opposed
       to the topmost window beneath the mouse cursor), we determine what
       window (if any) is below the cursor. If there is one, we set "hwnd"
       to be the window handle of this window, and translate "clientPos" to
       be in the coordinate space of this window. *)
    IF trsl.mouseFocus # NIL THEN
      WITH topHwnd = WinUser.WindowFromPoint (screenPos) DO
        IF topHwnd # NIL THEN
          hwnd := topHwnd;
          clientPos := screenPos;
          status := WinUser.ScreenToClient (hwnd, ADR (clientPos));
          <* ASSERT status = True *>
        END;
      END;
    END;
    v := GetVBT (trsl, hwnd);
    ur := v.upRef;

    IF Word.Minus(time, ur.last.time) <= ur.last.doubleClickInterval
      AND ABS(ur.last.x - clientPos.x) <= ur.last.safetyRadius
      AND ABS(ur.last.y - clientPos.y) <= ur.last.safetyRadius
      AND ur.last.button = button THEN
      INC(ur.last.clickCount)
    ELSE
      ur.last.clickCount := 0;
      ur.last.x          := clientPos.x;
      ur.last.y          := clientPos.y;
      ur.last.button     := button
    END;
    ur.last.time := time;

    (* Determine "cd.button", "cd.modifiers", and "cd.clickType". *)
    cd.modifiers := ExtractModifiers (wParam);
    CASE button OF
    | Button.None   => <* ASSERT FALSE *>
    | Button.Left   => cd.whatChanged := VBT.Modifier.MouseL;
    | Button.Middle => cd.whatChanged := VBT.Modifier.MouseM;
    | Button.Right  => cd.whatChanged := VBT.Modifier.MouseR;
    END;
    IF trans = Transition.Press THEN
      cd.modifiers := cd.modifiers - VBT.Modifiers{cd.whatChanged};
      IF cd.modifiers <= NonButtons THEN
        cd.clickType := VBT.ClickType.FirstDown;
        trsl.mouseFocus := v;
        EVAL WinUser.SetCapture (hwnd);
      ELSE
        cd.clickType := VBT.ClickType.OtherDown
      END
    ELSE
      IF cd.modifiers <= NonButtons THEN
        cd.clickType := VBT.ClickType.LastUp;
        trsl.mouseFocus := NIL;
        status := WinUser.ReleaseCapture ();
        <* ASSERT status = True *>
      ELSE
        cd.clickType := VBT.ClickType.OtherUp
      END;
      cd.modifiers := cd.modifiers + VBT.Modifiers{cd.whatChanged};
    END;

    cd.time := time;
    cd.cp := ToCursorPosition (clientPos.x, clientPos.y, hwnd);
    ur.cageCovered := TRUE;
    TRY
      cd.clickCount := ur.last.clickCount;
      VBTClass.Position (v, VBT.PositionRec{cd.cp, cd.time, cd.modifiers});
      VBTClass.Mouse(v, cd);
    FINALLY
      LOCK trsl DO
        ur.cageCovered := FALSE;
      END;
    END;
    LOCK v DO
      trsl.setcage(v);
    END;
    IF oldFocus # NIL AND oldFocus # v THEN
      cd.cp.offScreen := FALSE;
      cd.cp.pt.h      := focusPos.x;
      cd.cp.pt.v      := focusPos.y;
      cd.cp.gone      := TRUE;
      VBTClass.Mouse(oldFocus, cd);
    END;
*** 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.isXFocus THEN X.XSetInputFocus(trsl.dpy, ur.w, X.RevertToParent, time); sr.ts := time END ELSIF sr.v = v THEN X.XSetSelectionOwner(trsl.dpy, sr.name, ur.w, time); sr.ts := time END END END FINALLY Exit(trsl) END ***
  END ButtonEvent;
ExtractModifiers takes a WinDef.WPARAM that was typically delivered by a Windows Mouse Input Message (e.g. WM_MOUSEMOVE or WM_LBUTTONDOWN), and converts it into a Trestle VBT.Modifiers, that is, into a set of modifier keys and buttons.

Note: I handle only 5 out of 12 modifiers. In particular, I don't handle Option and Shift Lock.

PROCEDURE ExtractModifiers (wParam: WinDef.WPARAM): VBT.Modifiers =
  VAR
    mods := VBT.Modifiers {};
  BEGIN
    IF Word.And (wParam, WinUser.MK_SHIFT) # 0 THEN
      mods := mods + VBT.Modifiers {VBT.Modifier.Shift};
    END;
    IF Word.And (wParam, WinUser.MK_CONTROL) # 0 THEN
      mods := mods + VBT.Modifiers {VBT.Modifier.Control};
    END;
    IF Word.And (wParam, WinUser.MK_LBUTTON) # 0 THEN
      mods := mods + VBT.Modifiers {VBT.Modifier.MouseL};
    END;
    IF Word.And (wParam, WinUser.MK_MBUTTON) # 0 THEN
      mods := mods + VBT.Modifiers {VBT.Modifier.MouseM};
    END;
    IF Word.And (wParam, WinUser.MK_RBUTTON) # 0 THEN
      mods := mods + VBT.Modifiers {VBT.Modifier.MouseR};
    END;
    RETURN mods;
  END ExtractModifiers;

PROCEDURE ToCursorPosition (x, y: INTEGER;
                            hwnd: WinDef.HWND): VBT.CursorPosition =
  VAR
    status: WinDef.BOOL;
    r     : WinDef.RECT;
  BEGIN
    status := WinUser.GetClientRect (hwnd, ADR (r));
    <* ASSERT status = True *>

    RETURN VBT.CursorPosition {
               pt        := Point.T {x, y},
               screen    := DesktopID,
               gone      := x < r.left OR x >= r.right OR
                            y < r.top  OR y >= r.bottom,
               offScreen := FALSE};
  END ToCursorPosition;

PROCEDURE DeliverMousePos (hwnd  : WinDef.HWND;
                           lParam: WinDef.LPARAM;
                           wParam: WinDef.WPARAM) =
  VAR
    screenPos := WinDef.POINT {WinDef.LOWORD (lParam), WinDef.HIWORD (lParam)};
    clientPos : WinDef.POINT;
    status    : WinDef.BOOL;
    addr      : ADDRESS;
    ref       : REFANY;
  BEGIN
    IF hwnd # trsl.hwnd THEN
      status := WinUser.ClientToScreen (hwnd, ADR (screenPos));
      <* ASSERT status = True *>
    END;

    LOCK trsl DO
      IF trsl.lastPos = screenPos AND NOT trsl.anyCageSet THEN
        RETURN;
      ELSE
        trsl.anyCageSet := FALSE;
        trsl.lastPos := screenPos;
      END;
    END;

    WITH iter = trsl.vbts.iterate () DO
      WHILE iter.next (addr, ref) DO
        WITH hwnd = LOOPHOLE (addr, WinDef.HWND),
             v    = NARROW (ref, VBT.T) DO
          <* ASSERT v # NIL *>  (* I once crashed because v was NIL.
                                   This should be a locking-level error. *)
          clientPos := screenPos;
          status := WinUser.ScreenToClient (hwnd, ADR (clientPos));
          <* ASSERT status = True *>
          MouseMotion (hwnd, v, screenPos, clientPos, wParam);
        END;
      END;
    END;
  END DeliverMousePos;
Note: This procedure may not be called with trsl being held, since the call to VBTClass.Position might lead to a call back into WinTrestle and an attempt to acquire trsl.

PROCEDURE MouseMotion (hwnd     : WinDef.HWND;
                       v        : VBT.T;
                       screenPos: WinDef.POINT;
                       clientPos: WinDef.POINT;
                       wParam   : WinDef.WPARAM;

lost, takeFocus: BOOLEAN; e : X.XCrossingEventStar

                                              ) =
  VAR
    cd     : VBT.PositionRec;
    time   := WinUser.GetMessageTime ();
    status : WinDef.BOOL;
  BEGIN
    cd.time      := time;
    cd.modifiers := ExtractModifiers (wParam);
    cd.cp        := ToCursorPosition (clientPos.x, clientPos.y, hwnd);

    IF cd.cp.gone AND v = trsl.current THEN
      trsl.current := NIL;
    ELSIF NOT cd.cp.gone AND v # NIL THEN
      trsl.current := v
    END;

    VBTClass.Position (v, cd);
*** IF ur # NIL AND lost THEN LOCK trsl DO XProperties.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, time, VBT.KBFocus}) END ***
  END MouseMotion;

PROCEDURE GetVBT (trsl: T; hwnd: WinDef.HWND): VBT.T =
  VAR
    ref: REFANY := NIL;
  BEGIN
    EVAL trsl.vbts.get (hwnd, ref);
    RETURN ref;
  END GetVBT;

PROCEDURE ToRect (READONLY r: WinDef.RECT): Rect.T =
  BEGIN
    RETURN Rect.T{west  := r.left,
                  east  := r.right,
                  north := r.top,
                  south := r.bottom}
  END ToRect;

PROCEDURE FromRect (READONLY r: Rect.T): WinDef.RECT =
  BEGIN
    RETURN WinDef.RECT {left   := r.west,
                        right  := r.east,
                        top    := r.north,
                        bottom := r.south};
  END FromRect;

PROCEDURE EmptyRegion (): WinDef.HRGN =
  VAR
    rgn := WinGDI.CreateRectRgn (1,1,1,1);
  BEGIN
    <* ASSERT rgn # NIL *>
    RETURN rgn;
  END EmptyRegion;

PROCEDURE FromRegion (READONLY rgn: Region.T): WinDef.HRGN =
  VAR
    hrgn := EmptyRegion();
    rr   := EmptyRegion();
    status: Ctypes.int;
  BEGIN
    WITH rects = Region.ToRects (rgn) DO
      FOR i := FIRST(rects^) TO LAST (rects^) DO
        WITH r  = rects[i] DO
          status := WinGDI.SetRectRgn (rr, r.west, r.north, r.east, r.south);
          <* ASSERT status = True *>
          status := WinGDI.CombineRgn (hrgn, hrgn, rr, WinGDI.RGN_OR);
          <* ASSERT status # WinGDI.ERROR *>
        END;
      END;
      status := WinGDI.DeleteObject (rr);
      <* ASSERT status = True *>
    END;
    RETURN hrgn;
  END FromRegion;

PROCEDURE SetClipRegion (hdc: WinDef.HDC; rgn: Region.T) =
  VAR
    hrgn := FromRegion(rgn);
    status: Ctypes.int;
  BEGIN
    status := WinGDI.SelectClipRgn (hdc, hrgn);
    <* ASSERT status # WinGDI.ERROR *>
    status := WinGDI.DeleteObject (hrgn);
    <* ASSERT status = True *>
  END SetClipRegion;

PROCEDURE UnsetClipRegion (hdc: WinDef.HDC) =
  VAR
    status: Ctypes.int;
  BEGIN
    status := WinGDI.SelectClipRgn (hdc, NIL);
    <* ASSERT status # WinGDI.ERROR *>
  END UnsetClipRegion;

PROCEDURE PrintMessageType (message: WinDef.UINT) =
  BEGIN
    IO.Put("message " & Fmt.Int(message) & " = ");
    CASE message OF
    | WinUser.WM_NULL => IO.Put("WM_NULL");
    | WinUser.WM_CREATE => IO.Put("WM_CREATE");
    | WinUser.WM_DESTROY => IO.Put("WM_DESTROY");
    | WinUser.WM_MOVE => IO.Put("WM_MOVE");
    | WinUser.WM_SIZE => IO.Put("WM_SIZE");
    | WinUser.WM_ACTIVATE => IO.Put("WM_ACTIVATE");
    | WinUser.WM_SETFOCUS => IO.Put("WM_SETFOCUS");
    | WinUser.WM_KILLFOCUS => IO.Put("WM_KILLFOCUS");
    | WinUser.WM_ENABLE => IO.Put("WM_ENABLE");
    | WinUser.WM_SETREDRAW => IO.Put("WM_SETREDRAW");
    | WinUser.WM_SETTEXT => IO.Put("WM_SETTEXT");
    | WinUser.WM_GETTEXT => IO.Put("WM_GETTEXT");
    | WinUser.WM_GETTEXTLENGTH => IO.Put("WM_GETTEXTLENGTH");
    | WinUser.WM_PAINT => IO.Put("WM_PAINT");
    | WinUser.WM_CLOSE => IO.Put("WM_CLOSE");
    | WinUser.WM_QUERYENDSESSION => IO.Put("WM_QUERYENDSESSION");
    | WinUser.WM_QUIT => IO.Put("WM_QUIT");
    | WinUser.WM_QUERYOPEN => IO.Put("WM_QUERYOPEN");
    | WinUser.WM_ERASEBKGND => IO.Put("WM_ERASEBKGND");
    | WinUser.WM_SYSCOLORCHANGE => IO.Put("WM_SYSCOLORCHANGE");
    | WinUser.WM_ENDSESSION => IO.Put("WM_ENDSESSION");
    | WinUser.WM_SHOWWINDOW => IO.Put("WM_SHOWWINDOW");
    | WinUser.WM_WININICHANGE => IO.Put("WM_WININICHANGE");
    | WinUser.WM_DEVMODECHANGE => IO.Put("WM_DEVMODECHANGE");
    | WinUser.WM_ACTIVATEAPP => IO.Put("WM_ACTIVATEAPP");
    | WinUser.WM_FONTCHANGE => IO.Put("WM_FONTCHANGE");
    | WinUser.WM_TIMECHANGE => IO.Put("WM_TIMECHANGE");
    | WinUser.WM_CANCELMODE => IO.Put("WM_CANCELMODE");
    | WinUser.WM_SETCURSOR => IO.Put("WM_SETCURSOR");
    | WinUser.WM_MOUSEACTIVATE => IO.Put("WM_MOUSEACTIVATE");
    | WinUser.WM_CHILDACTIVATE => IO.Put("WM_CHILDACTIVATE");
    | WinUser.WM_QUEUESYNC => IO.Put("WM_QUEUESYNC");
    | WinUser.WM_GETMINMAXINFO => IO.Put("WM_GETMINMAXINFO");
    | WinUser.WM_PAINTICON => IO.Put("WM_PAINTICON");
    | WinUser.WM_ICONERASEBKGND => IO.Put("WM_ICONERASEBKGND");
    | WinUser.WM_NEXTDLGCTL => IO.Put("WM_NEXTDLGCTL");
    | WinUser.WM_SPOOLERSTATUS => IO.Put("WM_SPOOLERSTATUS");
    | WinUser.WM_DRAWITEM => IO.Put("WM_DRAWITEM");
    | WinUser.WM_MEASUREITEM => IO.Put("WM_MEASUREITEM");
    | WinUser.WM_DELETEITEM => IO.Put("WM_DELETEITEM");
    | WinUser.WM_VKEYTOITEM => IO.Put("WM_VKEYTOITEM");
    | WinUser.WM_CHARTOITEM => IO.Put("WM_CHARTOITEM");
    | WinUser.WM_SETFONT => IO.Put("WM_SETFONT");
    | WinUser.WM_GETFONT => IO.Put("WM_GETFONT");
    | WinUser.WM_SETHOTKEY => IO.Put("WM_SETHOTKEY");
    | WinUser.WM_GETHOTKEY => IO.Put("WM_GETHOTKEY");
    | WinUser.WM_QUERYDRAGICON => IO.Put("WM_QUERYDRAGICON");
    | WinUser.WM_COMPAREITEM => IO.Put("WM_COMPAREITEM");
    | WinUser.WM_FULLSCREEN => IO.Put("WM_FULLSCREEN");
    | WinUser.WM_COMPACTING => IO.Put("WM_COMPACTING");
    | WinUser.WM_OTHERWINDOWCREATED => IO.Put("WM_OTHERWINDOWCREATED");
    | WinUser.WM_OTHERWINDOWDESTROYED => IO.Put("WM_OTHERWINDOWDESTROYED");
    | WinUser.WM_COMMNOTIFY => IO.Put("WM_COMMNOTIFY");
    | WinUser.WM_HOTKEYEVENT => IO.Put("WM_HOTKEYEVENT");
    | WinUser.WM_WINDOWPOSCHANGING => IO.Put("WM_WINDOWPOSCHANGING");
    | WinUser.WM_WINDOWPOSCHANGED => IO.Put("WM_WINDOWPOSCHANGED");
    | WinUser.WM_POWER => IO.Put("WM_POWER");
    | WinUser.WM_COPYDATA => IO.Put("WM_COPYDATA");
    | WinUser.WM_NCCREATE => IO.Put("WM_NCCREATE");
    | WinUser.WM_NCDESTROY => IO.Put("WM_NCDESTROY");
    | WinUser.WM_NCCALCSIZE => IO.Put("WM_NCCALCSIZE");
    | WinUser.WM_NCHITTEST => IO.Put("WM_NCHITTEST");
    | WinUser.WM_NCPAINT => IO.Put("WM_NCPAINT");
    | WinUser.WM_NCACTIVATE => IO.Put("WM_NCACTIVATE");
    | WinUser.WM_GETDLGCODE => IO.Put("WM_GETDLGCODE");
    | WinUser.WM_NCMOUSEMOVE => IO.Put("WM_NCMOUSEMOVE");
    | WinUser.WM_NCLBUTTONDOWN => IO.Put("WM_NCLBUTTONDOWN");
    | WinUser.WM_NCLBUTTONUP => IO.Put("WM_NCLBUTTONUP");
    | WinUser.WM_NCLBUTTONDBLCLK => IO.Put("WM_NCLBUTTONDBLCLK");
    | WinUser.WM_NCRBUTTONDOWN => IO.Put("WM_NCRBUTTONDOWN");
    | WinUser.WM_NCRBUTTONUP => IO.Put("WM_NCRBUTTONUP");
    | WinUser.WM_NCRBUTTONDBLCLK => IO.Put("WM_NCRBUTTONDBLCLK");
    | WinUser.WM_NCMBUTTONDOWN => IO.Put("WM_NCMBUTTONDOWN");
    | WinUser.WM_NCMBUTTONUP => IO.Put("WM_NCMBUTTONUP");
    | WinUser.WM_NCMBUTTONDBLCLK => IO.Put("WM_NCMBUTTONDBLCLK");
    | WinUser.WM_KEYDOWN => IO.Put("WM_KEYDOWN (aka WM_KEYFIRST)");
    | WinUser.WM_KEYUP => IO.Put("WM_KEYUP");
    | WinUser.WM_CHAR => IO.Put("WM_CHAR");
    | WinUser.WM_DEADCHAR => IO.Put("WM_DEADCHAR");
    | WinUser.WM_SYSKEYDOWN => IO.Put("WM_SYSKEYDOWN");
    | WinUser.WM_SYSKEYUP => IO.Put("WM_SYSKEYUP");
    | WinUser.WM_SYSCHAR => IO.Put("WM_SYSCHAR");
    | WinUser.WM_SYSDEADCHAR => IO.Put("WM_SYSDEADCHAR");
    | WinUser.WM_KEYLAST => IO.Put("WM_KEYLAST");
    | WinUser.WM_INITDIALOG => IO.Put("WM_INITDIALOG");
    | WinUser.WM_COMMAND => IO.Put("WM_COMMAND");
    | WinUser.WM_SYSCOMMAND => IO.Put("WM_SYSCOMMAND");
    | WinUser.WM_TIMER => IO.Put("WM_TIMER");
    | WinUser.WM_HSCROLL => IO.Put("WM_HSCROLL");
    | WinUser.WM_VSCROLL => IO.Put("WM_VSCROLL");
    | WinUser.WM_INITMENU => IO.Put("WM_INITMENU");
    | WinUser.WM_INITMENUPOPUP => IO.Put("WM_INITMENUPOPUP");
    | WinUser.WM_MENUSELECT => IO.Put("WM_MENUSELECT");
    | WinUser.WM_MENUCHAR => IO.Put("WM_MENUCHAR");
    | WinUser.WM_ENTERIDLE => IO.Put("WM_ENTERIDLE");
    | WinUser.WM_CTLCOLORMSGBOX => IO.Put("WM_CTLCOLORMSGBOX");
    | WinUser.WM_CTLCOLOREDIT => IO.Put("WM_CTLCOLOREDIT");
    | WinUser.WM_CTLCOLORLISTBOX => IO.Put("WM_CTLCOLORLISTBOX");
    | WinUser.WM_CTLCOLORBTN => IO.Put("WM_CTLCOLORBTN");
    | WinUser.WM_CTLCOLORDLG => IO.Put("WM_CTLCOLORDLG");
    | WinUser.WM_CTLCOLORSCROLLBAR => IO.Put("WM_CTLCOLORSCROLLBAR");
    | WinUser.WM_CTLCOLORSTATIC => IO.Put("WM_CTLCOLORSTATIC");
    | WinUser.WM_MOUSEMOVE => IO.Put("WM_MOUSEMOVE (aka WM_MOUSEFIRST)");
    | WinUser.WM_LBUTTONDOWN => IO.Put("WM_LBUTTONDOWN");
    | WinUser.WM_LBUTTONUP => IO.Put("WM_LBUTTONUP");
    | WinUser.WM_LBUTTONDBLCLK => IO.Put("WM_LBUTTONDBLCLK");
    | WinUser.WM_RBUTTONDOWN => IO.Put("WM_RBUTTONDOWN");
    | WinUser.WM_RBUTTONUP => IO.Put("WM_RBUTTONUP");
    | WinUser.WM_RBUTTONDBLCLK => IO.Put("WM_RBUTTONDBLCLK");
    | WinUser.WM_MBUTTONDOWN => IO.Put("WM_MBUTTONDOWN");
    | WinUser.WM_MBUTTONUP => IO.Put("WM_MBUTTONUP");
    | WinUser.WM_MBUTTONDBLCLK => IO.Put("WM_MBUTTONDBLCLK (aka MOUSELAST)");
    | WinUser.WM_PARENTNOTIFY => IO.Put("WM_PARENTNOTIFY");
    | WinUser.WM_ENTERMENULOOP => IO.Put("WM_ENTERMENULOOP");
    | WinUser.WM_EXITMENULOOP => IO.Put("WM_EXITMENULOOP");
    | WinUser.WM_MDICREATE => IO.Put("WM_MDICREATE");
    | WinUser.WM_MDIDESTROY => IO.Put("WM_MDIDESTROY");
    | WinUser.WM_MDIACTIVATE => IO.Put("WM_MDIACTIVATE");
    | WinUser.WM_MDIRESTORE => IO.Put("WM_MDIRESTORE");
    | WinUser.WM_MDINEXT => IO.Put("WM_MDINEXT");
    | WinUser.WM_MDIMAXIMIZE => IO.Put("WM_MDIMAXIMIZE");
    | WinUser.WM_MDITILE => IO.Put("WM_MDITILE");
    | WinUser.WM_MDICASCADE => IO.Put("WM_MDICASCADE");
    | WinUser.WM_MDIICONARRANGE => IO.Put("WM_MDIICONARRANGE");
    | WinUser.WM_MDIGETACTIVE => IO.Put("WM_MDIGETACTIVE");
    | WinUser.WM_MDISETMENU => IO.Put("WM_MDISETMENU");
    | WinUser.WM_ENTERSIZEMOVE_UNDOCUMENTED => IO.Put("WM_ENTERSIZEMOVE_UNDOCUMENTED");
    | WinUser.WM_EXITSIZEMOVE_UNDOCUMENTED => IO.Put("WM_EXITSIZEMOVE_UNDOCUMENTED");
    | WinUser.WM_DROPFILES => IO.Put("WM_DROPFILES");
    | WinUser.WM_MDIREFRESHMENU => IO.Put("WM_MDIREFRESHMENU");
    | WinUser.WM_CUT => IO.Put("WM_CUT");
    | WinUser.WM_COPY => IO.Put("WM_COPY");
    | WinUser.WM_PASTE => IO.Put("WM_PASTE");
    | WinUser.WM_CLEAR => IO.Put("WM_CLEAR");
    | WinUser.WM_UNDO => IO.Put("WM_UNDO");
    | WinUser.WM_RENDERFORMAT => IO.Put("WM_RENDERFORMAT");
    | WinUser.WM_RENDERALLFORMATS => IO.Put("WM_RENDERALLFORMATS");
    | WinUser.WM_DESTROYCLIPBOARD => IO.Put("WM_DESTROYCLIPBOARD");
    | WinUser.WM_DRAWCLIPBOARD => IO.Put("WM_DRAWCLIPBOARD");
    | WinUser.WM_PAINTCLIPBOARD => IO.Put("WM_PAINTCLIPBOARD");
    | WinUser.WM_VSCROLLCLIPBOARD => IO.Put("WM_VSCROLLCLIPBOARD");
    | WinUser.WM_SIZECLIPBOARD => IO.Put("WM_SIZECLIPBOARD");
    | WinUser.WM_ASKCBFORMATNAME => IO.Put("WM_ASKCBFORMATNAME");
    | WinUser.WM_CHANGECBCHAIN => IO.Put("WM_CHANGECBCHAIN");
    | WinUser.WM_HSCROLLCLIPBOARD => IO.Put("WM_HSCROLLCLIPBOARD");
    | WinUser.WM_QUERYNEWPALETTE => IO.Put("WM_QUERYNEWPALETTE");
    | WinUser.WM_PALETTEISCHANGING => IO.Put("WM_PALETTEISCHANGING");
    | WinUser.WM_PALETTECHANGED => IO.Put("WM_PALETTECHANGED");
    | WinUser.WM_HOTKEY => IO.Put("WM_HOTKEY");
    | WinUser.WM_PENWINFIRST => IO.Put("WM_PENWINFIRST");
    | WinUser.WM_PENWINLAST => IO.Put("WM_PENWINLAST");
    | WinUser.WM_MM_RESERVED_FIRST => IO.Put("WM_MM_RESERVED_FIRST");
    | WinUser.WM_MM_RESERVED_LAST => IO.Put("WM_MM_RESERVED_LAST");
    | WinUser.WM_USER => IO.Put("WM_USER");
    ELSE
      IO.Put("<not in my incomplete table>");
    END;
    IO.Put("\n");
  END PrintMessageType;

PROCEDURE RegisterWindowClass () =
  VAR
    wc    : WinUser.WNDCLASS;
    status: WinDef.BOOL;
  BEGIN
    hInst := RTLinker.info.instance;
    hAccelTable := WinUser.LoadAccelerators(hInst, windowclassName);

    wc.style := WinUser.CS_HREDRAW + WinUser.CS_VREDRAW + WinUser.CS_OWNDC;
      (* other styles to consider:
         CS_GLOBALCLASS, CS_OWNDC, CS_PARENTDC, CS_SAVEBITS *)
    wc.lpfnWndProc := WindowProc;
    wc.cbClsExtra := 0;
    wc.cbWndExtra := 0;
    wc.hInstance := hInst;
    wc.hIcon := WinUser.LoadIcon (NIL, WinUser.IDI_APPLICATION);
wc.hCursor := WinUser.LoadCursor (NIL, WinUser.IDC_ARROW);
    wc.hCursor := NIL;
    gcCursor := WinUser.LoadCursor (NIL, WinUser.IDC_APPSTARTING);
    wc.hbrBackground := NIL;
    wc.lpszMenuName := NIL;
    wc.lpszClassName := windowclassName;

    status := WinUser.RegisterClass (ADR(wc));
    <* ASSERT status # 0 *>
  END RegisterWindowClass;

CONST
  CREATE_VBT           = WinUser.WM_USER;
  CREATE_OFFSCREEN_VBT = WinUser.WM_USER + 1;
  RESHAPE_VBT          = WinUser.WM_USER + 2;

TYPE
  CreateRec = REF RECORD
    trsl  : T;
    v     : VBT.T;
    st    : WinScreenType.T;
    nw    : Point.T;
    iconic: BOOLEAN;
  END;
Private procedure. LL = VBT.mu. WinLL assertion made by caller.

PROCEDURE CreateWindow (trsl  : T;
                        v     : VBT.T;
                        st    : WinScreenType.T;
                        nw    : Point.T;
                        iconic: BOOLEAN) RAISES {TrestleComm.Failure} =
  BEGIN
    (* Note that this works only because "cr" is on the stack of the current
       thread, and therefore will not be moved by the Modula-3 stop-and copy
       collector. *)
    WITH cr = NEW (CreateRec,
                   trsl   := trsl,
                   v      := v,
                   st     := st,
                   nw     := nw,
                   iconic := iconic),
         lParam = LOOPHOLE (cr, WinDef.LONG) DO
      EVAL WinUser.SendMessage (trsl.hwnd, CREATE_VBT, 0, lParam);
    END;
  END CreateWindow;
*************************************************************************** Garbage-Collection Cursor ***************************************************************************

VAR
  showGC := NOT RTParams.IsPresent("StarTrek")
                AND NOT (RTCollectorSRC.incremental AND RTHeapDep.VM
                         AND RTHeapRep.disableVMCount = 0);
If showGC is TRUE, the cursor of every installed window will change to the Star Trek cursor whenever the garbage collector is running. At runtime, you can force no StarTrek cursor by running your program @M3StarTrek.

TYPE
  GCClosure = RTHeapRep.MonitorClosure OBJECT
    trsl: T;
  OVERRIDES
    before := HackOn;
    after  := HackOff
  END;

PROCEDURE DoHackInit (trsl: T) =
  BEGIN
    IF showGC THEN
      RTHeapRep.RegisterMonitor(NEW(GCClosure, trsl := trsl))
    END;
  END DoHackInit;

PROCEDURE HackOn (cl: GCClosure) =
  BEGIN
    IF NOT ((RTCollectorSRC.incremental AND RTHeapDep.VM
               AND RTHeapRep.disableVMCount = 0)) THEN
      HackToggle(cl.trsl, TRUE);
      hacking := TRUE
    END
  END HackOn;

PROCEDURE HackOff (cl: GCClosure) =
  BEGIN
    IF hacking THEN
      HackToggle(cl.trsl, FALSE);
      hacking := FALSE
    END
  END HackOff;

VAR
  hacking   := FALSE;
  oldCursor : WinDef.HCURSOR;
  gcCursor  : WinDef.HCURSOR;

PROCEDURE HackToggle (trsl: T; on: BOOLEAN) =
  <*FATAL Split.NotAChild*>
  BEGIN

IF on THEN oldCursor := WinUser.SetCursor (gcCursor); IO.Put (Starting GC ................................\n); ELSE EVAL WinUser.SetCursor (oldCursor); IO.Put (................................ Finished GC\n); END;

IF NOT trsl.dead THEN VAR v := Split.Succ(trsl, NIL); BEGIN WHILE v # NIL DO VAR ur: Child := v.upRef; BEGIN IF ur # NIL AND ur.hwnd # NIL AND ur.xcage # X.None THEN IF on THEN EVAL Win.SetCursor (ur.X.XDefineCursor(dpy, ur.w, trsl.gcCursor) ELSE X.XDefineCursor(dpy, ur.w, ur.csid) END END END; v := Split.Succ(trsl, v) END END; END

END HackToggle;
*************************************************************************** Window-creation and message-handling thread ***************************************************************************

VAR
  cond := NEW (Thread.Condition);
        (* used to signal the main thread that "trsl.hwnd" has been created. *)

PROCEDURE CreateTrestle () =
  VAR
    mu := NEW (MUTEX);
  BEGIN
    trsl := NEW(T);
    DoHackInit(trsl);

    trsl.st := NEW(VBT.ScreenType);
    (* The st is irrelevant except that it must be non-NIL so that
       marking the trsl for redisplay is not a noop. *)

    Enter(trsl);
    TRY
      trsl.vbts := NEW(AddrRefTbl.Default).init();

trsl.sel := NEW(SelArray, 0); trsl.atoms := NEW(IntTextTbl.Default).init(); trsl.names := NEW(TextIntTbl.Default).init(); SetUngrabs(trsl); trsl.evc := NEW(Thread.Condition); trsl.qEmpty := NEW(Thread.Condition); trsl.qNonEmpty := NEW(Thread.Condition); trsl.defaultScreen := X.XDefaultScreen(trsl.dpy); trsl.screens := NEW(REF ARRAY OF XScreenType.T, X.XScreenCount(trsl.dpy)); trsl.takeFocus := XClient.ToAtom(trsl, WM_TAKE_FOCUS); trsl.wmMoved := XClient.ToAtom(trsl, WM_MOVED); trsl.decTakeFocus := XClient.ToAtom(trsl, DEC_WM_TAKE_FOCUS); trsl.protocols := XClient.ToAtom(trsl, WM_PROTOCOLS); trsl.deleteWindow := XClient.ToAtom(trsl, WM_DELETE_WINDOW); trsl.miscAtom := XClient.ToAtom(trsl, _DEC_TRESTLE_MISCCODE); trsl.paNewScreen := XClient.ToAtom(trsl, _PALO_ALTO_NEW_SCREEN); trsl.paNewDisplay := XClient.ToAtom(trsl, _PALO_ALTO_NEW_DISPLAY); trsl.paAddDisplay := XClient.ToAtom(trsl, _PALO_ALTO_ADD_DISPLAY); XProperties.ExtendSel(trsl.sel, VBT.Target); trsl.sel[VBT.Target.sel].name := XClient.ToAtom(trsl, SECONDARY); XProperties.ExtendSel(trsl.sel, VBT.Source); trsl.sel[VBT.Source.sel].name := XClient.ToAtom(trsl, PRIMARY); XProperties.ExtendSel(trsl.sel, VBT.KBFocus); trsl.sel[VBT.KBFocus.sel].name := X.None;

trsl.gcCursor := X.XCreateFontCursor(hackdpy, 142 (*X.XC_trek

);
        IF trsl.gcCursor # X.None THEN
          VAR bg, fg: X.XColor;
          BEGIN
            bg.red := 65535;
            bg.green := 65535;
            bg.blue := 65535;
            bg.flags := X.DoRed + X.DoGreen + X.DoBlue;
            fg.red := 65535;
            fg.green := 0;
            fg.blue := 0;
            fg.flags := X.DoRed + X.DoGreen + X.DoBlue;
            X.XRecolorCursor(hackdpy, trsl.gcCursor, ADR(fg), ADR(bg))
          END
        END

        XProperties.InitialiseXClient(trsl);
        XExtensions.InitXClient(trsl);
*)
    FINALLY
      Exit(trsl, 1)
    END;

    trsl.screen := WinScreenType.New(trsl);

XInput.Start(trsl); XMessenger.Start(trsl); TrestleOnX.Enter(trsl); TRY FOR i := 0 TO LAST(trsl.screens^) DO X.XSelectInput(trsl.dpy, trsl.screens[i].root, X.EnterWindowMask) END FINALLY TrestleOnX.Exit(trsl, -1) END;


    trslThread := Thread.Fork (NEW (Thread.Closure, apply := MessengerApply));
    LOCK mu DO
      Thread.Wait (mu, cond);
    END;
  END CreateTrestle;

PROCEDURE MessengerApply (<*UNUSED*> cl: Thread.Closure): REFANY =
  VAR
    wc    : WinUser.WNDCLASS;
    status: WinDef.BOOL;
    cs    : WinUser.CREATESTRUCT;
    class := M3toC.CopyTtoS("Trestle Desktop");
    msg   : WinUser.MSG;
  BEGIN
    (* First, we have to register a window class for the "null window". *)

    hInst := RTLinker.info.instance;

    wc.style := WinUser.CS_HREDRAW + WinUser.CS_VREDRAW;
      (* other styles to consider:
         CS_GLOBALCLASS, CS_OWNDC, CS_PARENTDC, CS_SAVEBITS *)
    wc.lpfnWndProc := WindowProc;
    wc.cbClsExtra := 0;
    wc.cbWndExtra := 0;
    wc.hInstance := hInst;
    wc.hIcon := WinUser.LoadIcon (NIL, WinUser.IDI_APPLICATION);
    wc.hCursor := WinUser.LoadCursor (NIL, WinUser.IDC_ARROW);
    wc.hbrBackground := NIL;
    wc.lpszMenuName := NIL;
    wc.lpszClassName := class;

    status := WinUser.RegisterClass (ADR(wc));
    <* ASSERT status # 0 *>

    (* Now, we can actually create the "null window" *)
    trsl.hwnd := WinUser.CreateWindow(
                    class, NIL, WinUser.WS_DISABLED,
                    WinUser.CW_USEDEFAULT, WinUser.CW_USEDEFAULT,
                    WinUser.CW_USEDEFAULT, WinUser.CW_USEDEFAULT,
                    NIL, NIL, hInst, ADR(cs));
    <* ASSERT trsl.hwnd # NIL *>

    (* Signal "CreateTrestle" that the window is created. *)
    Thread.Signal (cond);

    (* Start a Windows Timer with 0.1 sec clicks *)
    trsl.timerId := WinUser.SetTimer (trsl.hwnd, 1, 100, NIL);

    (* start the message loop for all windows belonging to this Trestle *)
    WHILE WinUser.GetMessage (ADR(msg), NIL, 0, 0) = True DO
      EVAL WinUser.TranslateMessage (ADR(msg));
      EVAL WinUser.DispatchMessage (ADR(msg));
    END;

    (* received WM_QUIT message -- exiting *)
    RETURN NIL;
  END MessengerApply;

BEGIN
  CreateTrestle ();
  RegisterWindowClass();
END WinTrestle.

interface PathPrivate is in: