<*PRAGMA LL*>

MODULE Font;

IMPORT Palette, PlttFrnds, ScrnFont, ScreenType, TrestleComm, Text;

TYPE TextList = REF ARRAY OF TEXT;

PROCEDURE FromName (READONLY names: ARRAY OF TEXT): T =
  VAR tl := NEW(TextList, NUMBER(names));
  BEGIN
    FOR i := 0 TO LAST(names) DO tl[i] := names[i] END;
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.fonts # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextFont - 1 DO
          TYPECASE PlttFrnds.con.fonts[i] OF
            NULL =>              (* skip *)
          | Closure (cl) =>
              IF NUMBER(cl.names^) = NUMBER(tl^) THEN
                VAR match := TRUE;
                BEGIN
                  FOR j := 0 TO LAST(tl^) DO
                    match := match AND Text.Equal(cl.names[j], tl[j])
                  END;
                  IF match THEN RETURN T{i} END
                END
              END
          ELSE
          END
        END
      END
    END;
    RETURN Palette.FromFontClosure(NEW(Closure, names := tl))
  END FromName;

TYPE Closure = Palette.FontClosure OBJECT
    names: TextList;
  OVERRIDES
    apply := Apply
  END;

PROCEDURE Apply(cl: Closure; st: ScreenType.T): ScrnFont.T =
  BEGIN
    FOR i := FIRST(cl.names^) TO LAST(cl.names^) DO
      TRY
        RETURN st.font.lookup(cl.names[i])
      EXCEPT
        TrestleComm.Failure, ScrnFont.Failure => (*skip*)
      END
    END;
    RETURN Palette.ResolveFont(st, BuiltIn)
  END Apply;

BEGIN END Font.