kolibrios-gitea/programs/other/fb2reader/SRC/Font.ob07

(*
    Copyright 2016, 2018, 2022 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 <http://www.gnu.org/licenses/>.
*)

MODULE Font;

IMPORT W := Window, S := Strings, G := Graph, sys := SYSTEM, K := KOSAPI, Conv, Ini, KF := kfonts;

VAR

  kf_font, kf_loaded, 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.PBuffer);
BEGIN
  KF.TextOut(KFont, canvas.adr - 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
    Conv.convert(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
    Conv.convert(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_loaded := KFont # NIL;
  kf_font := kf_loaded;
  kf_enabled := kf_loaded
END Font.