ui/src/nt/NTScrnFont.m3


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

UNSAFE MODULE NTScrnFont;

IMPORT Axis, Ctypes, Fmt, Font, M3toC, NT, NTScreenType,
       NTScrnTpRep, Palette, Rect, ScreenType, ScrnFont, Text, TrestleComm,
       TrestleOnNT ;

TYPE
  DeepFontOracle =
    ScrnFont.Oracle OBJECT
      st: NTScreenType.T;
    METHODS
      init (st: NTScreenType.T): DeepFontOracle := DeepInitFontOracle;
      (* LL = st.trsl *)
    OVERRIDES
      list    := DeepFontList;
      match   := DeepFontMatch;
      lookup  := DeepFontLookup;
      builtIn := DeepFontBuiltIn
    END;
  FontOracle =
    ScrnFont.Oracle OBJECT
      st: NTScreenType.T;
    METHODS
      init (st: NTScreenType.T): FontOracle RAISES {TrestleComm.Failure} := InitFontOracle;
      (* LL = st.trsl *)
    OVERRIDES
      list    := FontList;
      match   := FontMatch;
      lookup  := FontLookup;
      builtIn := FontBuiltIn
    END;
  NTFont = ScrnFont.T;

PROCEDURE NewOracle (scrn: NTScreenType.T; depthOne := FALSE): ScrnFont.Oracle
  RAISES {TrestleComm.Failure} =
  BEGIN
    IF depthOne THEN
      RETURN NEW(FontOracle).init(scrn);
    ELSE
      RETURN NEW(DeepFontOracle).init(scrn);
    END;
  END NewOracle;

PROCEDURE DeepFontMatch (orc            : DeepFontOracle;
                         family         : TEXT;
                         pointSize      : INTEGER;
                         slant          : ScrnFont.Slant;
                         maxResults     : CARDINAL;
                         weightName     : TEXT;
                         version        : TEXT;
                         foundry        : TEXT;
                         width          : TEXT;
                         pixelsize      : INTEGER;
                         hres, vres     : INTEGER;
                         spacing        : ScrnFont.Spacing;
                         averageWidth   : INTEGER;
                         charsetRegistry: TEXT;
                         charsetEncoding: TEXT              ):
  REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN orc.st.bits.font.match(
             family, pointSize, slant, maxResults, weightName, version,
             foundry, width, pixelsize, hres, vres, spacing, averageWidth,
             charsetRegistry, charsetEncoding)
  END DeepFontMatch;

PROCEDURE DeepFontList (orc: DeepFontOracle; pat: TEXT; maxResults: INTEGER):
  REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN orc.st.bits.font.list(pat, maxResults)
  END DeepFontList;

PROCEDURE FontMatch (orc            : FontOracle;
                     family         : TEXT;
                     pointSize      : INTEGER;
                     slant          : ScrnFont.Slant;
                     maxResults     : CARDINAL;
                     weightName     : TEXT;
                     version        : TEXT;
                     foundry        : TEXT;
                     width          : TEXT;
                     pixelsize      : INTEGER;
                     hres, vres     : INTEGER;
                     spacing        : ScrnFont.Spacing;
                     averageWidth   : INTEGER;
                     charsetRegistry: TEXT;
                     charsetEncoding: TEXT              ):
  REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
  VAR fname: TEXT;
  BEGIN
    IF Text.Length(version) # 0 THEN
      fname := "+" & version
    ELSE
      fname := ""
    END;
    fname := fname & "-" & foundry & "-" & family & "-" & weightName & "-";
    CASE slant OF
      ScrnFont.Slant.Roman => fname := fname & "R"
    | ScrnFont.Slant.Italic => fname := fname & "I"
    | ScrnFont.Slant.Oblique => fname := fname & "O"
    | ScrnFont.Slant.ReverseItalic => fname := fname & "RI"
    | ScrnFont.Slant.ReverseOblique => fname := fname & "RO"
    | ScrnFont.Slant.Other => fname := fname & "OT"
    | ScrnFont.Slant.Any => fname := fname & "*"
    END;
    fname := fname & "-" & width & "-*-" & Num(pixelsize) & Num(pointSize)
               & ResNum(hres, orc.st.res[Axis.T.Hor])
               & ResNum(vres, orc.st.res[Axis.T.Ver]);
    CASE spacing OF
      ScrnFont.Spacing.Proportional => fname := fname & "P"
    | ScrnFont.Spacing.Monospaced => fname := fname & "M"
    | ScrnFont.Spacing.CharCell => fname := fname & "C"
    | ScrnFont.Spacing.Any => fname := fname & "*"
    END;
    fname := fname & "-" & Num(averageWidth) & charsetRegistry & "-"
               & charsetEncoding;
    RETURN orc.list(fname, maxResults)
  END FontMatch;

