Copyright (C) 1994, Digital Equipment Corp.
by Steve Glassman, Mark Manasse and Greg Nelson
<*PRAGMA LL*> UNSAFE MODULESteve: M2+E requires these versions of Div and Mod:; IMPORT Batch, BatchRep, BatchUtil, NT, NTClientF, NTScrnPxmp, NTScreenType, PaintPrivate, Path, Point, Rect, Region, Trapezoid, TrestleComm, TrestleOnNT, TrestleClass, VBTClass, VBT, VBTRep, WinDef, WinGDI, WinUser, Word; FROM PaintPrivate IMPORT CommandPtr; REVEAL T = TrestleOnNT.Display BRANDED OBJECT OVERRIDES paintbatch := PaintBatch; END; TYPE PC = PaintPrivate.PaintCommand; CONST ComSize = ADRSIZE(PaintPrivate.CommandRec); PROCEDURE NTPaint PaintBatch (v: T; ch: VBT.T; ba: Batch.T) RAISES {} = VAR cmd : CommandPtr; ur : NTClientF.Child := ch.upRef; w : WinDef.HWND; hdc : WinDef.HDC; pAdr := ADR(ba.b[0]); endP := ba.next; st : NTScreenType.T := ch.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; TRY TrestleOnNT.Enter(v); TRY w := ur.hwnd; hdc := WinUser.GetDC(w); WHILE pAdr < endP DO cmd := pAdr; CASE cmd.command OF PC.TintCom => pAdr := TintCom(cmd, pAdr, endP, hdc, st); | PC.TextureCom => pAdr := TextureCom(cmd, pAdr, endP, hdc, st); | PC.PixmapCom => pAdr := PixmapCom(cmd, pAdr, endP, hdc, st); | PC.ScrollCom => pAdr := ScrollCom(cmd, pAdr, hdc, ur, st); | PC.TrapCom => pAdr := TrapCom(cmd, pAdr, endP, hdc, st); | PC.TextCom => pAdr := TextCom(cmd, pAdr, endP, hdc, st, ba); | PC.ExtensionCom => pAdr := ExtensionCom(cmd, pAdr, endP, hdc, v, st); | PC.RepeatCom => INC(pAdr, ComSize) ELSE RETURN END END FINALLY Batch.Free(ba); TrestleOnNT.Exit(v) END EXCEPT TrestleComm.Failure => (* skip *) END END PaintBatch; TYPE Bits = ARRAY [0..7] OF Word.T; PackedDIB = RECORD bi: WinGDI.BITMAPINFO; (* space for second rgb entry *) rgb2: WinGDI.RGBQUAD := WinGDI.RGBQUAD{0, 0, 0, 0}; bits: Bits := Bits{0, ..}; END; VAR SolidDIB: PackedDIB := PackedDIB{ bi := WinGDI.BITMAPINFO { bmiColors := ARRAY [0 .. 0] OF WinGDI.RGBQUAD{WinGDI.RGBQUAD{0, 0, 0, 0}}, bmiHeader := WinGDI.BITMAPINFOHEADER { biSize := BYTESIZE(WinGDI.BITMAPINFOHEADER), biWidth := 8, biHeight := 8, biPlanes := 1, biBitCount := 1, biCompression := WinGDI.BI_RGB, biSizeImage := 0, biXPelsPerMeter := 1, (* ??? *) biYPelsPerMeter := 1, biClrUsed := 1, biClrImportant := 0}}}; PROCEDURETintCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc : WinDef.HDC; st : NTScreenType.T): CommandPtr RAISES {TrestleComm.Failure} = VAR rpt : CommandPtr; hbr: WinDef.HBRUSH; BEGIN TRY WITH op = LOOPHOLE(cmd, PaintPrivate.TintPtr) DO INC(pAdr, ADRSIZE(op^)); WITH tbl = st.optable[op.op] DO NT.Assert(WinGDI.SetROP2(hdc, tbl.rop)); hbr := WinGDI.CreateSolidBrush(16_1000000 + tbl.fg); END; FillRect(hdc, op.clip, hbr); LOOP IF pAdr >= endP THEN EXIT END; rpt := pAdr; IF rpt.command # PC.RepeatCom THEN EXIT END; INC(pAdr, ComSize); FillRect(hdc, rpt.clip, hbr) END END; FINALLY NT.Assert(WinGDI.DeleteObject(hbr)); END; RETURN pAdr; END TintCom; PROCEDURETextureCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc : WinDef.HDC; st : NTScreenType.T ): CommandPtr RAISES {TrestleComm.Failure} = BEGIN NT.Assert(0); END TextureCom; PROCEDUREPixmapCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc: WinDef.HDC; st : NTScreenType.T ): CommandPtr RAISES {TrestleComm.Failure} = BEGIN NT.Assert(0); END PixmapCom; PROCEDUREScrollCom (cmd : CommandPtr; pAdr: ADDRESS; hdc: WinDef.HDC; ur : NTClientF.Child; st : NTScreenType.T ): CommandPtr RAISES {TrestleComm.Failure} = BEGIN NT.Assert(0); END ScrollCom; PROCEDURETrapCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc: WinDef.HDC; st : NTScreenType.T ): CommandPtr RAISES {TrestleComm.Failure} = BEGIN NT.Assert(0); END TrapCom; PROCEDURETextCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc: WinDef.HDC; st : NTScreenType.T; ba : Batch.T ): CommandPtr RAISES {TrestleComm.Failure} = BEGIN NT.Assert(0); END TextCom; PROCEDUREExtensionCom (cmd : CommandPtr; pAdr, endP: ADDRESS; hdc: WinDef.HDC; v : T; st : NTScreenType.T ): CommandPtr RAISES {TrestleComm.Failure} = <* FATAL Path.Malformed *> BEGIN NT.Assert(0); END ExtensionCom; <*INLINE*> PROCEDUREDiv (n: INTEGER; d: CARDINAL): INTEGER = BEGIN RETURN n DIV d END Div; <*INLINE*> PROCEDUREMod (n: INTEGER; d: CARDINAL): INTEGER = BEGIN RETURN n MOD d END Mod;
PROCEDURE Div(n: INTEGER; d: CARDINAL): INTEGER; BEGIN IF n >= 0 THEN RETURN n DIV d ELSE RETURN -1 - (-n - 1) DIV d END END Div;
PROCEDURE Mod(n: INTEGER; d: CARDINAL): INTEGER; BEGIN IF n >= 0 THEN RETURN n MOD d ELSE RETURN d - 1 - (-n - 1) MOD d END END Mod;
PROCEDUREHW (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 + Div(m.d * (v - p.v) + m.n - 1, m.n) END HW; PROCEDUREHF (READONLY m: Trapezoid.Rational; READONLY p: Point.T; v: INTEGER ): INTEGER = (* Return fractional part of (ceiling - actual) of intersection above *) BEGIN RETURN Mod(-m.d * (v - p.v), m.n) END HF; <* INLINE *> PROCEDUREFillRect (hdc: WinDef.HDC; READONLY r: Rect.T; hbr: WinDef.HBRUSH) RAISES {TrestleComm.Failure} = BEGIN IF r.west < r.east THEN VAR rc := NT.FromRect(r); oldBr := WinGDI.SelectObject(hdc, hbr); BEGIN (* NT.Assert(WinUser.FillRect(hdc, ADR(rc), hbr)); *) EVAL WinGDI.SelectObject(hdc, WinGDI.GetStockObject(WinGDI.NULL_PEN)); NT.Assert(WinGDI.Rectangle(hdc, r.west, r.north, r.east+1, r.south+1)); EVAL WinGDI.SelectObject(hdc, oldBr); END; END; END FillRect; BEGIN END NTPaint.