(* 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 . *) 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.