PROCEDURE FontList (orc: FontOracle; pat: TEXT; maxResults: INTEGER):
  REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
  BEGIN
    NT.Assert(0); (* NYI *)
  END FontList;

PROCEDURE Num (n: INTEGER): TEXT =
  BEGIN
    IF n < 0 THEN RETURN "*-" ELSE RETURN Fmt.Int(n) & "-" END
  END Num;

PROCEDURE ResNum (n: INTEGER; res: REAL): TEXT =
  BEGIN
    (* Gross hack to deal with the fact that all available fonts for X are
       either scaled for 75 pixel per inch or 100 pixel per inch
       displays *)
    IF n = -2 THEN
      RETURN Num(ROUND(res * 25.4 / 25.0) * 25)
    ELSE
      RETURN Num(n)
    END
  END ResNum;

PROCEDURE DeepFontLookup (orc: DeepFontOracle; name: TEXT): ScrnFont.T
  RAISES {ScrnFont.Failure, TrestleComm.Failure} =
  BEGIN
    RETURN orc.st.bits.font.lookup(name)
  END DeepFontLookup;

PROCEDURE FontLookup (orc: FontOracle; name: TEXT): ScrnFont.T
  RAISES {ScrnFont.Failure, TrestleComm.Failure} =
  BEGIN
    NT.Assert(0); (* NYI *)
  END FontLookup;

CONST
  BuiltInNames = ARRAY OF
                   TEXT{
                   "-adobe-helvetica-medium-r-normal--*-100-*-*-p-*-iso8859-1",
                   "-*-helvetica-medium-r-*-*-*-10?-*-*-*-*-iso8859-1",
                   "-*-times-medium-r-*-*-*-10?-*-*-*-*-iso8859-1",
                   "fixed", "-*-helvetica-*-r-*-*-*-11?-*-*-*-*-iso8859-1",
                   "-*-helvetica-*-r-*-*-*-12?-*-*-*-*-iso8859-1",
                   "-*-helvetica-*-r-*-*-*-1??-*-*-*-*-iso8859-?",
                   "-*-times-*-r-*-*-*-1??-*-*-*-*-iso8859-?", "timrom1?",
                   "times_roman1?", "*"};

PROCEDURE DeepFontBuiltIn (orc: DeepFontOracle; id: Font.Predefined):
  ScrnFont.T =
  BEGIN
    RETURN Palette.ResolveFont(orc.st.bits, Font.T{id})
  END DeepFontBuiltIn;

PROCEDURE FontBuiltIn (orc: FontOracle; id: Font.Predefined): ScrnFont.T =
  BEGIN
    IF id # Font.BuiltIn.fnt THEN Crash() END;
    RETURN
      NEW(ScrnFont.T, id := 0,
          metrics := NEW(NullMetrics,
                         minBounds := ScrnFont.CharMetric{0, Rect.Empty},
                         maxBounds := ScrnFont.CharMetric{0, Rect.Empty},
                         firstChar := 0, lastChar := 0,
                         selfClearing := TRUE, charMetrics := NIL))
  END FontBuiltIn;

TYPE
  NullMetrics = ScrnFont.Metrics OBJECT
                OVERRIDES
                  intProp  := NullIntProp;
                  textProp := NullTextProp
                END;

PROCEDURE NullIntProp (<*UNUSED*> self: NullMetrics;
                       <*UNUSED*> name: TEXT;
                       <*UNUSED*> ch  : INTEGER       := -1): INTEGER
  RAISES {ScrnFont.Failure} =
  BEGIN
    RAISE ScrnFont.Failure
  END NullIntProp;

PROCEDURE NullTextProp (<*UNUSED*> self: NullMetrics;
                        <*UNUSED*> name: TEXT;
                        <*UNUSED*> ch  : INTEGER       := -1): TEXT
  RAISES {ScrnFont.Failure} =
  BEGIN
    RAISE ScrnFont.Failure
  END NullTextProp;

PROCEDURE InitFontOracle (orc: FontOracle; st: NTScreenType.T): FontOracle
  RAISES {TrestleComm.Failure} =
  BEGIN
    orc.st := st;
    RETURN orc
  END InitFontOracle;

PROCEDURE DeepInitFontOracle (orc: DeepFontOracle; st: NTScreenType.T):
  DeepFontOracle =
  BEGIN
    orc.st := st;
    RETURN orc
  END DeepInitFontOracle;

EXCEPTION FatalError;

PROCEDURE Crash() =
  <* FATAL FatalError *>
  BEGIN
    RAISE FatalError;
  END Crash;

BEGIN
END NTScrnFont.