ui/src/nt/NTPaint.m3


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

UNSAFE MODULE NTPaint;

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 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}}};

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

PROCEDURE TextureCom (cmd       : CommandPtr;
                      pAdr, endP: ADDRESS;
                      hdc       : WinDef.HDC;
                      st        : NTScreenType.T  ): CommandPtr
  RAISES {TrestleComm.Failure} =
  BEGIN
   NT.Assert(0);
  END TextureCom;

PROCEDURE PixmapCom (cmd       : CommandPtr;
                     pAdr, endP: ADDRESS;
                     hdc: WinDef.HDC;
                     st        : NTScreenType.T  ): CommandPtr
  RAISES {TrestleComm.Failure} =
  BEGIN
    NT.Assert(0);
  END PixmapCom;

PROCEDURE ScrollCom (cmd : CommandPtr;
                     pAdr: ADDRESS;
                     hdc: WinDef.HDC;
                     ur  : NTClientF.Child;
                     st  : NTScreenType.T   ): CommandPtr
  RAISES {TrestleComm.Failure} =
  BEGIN
    NT.Assert(0);
  END ScrollCom;

PROCEDURE TrapCom (cmd       : CommandPtr;
                   pAdr, endP: ADDRESS;
                   hdc: WinDef.HDC;
                   st        : NTScreenType.T  ): CommandPtr
  RAISES {TrestleComm.Failure} =
  BEGIN
    NT.Assert(0);
  END TrapCom;

PROCEDURE TextCom (cmd       : CommandPtr;
                   pAdr, endP: ADDRESS;
                   hdc: WinDef.HDC;
                   st        : NTScreenType.T;
                   ba        : Batch.T        ): CommandPtr
  RAISES {TrestleComm.Failure} =
  BEGIN
    NT.Assert(0);
  END TextCom;

PROCEDURE ExtensionCom (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*> PROCEDURE Div (n: INTEGER; d: CARDINAL): INTEGER =
  BEGIN
    RETURN n DIV d
  END Div;

<*INLINE*> PROCEDURE Mod (n: INTEGER; d: CARDINAL): INTEGER =
  BEGIN
    RETURN n MOD d
  END Mod;
Steve: M2+E requires these versions of Div and 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;

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 + Div(m.d * (v - p.v) + m.n - 1, 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 Mod(-m.d * (v - p.v), m.n)
  END HF;

<* INLINE *>
PROCEDURE FillRect (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.