Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Mon Jun 26 09:33:27 PDT 1995 by najork
UNSAFE MODULE*************************************************************************** Painting Tints ***************************************************************************; (* unsafe because of M3toC *) IMPORT Batch, BatchRep, BatchUtil, Ctypes, M3toC, PaintExt, PaintPrivate, Path, PathPrivate, Point, PolyRegion, Rect, Region, ScrnFont, Trapezoid, Trestle, TrestleImpl, VBT, VBTRep, WinBase, WinContext, WinDef, WinGDI, WinScreenType, WinScreenTypePrivate, WinScrnFont, WinScrnPaintOp, WinScrnPixmap, Word; TYPE PC = PaintPrivate.PaintCommand; CONST (** False = 0; **) True = 1; ComSize = ADRSIZE (PaintPrivate.CommandRec); VAR Chicago := IsChicago (); Bug95_SetDIBits := FALSE; (* Chicago; *) Bug95_PatternBrush := Chicago; PROCEDURE WinPaint PaintBatch (self: Trestle.T; v: VBT.T; ba: Batch.T; hdc: WinDef.HDC) = VAR cmdP := LOOPHOLE (ADR (ba.b[0]), PaintPrivate.CommandPtr); endP : PaintPrivate.CommandPtr := ba.next; st : WinScreenType.T := v.st; 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; LOCK self DO 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, 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 EXIT; END END; Batch.Free(ba); END; END PaintBatch;
PROCEDURE******************* (* * Debugging gearTintCom (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;
PROCEDURE StrokeRect (hdc: WinDef.HDC; READONLY r: Rect.T) = VAR rc : WinDef.RECT; oldBr : WinDef.HBRUSH; oldPen: WinDef.HPEN; status: WinDef.BOOL; BEGIN IF r.west < r.east THEN rc := FromRect(r); oldPen := WinGDI.SelectObject (hdc, WinGDI.GetStockObject (WinGDI.BLACK_PEN)); <* ASSERT oldPen # NIL *> oldBr := WinGDI.SelectObject (hdc, WinGDI.GetStockObject (WinGDI.NULL_BRUSH)); <* ASSERT oldBr # NIL *> (* "WinGDI.Rectangle" uses both the current pen and the current brush *) status := WinGDI.Rectangle (hdc, r.west, r.north, r.east+1, r.south+1); <* ASSERT status = True *> oldBr := WinGDI.SelectObject (hdc, oldBr); oldPen := WinGDI.SelectObject (hdc, oldPen); END; END StrokeRect; *************)*********** (* * More debugging gear
PROCEDURE MarkPoint (hdc: WinDef.HDC; READONLY a: Point.T) = VAR oldPen: WinDef.HGDIOBJ; BEGIN oldPen := WinGDI.SelectObject (hdc, WinGDI.GetStockObject (WinGDI.BLACK_PEN)); <* ASSERT oldPen # NIL *> DrawLine(hdc, Point.T{a.h - 2, a.v}, Point.T{a.h + 2, a.v}); DrawLine(hdc, Point.T{a.h, a.v - 2}, Point.T{a.h, a.v + 2}); oldPen := WinGDI.SelectObject (hdc, oldPen); END MarkPoint; ***********)*************************************************************************** Painting textures ***************************************************************************
PROCEDURE*************************************************************************** Painting pixmaps ***************************************************************************TextureCom (cmdP, endP: PaintPrivate.CommandPtr; hdc : WinDef.HDC; st : WinScreenType.T): PaintPrivate.CommandPtr = VAR fastPath : BOOLEAN; status : WinDef.BOOL; comdc : WinDef.HDC; bitmap : WinDef.HBITMAP; oldBitmap: WinDef.HBITMAP; pm : PaintPrivate.Pixmap; delta : Point.T; pst : WinScreenType.T; color : WinDef.COLORREF; brush : WinDef.HBRUSH; auxBrush : WinDef.HBRUSH; brop : INTEGER; frop : INTEGER; pat0 : INTEGER; pat1 : INTEGER; BEGIN WITH op = LOOPHOLE (cmdP, PaintPrivate.PixmapPtr)^ DO IF Bug95_PatternBrush AND NOT PixmapIs8x8 (op.pm, st) THEN RETURN ChicagoTextureCom (cmdP, endP, hdc, st); END; (* First, determine if we can use a fast path. For Windows NT, the fast path is to fill the rectangle directly using a pattern brush. The slow path is to copy the texture onto a memory device context, and then to repeatedly bit-blit this memory device context onto "hdc". *) IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER(st.optable^) THEN WITH tbl = st.optable[op.op] DO fastPath := (tbl.bop.mode = tbl.fop.mode); END; ELSE fastPath := TRUE; END; IF NOT fastPath THEN (* Create a compatible device context *) comdc := WinGDI.CreateCompatibleDC (hdc); (* Create a bitmap that can hold the rectangle covered by op.clip *) bitmap := WinGDI.CreateCompatibleBitmap (hdc, 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. *) delta := op.delta; IF delta # Point.Origin THEN WITH pmb = WinScrnPixmap.PixmapDomain (st, pm) DO IF NOT Rect.IsEmpty (pmb) THEN delta := Rect.Mod (delta, pmb); END; END; END; pm := op.pm; IF pm < 0 THEN pm := WinScrnPixmap.SolidPixmap - pm; pst := st.bits; ELSE pst := st; 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 (* Select the pixmap into a pattern brush *) 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 *> brop := tbl.brop3; frop := tbl.frop3; 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); (* STILL TO DO: delete "brush" *) BitBltFill (hdc, pat0, brop, op.clip, comdc); BitBltFill (hdc, pat1, frop, op.clip, comdc); INC (cmdP, ADRSIZE(op)); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO BitBltFill (hdc, pat0, brop, cmdP.clip, comdc); BitBltFill (hdc, pat1, frop, cmdP.clip, comdc); INC (cmdP, ComSize); END; status := WinGDI.DeleteDC (comdc); <* ASSERT status = True *> status := WinGDI.DeleteObject (bitmap); <* ASSERT status = True *> ELSE (* fastPath = TRUE *) 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; RETURN cmdP; END TextureCom; PROCEDUREPixmapIs8x8 (pm: PaintPrivate.Pixmap; st: WinScreenType.T): BOOLEAN = BEGIN IF pm < 0 THEN pm := WinScrnPixmap.SolidPixmap - pm; st := st.bits; END; IF st.pmtable # NIL AND pm < NUMBER (st.pmtable^) THEN WITH rect = st.pmtable[pm].domain DO RETURN Rect.VerSize (rect) = 8 AND Rect.HorSize (rect) = 8; END; ELSE RETURN TRUE; END; END PixmapIs8x8; PROCEDUREChicagoTextureCom (cmdP, endP: PaintPrivate.CommandPtr; hdc : WinDef.HDC; st : WinScreenType.T): PaintPrivate.CommandPtr = VAR dci : INTEGER; status: WinDef.BOOL; BEGIN WITH op = LOOPHOLE (cmdP, PaintPrivate.PixmapPtr)^ DO dci := WinGDI.SaveDC (hdc); <* ASSERT dci # 0 *> ClipToRect (hdc, op.clip); ChicagoFill (hdc, st, op.clip, op.op, op.pm, op.delta, TRUE); status := WinGDI.RestoreDC (hdc, -1); <* ASSERT status = True *> INC (cmdP, ADRSIZE(op)); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO dci := WinGDI.SaveDC (hdc); <* ASSERT dci # 0 *> ClipToRect (hdc, cmdP.clip); ChicagoFill (hdc, st, cmdP.clip, op.op, op.pm, op.delta, TRUE); status := WinGDI.RestoreDC (hdc, -1); <* ASSERT status = True *> INC (cmdP, ComSize); END; END; RETURN cmdP; END ChicagoTextureCom; PROCEDUREClipToRect (hdc: WinDef.HDC; clip: Rect.T) = VAR hrgn : WinDef.HRGN; status: WinDef.BOOL; BEGIN hrgn := WinGDI.CreateRectRgn (clip.west, clip.north, clip.east, clip.south); <* ASSERT hrgn # NIL *> status := WinGDI.SelectClipRgn (hdc, hrgn); <* ASSERT status # WinGDI.ERROR *> status := WinGDI.DeleteObject (hrgn); <* ASSERT status = True *> END ClipToRect; PROCEDUREChicagoFill (hdc : WinDef.HDC; st : WinScreenType.T; rect : Rect.T; op : PaintPrivate.PaintOp; pm : PaintPrivate.Pixmap; delta: Point.T; tile : BOOLEAN) = PROCEDURE BitBlt (hdc : WinDef.HDC; col : WinDef.COLORREF; rop : WinDef.DWORD; rect : Rect.T; delta : Point.T; comdc : WinDef.HDC; width : INTEGER; height: INTEGER; tile : BOOLEAN) = VAR oldBrush: WinDef.HBRUSH; solBrush: WinDef.HBRUSH; status : WinDef.BOOL; BEGIN IF rop # 0 THEN solBrush := WinGDI.CreateSolidBrush (col); <* ASSERT solBrush # NIL *> oldBrush := WinGDI.SelectObject (hdc, solBrush); <* ASSERT oldBrush # NIL *> WITH west = rect.west - (rect.west - delta.h) MOD width, north = rect.north - (rect.north - delta.v) MOD height DO IF tile THEN FOR x := west TO rect.east - 1 BY width DO FOR y := north TO rect.south - 1 BY height DO status := WinGDI.BitBlt (hdc, x, y, width, height, comdc, 0, 0, rop); <* ASSERT status = True *> END; END; ELSE status := WinGDI.BitBlt (hdc, west, north, width, height, comdc, 0, 0, rop); <* ASSERT status = True *> END; END; oldBrush := WinGDI.SelectObject (hdc, oldBrush); <* ASSERT oldBrush = solBrush *> status := WinGDI.DeleteObject (solBrush); <* ASSERT status = True *> END; END BitBlt; VAR pst : WinScreenType.T; comdc : WinDef.HDC; oldBmp : WinDef.HBITMAP; hbmp : WinDef.HBITMAP; status : WinDef.BOOL; bmi : WinGDI.BITMAPINFO; k := 0; BEGIN IF delta # Point.Origin THEN WITH pmb = WinScrnPixmap.PixmapDomain (st, pm) DO IF NOT Rect.IsEmpty (pmb) THEN delta := Rect.Mod (delta, pmb); END; END; END; IF pm < 0 THEN pm := WinScrnPixmap.SolidPixmap - pm; pst := st.bits; ELSE pst := st; END; IF op >= 0 AND st.optable # NIL AND op < NUMBER(st.optable^) AND pst.pmtable # NIL AND pm < NUMBER (pst.pmtable^) THEN WITH tbl = st.optable[op], spm = pst.pmtable[pm], height = Rect.VerSize (spm.domain), width = Rect.HorSize (spm.domain), pixels = NEW (REF ARRAY OF WinGDI.RGBQUAD, height * width) DO comdc := WinGDI.CreateCompatibleDC (hdc); <* ASSERT comdc # NIL *> hbmp := WinGDI.CreateCompatibleBitmap (hdc, width, height); <* ASSERT hbmp # NIL *> WITH h = bmi.bmiHeader DO h.biSize := BYTESIZE(WinGDI.BITMAPINFOHEADER); h.biWidth := width; h.biHeight := height; h.biPlanes := 1; h.biBitCount := BITSIZE (WinDef.COLORREF); h.biCompression := WinGDI.BI_RGB; END; status := WinGDI.GetDIBits (comdc, spm.hbmp, 0, (* start at scan line 0 *) height, (* copy "height" lines *) ADR(pixels[0]),(* into "pixels" *) ADR (bmi), WinGDI.DIB_RGB_COLORS); <* ASSERT status = height *> (* On NT, we can use "SetDIBits" to copy "pixels" into "hbmp". On Windows 95, the bitmap comes out black. So, we copy the pixels individually, using "SetPixelV". This works fine both on NT and on Windows 95. Note that the spec of "SetDIBits" says that "hbmp" must not be selected into "comdc", while the spec of "SetPixelV" says that it must be. *) IF NOT Bug95_SetDIBits THEN status := WinGDI.SetDIBits (comdc, hbmp, 0, height, ADR(pixels[0]), ADR (bmi), WinGDI.DIB_RGB_COLORS); <* ASSERT status = height *> oldBmp := WinGDI.SelectObject (comdc, hbmp); <* ASSERT oldBmp # NIL *> ELSE (* Bug95_SetDIBits = TRUE *) oldBmp := WinGDI.SelectObject (comdc, hbmp); <* ASSERT oldBmp # NIL *> k := 0; FOR y := height - 1 TO 0 BY -1 DO FOR x := 0 TO width - 1 DO WITH p = pixels[k], col = WinGDI.RGB (p.rgbRed, p.rgbGreen, p.rgbBlue) DO status := WinGDI.SetPixelV (comdc, x, y, col); <* ASSERT status = True *> INC (k); END; END; END; END; BitBlt (hdc, tbl.bop.col, tbl.brop3, rect, delta, comdc, width, height, tile); BitBlt (hdc, tbl.fop.col, tbl.frop3, rect, delta, comdc, width, height, tile); status := WinGDI.DeleteDC (comdc); <* ASSERT status = True *> status := WinGDI.DeleteObject (hbmp); <* ASSERT status = True *> END; ELSE (* "op" not in "st.optable", or "pm" not in "pst.pmtable" - do nothing *) END; END ChicagoFill;
For now, I try to treat pixmaps just like textures. This might not work for color pixmaps, and might not work for every PaintOp.
This code has not been tested for every possible PaintOp and for color. It seems to work with PaintOp.BgFg and with PaintOp.TransparentFg. I should run a fullsuite of tests once I got rudimentary color working.
Note that the Win32 specification states that WinGDI.SetBrushOrgEx works only for x and y coordinates between 0 and 7, and that I assume it to work for arbitrary coordinates. Under NT, this seems to be ok, but there is no guarantee that it will work under Windows 95.
PROCEDURE*************************************************************************** Scrolling ***************************************************************************PixmapCom (cmdP, endP: PaintPrivate.CommandPtr; hdc : WinDef.HDC; st : WinScreenType.T): PaintPrivate.CommandPtr = VAR fastPath : BOOLEAN; status : WinDef.BOOL; comdc : WinDef.HDC; bitmap : WinDef.HBITMAP; oldBitmap: WinDef.HBITMAP; pm : PaintPrivate.Pixmap; delta : Point.T; pst : WinScreenType.T; apm : PaintPrivate.Pixmap; 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 Bug95_PatternBrush AND NOT PixmapIs8x8 (op.pm, st) THEN RETURN ChicagoPixmapCom (cmdP, endP, hdc, st); END; IF op.op >= 0 AND st.optable # NIL AND op.op < NUMBER(st.optable^) THEN WITH tbl = st.optable[op.op] DO brop := tbl.brop3; frop := tbl.frop3; fastPath := (tbl.bop.mode = tbl.fop.mode); END; ELSE fastPath := TRUE; END; IF NOT fastPath THEN (* Create a compatible device context *) comdc := WinGDI.CreateCompatibleDC (hdc); (* Create a bitmap that can hold the rectangle covered by op.clip *) bitmap := WinGDI.CreateCompatibleBitmap (hdc, 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; apm := 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); BitBltFill (hdc, pat0, brop, op.clip, comdc); BitBltFill (hdc, pat1, frop, op.clip, comdc); INC (cmdP, ADRSIZE(op)); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO BitBltFill (hdc, pat0, brop, cmdP.clip, comdc); BitBltFill (hdc, pat1, frop, cmdP.clip, comdc); 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 (* fastPath = TRUE *) 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; RETURN cmdP; END PixmapCom; PROCEDUREChicagoPixmapCom ( cmdP, endP: PaintPrivate.CommandPtr; hdc : WinDef.HDC; st : WinScreenType.T): PaintPrivate.CommandPtr = VAR dci : INTEGER; status: WinDef.BOOL; BEGIN WITH op = LOOPHOLE (cmdP, PaintPrivate.PixmapPtr)^ DO dci := WinGDI.SaveDC (hdc); <* ASSERT dci # 0 *> ClipToRect (hdc, op.clip); ChicagoFill (hdc, st, op.clip, op.op, op.pm, op.delta, FALSE); status := WinGDI.RestoreDC (hdc, -1); <* ASSERT status = True *> INC (cmdP, ADRSIZE(op)); WHILE cmdP < endP AND cmdP.command = PC.RepeatCom DO dci := WinGDI.SaveDC (hdc); <* ASSERT dci # 0 *> ClipToRect (hdc, cmdP.clip); ChicagoFill (hdc, st, cmdP.clip, op.op, op.pm, op.delta, FALSE); status := WinGDI.RestoreDC (hdc, -1); <* ASSERT status = True *> INC (cmdP, ComSize); END; END; RETURN cmdP; END ChicagoPixmapCom; PROCEDUREBitBltFill (hdc : WinDef.HDC; col : WinDef.COLORREF; rop : WinDef.DWORD; rect : Rect.T; comdc : WinDef.HDC) = VAR oldBrush: WinDef.HBRUSH; solBrush: WinDef.HBRUSH; status : WinDef.BOOL; BEGIN IF rop # 0 THEN solBrush := WinGDI.CreateSolidBrush (col); <* ASSERT solBrush # NIL *> oldBrush := WinGDI.SelectObject (hdc, solBrush); <* ASSERT oldBrush # NIL *> status := WinGDI.BitBlt (hdc, rect.west, rect.north, rect.east - rect.west, rect.south - rect.north, comdc, rect.west, rect.north, rop); <* ASSERT status = True *> oldBrush := WinGDI.SelectObject (hdc, oldBrush); <* ASSERT oldBrush = solBrush *> status := WinGDI.DeleteObject (solBrush); <* ASSERT status = True *> END; END BitBltFill;
So far, I only handle cmdP.op = Paint.Copy
. I'm not quite sure what
* it means to apply general paint ops to a source whose depth is typically
* not 1.
PROCEDUREScrollCom (cmdP: PaintPrivate.CommandPtr; hdc : WinDef.HDC; st : WinScreenType.T): PaintPrivate.CommandPtr = VAR trop := 16_00AA0029; (* Ternary raster op code for NO-OP *) BEGIN WITH op = LOOPHOLE (cmdP, PaintPrivate.ScrollPtr)^ 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.Copy THEN trop := tbl.brop3; END; END; 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; WinContext.Pop (ctxt); 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 : Trestle.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; UnsetClipRegion (hdc); 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; UnsetClipRegion (hdc); 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
PROCEDURE*************************************************************************** Auxiliary procedures ***************************************************************************DrawLine (hdc: WinDef.HDC; a, b: Point.T) = VAR points := ARRAY [0..1] OF WinDef.POINT { WinDef.POINT {a.h, a.v}, WinDef.POINT {b.h, b.v}}; status: WinDef.BOOL; BEGIN status := WinGDI.Polyline (hdc, ADR(points[0]), 2); <* ASSERT status = True *> END DrawLine; TYPE StrokeMap = Path.MapObject OBJECT trsl: Trestle.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: Trestle.T; hdc: WinDef.HDC; path: Path.T) = 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); 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; status := WinGDI.Polyline (sm.hdc, ADR(sm.a[0]), sm.n); <* ASSERT status = True *> sm.n := 0; END EmitStroke; TYPE FillMap = Path.MapObject OBJECT trsl : Trestle.T; a : Points; n : CARDINAL := 0; origin, start: Point.T; OVERRIDES line := FillLine; move := FillMove; close := FillLine END; PROCEDUREFillPath (trsl: Trestle.T; hdc: WinDef.HDC; path: Path.T) = <*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); (* 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;
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; PROCEDUREIsChicago (): BOOLEAN = VAR os_version : WinBase.OSVERSIONINFO; status : WinDef.BOOL; BEGIN os_version.dwOSVersionInfoSize := BYTESIZE (os_version); status := WinBase.GetVersionEx (ADR (os_version)); <* ASSERT status = True *> RETURN os_version.dwPlatformId = WinBase.VER_PLATFORM_WIN32_WINDOWS; END IsChicago; BEGIN END WinPaint.