Copyright (C) 1994, Digital Equipment Corp.
by Steve Glassman, Mark Manasse and Greg Nelson
<*PRAGMA LL*> UNSAFE MODULE; 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 NTScreenType 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; PROCEDURENew2 (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; PROCEDURENewDepthOne (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.