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.