Subversion Repositories Kolibri OS

(*

    Copyright 2016, 2018, 2022, 2023 Anton Krotov

    This file is part of fb2read.

    fb2read is free software: you can redistribute it and/or modify

    it under the terms of the GNU General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    fb2read is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License

    along with fb2read. If not, see .

*)

MODULE Font;

IMPORT

	W := Window, S := Strings, G := Graph, sys := SYSTEM, K := KOSAPI,

	Encoding, Ini, KF := kfonts;

VAR

  kf_font, kf_enabled: BOOLEAN;

  cp1251buf: ARRAY 102400 OF CHAR;

  KFont*: KF.TFont;

  Font*: RECORD

    color* : INTEGER;

    size   : INTEGER;

    bold   : BOOLEAN;

    italic : BOOLEAN;

    strike : BOOLEAN

  END;

  ItalicColor, NormalColor: INTEGER;

PROCEDURE KFText(X, Y: INTEGER; first, quantity: INTEGER; canvas: G.tBuffer);

BEGIN

  KF.TextOut(KFont, canvas.bitmap - 8, X, Y, first, quantity, Font.color, ORD(Font.bold) + ORD(Font.italic) * 2 + ORD(Font.strike) * 8)

END KFText;

PROCEDURE sysfont*(sf: BOOLEAN);

BEGIN

  kf_font := ~sf & kf_enabled;

END sysfont;

PROCEDURE params*(): INTEGER;

  RETURN Font.size + 0 + LSL(3, 16) + LSL(ORD(Font.bold) + ORD(Font.italic) * 2 + 128, 24)

END params;

PROCEDURE SetFontColor*(color: INTEGER);

BEGIN

	Font.color := color

END SetFontColor;

PROCEDURE Bold*(bold: BOOLEAN);

BEGIN

  Font.bold := bold

END Bold;

PROCEDURE Italic*(italic, notLink: BOOLEAN);

BEGIN

	Font.italic := italic;

	IF italic THEN

		IF notLink THEN

			SetFontColor(ItalicColor)

		END

	ELSE

		IF notLink THEN

			SetFontColor(NormalColor)

		END

	END

END Italic;

PROCEDURE Strike*(strike: BOOLEAN);

BEGIN

  Font.strike := strike

END Strike;

PROCEDURE FontW(): INTEGER;

  RETURN ASR(Font.size, 1)

END FontW;

PROCEDURE FontH*(): INTEGER;

VAR res: INTEGER;

BEGIN

  IF kf_font THEN

    res := KF.TextHeight(KFont)

  ELSE

    res := Font.size

  END

  RETURN res

END FontH;

PROCEDURE TextWidth*(text: S.CHARS; length: INTEGER): INTEGER;

VAR res: INTEGER;

BEGIN

  IF kf_font THEN

    Encoding.convert1251(text.first, sys.ADR(cp1251buf[0]), length);

    res := KF.TextWidth(KFont, sys.ADR(cp1251buf[0]), length, ORD(Font.bold) + ORD(Font.italic) * 2)

  ELSE

    res := length * FontW()

  END

  RETURN res

END TextWidth;

PROCEDURE MonoWidth*(): INTEGER;

  RETURN FontW()

END MonoWidth;

PROCEDURE StrikeText*(Rect: W.tRect; X, Y: INTEGER; width: INTEGER);

VAR y: INTEGER;

BEGIN

  IF Font.strike THEN

    y := Y + FontH() DIV 2;

//    X := X + ORD(Font.italic & kf_font) * ((KF.TextHeight(KFont) DIV 2) DIV 3);

    G.SetColor(Font.color);

    G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);

    IF Font.size >= 28 THEN

      INC(y);

      G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);

    END

  END

END StrikeText;

PROCEDURE Text*(Rect: W.tRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER);

BEGIN

  IF kf_font THEN

    Encoding.convert1251(adr, sys.ADR(cp1251buf[0]), length);

    KFText(X + Rect.left, Y + Rect.top, sys.ADR(cp1251buf[0]), length, G.Buffer)

  ELSE

    G.SetColor(Font.color);

    G.TextOut(X + Rect.left, Y + Rect.top, adr, length, Font.size, params())

  END

END Text;

PROCEDURE Init*(italic, normal, fs: INTEGER);

BEGIN

  ItalicColor := italic;

  NormalColor := normal;

  IF KF.SetSize(KFont, fs) THEN

    Font.size := KF.TextHeight(KFont);

    kf_font := TRUE;

    kf_enabled := TRUE

  ELSE

    Font.size := fs;

    kf_font := FALSE;

    kf_enabled := FALSE

  END

END Init;

BEGIN

  KFont := KF.LoadFont(Ini.Font);

  kf_font := KFont # NIL;

  kf_enabled := kf_font

END Font.