Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Mon Jan 16 10:05:17 PST 1995 by najork
UNSAFE MODULESetCage is called with locking level VBT.mu. It turns out that sometimes; 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 WinTrestle 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; PROCEDUREBeChild (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; PROCEDUREReplace (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;
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*************************************************************************** Painting Tints ***************************************************************************SetCage (self: T; <* UNUSED *>v: VBT.T) = BEGIN self.anyCageSet := TRUE; END SetCage; PROCEDURESetCursor (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; PROCEDUREPaintBatch (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;
PROCEDURETintCom (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; PROCEDUREFillRect (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
PROCEDUREStrokeRect (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*************************************************************************** Painting textures ***************************************************************************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;
PROCEDURE*************************************************************************** Painting pixmaps ***************************************************************************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;
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.
PROCEDUREBin (i: Word.T): TEXT = BEGIN RETURN Fmt.Pad (Fmt.Int (i, 2), 32, '0'); END Bin; PROCEDUREPixmapCom (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 ***************************************************************************
PROCEDUREScrollCom (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*************************************************************************** Painting Trapezoids ***************************************************************************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;
PROCEDURE*************************************************************************** Painting Text ***************************************************************************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; PROCEDURETrap ( 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;
PROCEDURE*************************************************************************** Extensions: Stroking and filling polygons; drawing simple lines. The xvbt version also handles pictures ***************************************************************************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}; PROCEDUREPaintString (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;
PROCEDUREThis function could move into a moduleExtensionCom (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;
WinWrap
PROCEDUREWindows maintains batches of paint requests on a per-thread (as opposed to per-window) basis. Batches are flushed by callingDrawLine (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; PROCEDUREStrokePath (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; PROCEDUREStrokeMove (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; PROCEDUREStrokeLine ( 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; PROCEDUREEmitStroke (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; PROCEDUREFillPath (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; PROCEDUREFillMove (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; PROCEDUREFillLine ( 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;
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.
PROCEDURESync (<* 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.
PROCEDURENote: The TrestleCapture ( 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; PROCEDUREScreenOf ( 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;
self
must not be locked by the calling thread.
PROCEDURENewShape (self: T; ch: VBT.T) = BEGIN IF ch.st # NIL THEN VBT.Mark(self); END; END NewShape; PROCEDUREFmt_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; PROCEDUREAcquire (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----------------------------------------------------------------------------- TheRelease (self: T; v: VBT.T; w: VBT.T; s: VBT.Selection) = BEGIN IO.Put ("WARNING: WinTrestle.Release is not yet implemented \n"); END Release; PROCEDUREPut ( 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; PROCEDUREForge ( 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; PROCEDUREReadUp (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; PROCEDUREWriteUp (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; PROCEDUREAttach (self: T; v: VBT.T) RAISES {TrestleComm.Failure} = BEGIN LOCK v DO LOCK self DO ProperSplit.Insert (self, NIL, v); END; END; END Attach;
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.
-----------------------------------------------------------------------------
PROCEDUREDecorate (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 ...
PROCEDUREInterface procedure. LL = VBT.mu. Makes WinLL assertion.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; PROCEDUREOverlap ( trsl: T; v : VBT.T; <*UNUSED*> id : Trestle.ScreenID; READONLY nw : Point.T) RAISES {TrestleComm.Failure} = BEGIN InnerOverlap(trsl, v, nw, TRUE) END Overlap;
PROCEDURE----------------------------------------------------------------------------- TrestleClass.Public introduces a methodMoveNear (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; PROCEDUREInstallOffScreen (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;
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----------------------------------------------------------------------------- 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. -----------------------------------------------------------------------------SetColorMap (self: T; v: VBT.T; cm: ScrnColorMap.T) = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END SetColorMap; PROCEDUREGetScreens (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; PROCEDURECaptureScreen ( 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; PROCEDUREAllCeded (self: T): BOOLEAN RAISES {TrestleComm.Failure} = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END AllCeded; PROCEDURETickTime (self: T): INTEGER = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END TickTime; PROCEDURETrestleID (self: T; v: VBT.T): TEXT = BEGIN RETURN "Default Trestle" END TrestleID; PROCEDUREWindowID (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;
PROCEDURE***************************************************************************UpdateChalk (t: T; v: VBT.T; chalk: TEXT) = BEGIN (* do nothing *) END UpdateChalk; PROCEDUREUpdateBuddies ( 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; PROCEDUREDoConnect (<*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; PROCEDUREInit () = BEGIN TrestleClass.RegisterConnectClosure( NEW(TrestleClass.ConnectClosure, apply := DoConnect)) END Init;
<*INLINE*> PROCEDUREEnter (trsl: T) RAISES {TrestleComm.Failure} = BEGIN Thread.Acquire(trsl); IF trsl.dead THEN Thread.Release(trsl); RAISE TrestleComm.Failure; END END Enter; <*INLINE*> PROCEDUREExit (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; PROCEDUREAdjustCoverage (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; PROCEDUREDelete (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; PROCEDURESetDecoration (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; PROCEDURESetWindowText (hwnd: WinDef.HWND; title: TEXT) = VAR status: WinDef.BOOL; BEGIN status := WinUser.SetWindowText (hwnd, M3toC.TtoS (title)); <* ASSERT status # 0 *> END SetWindowText; PROCEDUREReshape (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; PROCEDURESetSizeHints (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.
PROCEDUREPrivate procedure. LL = VBT.mu. WinLL assertion made by caller. In comparison to the X version, I did some pretty heavy folding here ...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;
PROCEDUREInnerOverlap ( 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*> PROCEDUREWindowProc (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; PROCEDUREDumpSystemPalette (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; PROCEDUREVirtualKeyToKeySym (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.
PROCEDUREButtonEvent (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
.
PROCEDURENote: This procedure may not be called with trsl being held, since the call toExtractModifiers (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; PROCEDUREToCursorPosition (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; PROCEDUREDeliverMousePos (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;
VBTClass.Position
might lead to a call back into WinTrestle
and an
attempt to acquire trsl
.
PROCEDUREMouseMotion (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; PROCEDUREGetVBT (trsl: T; hwnd: WinDef.HWND): VBT.T = VAR ref: REFANY := NIL; BEGIN EVAL trsl.vbts.get (hwnd, ref); RETURN ref; END GetVBT; PROCEDUREToRect (READONLY r: WinDef.RECT): Rect.T = BEGIN RETURN Rect.T{west := r.left, east := r.right, north := r.top, south := r.bottom} END ToRect; PROCEDUREFromRect (READONLY r: Rect.T): WinDef.RECT = BEGIN RETURN WinDef.RECT {left := r.west, right := r.east, top := r.north, bottom := r.south}; END FromRect; PROCEDUREEmptyRegion (): WinDef.HRGN = VAR rgn := WinGDI.CreateRectRgn (1,1,1,1); BEGIN <* ASSERT rgn # NIL *> RETURN rgn; END EmptyRegion; PROCEDUREFromRegion (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; PROCEDURESetClipRegion (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; PROCEDUREUnsetClipRegion (hdc: WinDef.HDC) = VAR status: Ctypes.int; BEGIN status := WinGDI.SelectClipRgn (hdc, NIL); <* ASSERT status # WinGDI.ERROR *> END UnsetClipRegion; PROCEDUREPrintMessageType (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; PROCEDURERegisterWindowClass () = 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*************************************************************************** Garbage-Collection Cursor ***************************************************************************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;
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; PROCEDUREDoHackInit (trsl: T) = BEGIN IF showGC THEN RTHeapRep.RegisterMonitor(NEW(GCClosure, trsl := trsl)) END; END DoHackInit; PROCEDUREHackOn (cl: GCClosure) = BEGIN IF NOT ((RTCollectorSRC.incremental AND RTHeapDep.VM AND RTHeapRep.disableVMCount = 0)) THEN HackToggle(cl.trsl, TRUE); hacking := TRUE END END HackOn; PROCEDUREHackOff (cl: GCClosure) = BEGIN IF hacking THEN HackToggle(cl.trsl, FALSE); hacking := FALSE END END HackOff; VAR hacking := FALSE; oldCursor : WinDef.HCURSOR; gcCursor : WinDef.HCURSOR; PROCEDUREHackToggle (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. *) PROCEDURECreateTrestle () = 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; PROCEDUREMessengerApply (<*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.