ui/src/winvbt/WinScreenType.m3


Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
                                                                           
       Created on Tue Jan 17 11:23:11 PST 1995 by najork                   

UNSAFE MODULE WinScreenType EXPORTS WinScreenType, WinScreenTypePrivate;

IMPORT Axis, Ctypes, PaintOp, Pixmap, Rect, TrestleComm, VBTRep, WinDef,
       WinGDI, WinScrnColorMap, WinScrnCursor, WinScrnFont, WinScrnPaintOp,
       WinScrnPixmap, WinTrestle, WinUser;

REVEAL
  T = Private BRANDED OBJECT END;
NewBits returns a new screen type of a depth corresponding to the number of planes supported by the cuurent Windows desktop. It is supposed to fill in the following fields: depth, color, bg, fg, bits, font, cmap It also calls InnerNew to fill in the remaining fields.

PROCEDURE New(trsl: WinTrestle.T): T =
  VAR
    res := NEW(T);
  BEGIN
    TRY
      WinTrestle.Enter (trsl);
      TRY
        res.trsl := trsl;
        res.bg := WinGDI.RGB (255, 255, 255); (* white *)
        res.fg := WinGDI.RGB (0, 0, 0);       (* black *)

        res.depth := BITSIZE (WinDef.COLORREF);

        (* "GetDeviceCaps (WinGDI.PLANES)" returns 1.
           "GetDeviceCaps (WinGDI.BITSPIXEL)" returns 8.
           "BITSIZE (WinDef.COLORREF)" returns 32. *)

        res.bits := NewBits(trsl);
        InnerNew (res);
        res.font := WinScrnFont.NewOracle (res, FALSE);
        res.color := GetDeviceCaps (WinGDI.NUMCOLORS) > 2;
        res.cmap := WinScrnColorMap.NewOracle();
      FINALLY
        WinTrestle.Exit (trsl);
      END;
    EXCEPT
      TrestleComm.Failure => (* skip *)
    END;
    RETURN res;
  END New;
NewBits returns a new screen type of depth 1 (i.e. a bitmap screen type). It is supposed to fill in the following fields: depth, color, bg, fg, bits, font, cmap It also calls InnerNew to fill in the remaining fields. LL = trsl

PROCEDURE NewBits(trsl: WinTrestle.T): T RAISES {TrestleComm.Failure} =
  VAR
    res := NEW (T);
  BEGIN
    res.trsl  := trsl;
    res.depth := 1;
    res.bits  := res;
    InnerNew(res);
    res.font  := WinScrnFont.NewOracle (res, TRUE);
    res.cmap  := NIL;
    res.color := FALSE;
    res.bg    := 0;
    res.fg    := 1;
    RETURN res;
  END NewBits;

PROCEDURE InnerNew ((* IN-OUT *) res: T) RAISES {TrestleComm.Failure} =
  BEGIN
    WITH pix_hor = WinUser.GetSystemMetrics(WinUser.SM_CXSCREEN),
         pix_ver = WinUser.GetSystemMetrics(WinUser.SM_CYSCREEN),
         mm_hor  = GetDeviceCaps (WinGDI.HORZSIZE),
         mm_ver  = GetDeviceCaps (WinGDI.VERTSIZE) DO
      res.rootDom := Rect.FromSize(pix_hor, pix_ver);
      res.res[Axis.T.Hor] := FLOAT(pix_hor) / FLOAT(mm_hor);
      res.res[Axis.T.Ver] := FLOAT(pix_ver) / FLOAT(mm_ver);
    END;
    res.op := WinScrnPaintOp.NewOracle (res);
    res.cursor := WinScrnCursor.NewOracle (res);
    res.pixmap := WinScrnPixmap.NewOracle (res);
    res.ops := NIL;
    res.cursors := NIL;
    res.pixmaps := NIL;
    res.fonts := NIL;

    res.optable := NEW (REF ARRAY OF WinScrnPaintOp.OpRecord,
                        NUMBER (PaintOp.Predefined));
    res.pmtable := NEW (REF ARRAY OF WinScrnPixmap.PixmapRecord,
                        NUMBER (Pixmap.Predefined));
  END InnerNew;

PROCEDURE GetDeviceCaps (cap: Ctypes.int): INTEGER =
  BEGIN
    WITH hwnd   = WinUser.GetDesktopWindow(),
         hdc    = WinUser.GetDC (hwnd),
         res    = WinGDI.GetDeviceCaps (hdc, cap),
         status = WinUser.ReleaseDC (hwnd, hdc) DO
      <* ASSERT status # 0 *>
      RETURN res;
    END;
  END GetDeviceCaps;

BEGIN
END WinScreenType.