ui/src/nt/NTScreenType.m3


Copyright (C) 1994, Digital Equipment Corp.
 by Steve Glassman, Mark Manasse and Greg Nelson 

<*PRAGMA LL*>

UNSAFE MODULE NTScreenType;

IMPORT Axis, NTClient, NTMsgs, NTScrnCmap, NTScrnCrsr, NTScrnFont,
       NTScrnPntOp, NTScrnPxmp, NTScrnTpRep, PaintOp, Pixmap, Rect,
       ScreenType, TrestleComm, TrestleOnNT, WinDef, WinGDI, WinUser;

CONST
  Black = 16_0;
  White = 16_FFFFFF;

REVEAL
  T = NTScrnPntOp.T BRANDED OBJECT END;

PROCEDURE New (trsl: NTClient.T; i: INTEGER): T =
  VAR
    res             := NEW(T, trsl := trsl);
    hdc: WinDef.HDC;
  BEGIN
    TRY
      TrestleOnNT.Enter(trsl);
      TRY
        hdc := WinUser.GetDC(NTMsgs.NullWindow(trsl));

        (* res.depth > 0, since the default visual must be supported. *)
        res.depth := WinGDI.GetDeviceCaps(hdc, WinGDI.BITSPIXEL);
        res.color := TRUE;       (* ??? *)
        WITH hpal = WinGDI.GetCurrentObject(hdc, WinGDI.OBJ_PAL) DO
          res.bg := WinGDI.GetNearestPaletteIndex(hpal, White);
          res.fg := WinGDI.GetNearestPaletteIndex(hpal, Black);
        END;
        New2(hdc, i, res);
        res.font := NTScrnFont.NewOracle(res);
        res.cmap := NTScrnCmap.NewOracle(res);
        res.nullCursor := NTScrnCrsr.NullCursor()
      FINALLY
        TrestleOnNT.Exit(trsl)
      END;
      res.bits := NewDepthOne(trsl, hdc, i)
    EXCEPT
      TrestleComm.Failure =>     (*skip*)
    END;
    RETURN res
  END New;

PROCEDURE New2 (hdc: WinDef.HDC; i: INTEGER; res: T)
  RAISES {TrestleComm.Failure} =
  (* The initialization common to st and st.bits.  LL = trsl *)
  VAR
    w := WinGDI.GetDeviceCaps(hdc, WinGDI.HORZRES);
    h := WinGDI.GetDeviceCaps(hdc, WinGDI.VERTRES);
  BEGIN
    res.rootDom := Rect.FromSize(w, h);
    res.res[Axis.T.Hor] :=
      FLOAT(WinGDI.GetDeviceCaps(hdc, WinGDI.HORZSIZE)) / FLOAT(w);
    res.res[Axis.T.Ver] :=
      FLOAT(WinGDI.GetDeviceCaps(hdc, WinGDI.VERTSIZE)) / FLOAT(h);
    res.op := NTScrnPntOp.NewOracle(res);
    res.cursor := NTScrnCrsr.NewOracle(res);
    res.pixmap := NTScrnPxmp.NewOracle(res);
    res.optable :=
      NEW(REF ARRAY OF NTScrnTpRep.OpRecord, NUMBER(PaintOp.Predefined));
    res.pmtable := NEW(REF ARRAY OF NTScrnTpRep.PixmapRecord,
                       NUMBER(Pixmap.Predefined));
    res.screenID := i;
  END New2;

PROCEDURE NewDepthOne (trsl: NTClient.T; hdc: WinDef.HDC; i: INTEGER):
  T =
  VAR res := NEW(T, trsl := trsl);
  BEGIN
    TRY
      TrestleOnNT.Enter(trsl);
      TRY
        res.depth := 1;
        res.color := FALSE;
        res.bg := 0;
        res.fg := 1;
        res.bits := res;
        New2(hdc, i, res);
        res.font := NTScrnFont.NewOracle(res, TRUE);
        res.cmap := NIL
      FINALLY
        TrestleOnNT.Exit(trsl)
      END
    EXCEPT
      TrestleComm.Failure =>    (*skip*)
    END;
    RETURN res
  END NewDepthOne;

BEGIN
END NTScreenType.