467 lines
11 KiB
Plaintext
467 lines
11 KiB
Plaintext
(*
|
|
Copyright 2018-2020, 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 <http://www.gnu.org/licenses/>.
|
|
*)
|
|
|
|
MODULE kfonts;
|
|
|
|
IMPORT File, sys := SYSTEM, LISTS, KOSAPI, S := Strings;
|
|
|
|
|
|
CONST
|
|
|
|
MIN_FONT_SIZE = 8;
|
|
MAX_FONT_SIZE = 46;
|
|
|
|
bold* = 1;
|
|
//italic* = 2;
|
|
underline* = 4;
|
|
strike_through* = 8;
|
|
//smoothing* = 16;
|
|
//bpp32* = 32;
|
|
|
|
|
|
TYPE
|
|
|
|
FNAME = ARRAY 2048 OF CHAR;
|
|
|
|
FILE = RECORD
|
|
|
|
name: FNAME;
|
|
data, size, pos: INTEGER
|
|
|
|
END;
|
|
|
|
PIX = POINTER TO RECORD (LISTS.ITEM)
|
|
|
|
x, y: INTEGER
|
|
|
|
END;
|
|
|
|
FONT = POINTER TO RECORD
|
|
|
|
chars,
|
|
smooth: ARRAY 256 OF LISTS.LIST;
|
|
width: ARRAY 256 OF INTEGER;
|
|
height: INTEGER;
|
|
file: FILE
|
|
|
|
END;
|
|
|
|
TFont* = FONT;
|
|
|
|
|
|
PROCEDURE getch (VAR F: FILE): CHAR;
|
|
VAR
|
|
ch: CHAR;
|
|
BEGIN
|
|
IF (F.pos >= 0) & (F.pos < F.size) THEN
|
|
sys.GET(F.data + F.pos, ch);
|
|
INC(F.pos)
|
|
ELSE
|
|
ch := 0X
|
|
END
|
|
RETURN ch
|
|
END getch;
|
|
|
|
|
|
PROCEDURE getint (VAR F: FILE): INTEGER;
|
|
VAR
|
|
i: INTEGER;
|
|
BEGIN
|
|
IF (F.pos >= 0) & (F.pos < F.size) THEN
|
|
sys.GET(F.data + F.pos, i);
|
|
INC(F.pos, 4)
|
|
ELSE
|
|
i := 0
|
|
END
|
|
RETURN i
|
|
END getint;
|
|
|
|
|
|
PROCEDURE getpix (list: LISTS.LIST; x, y: INTEGER): BOOLEAN;
|
|
VAR
|
|
pix: PIX;
|
|
res: BOOLEAN;
|
|
|
|
BEGIN
|
|
res := FALSE;
|
|
pix := list.first(PIX);
|
|
WHILE pix # NIL DO
|
|
IF (pix.x = x) & (pix.y = y) THEN
|
|
res := TRUE;
|
|
pix := NIL
|
|
ELSE
|
|
pix := pix.next(PIX)
|
|
END
|
|
END
|
|
|
|
RETURN res
|
|
END getpix;
|
|
|
|
|
|
PROCEDURE process (font: FONT; n: INTEGER);
|
|
VAR
|
|
xsize, ysize, size, ch_size, xmax: INTEGER;
|
|
ptr: INTEGER; i, c: INTEGER;
|
|
s: SET; x, y: INTEGER;
|
|
eoc: BOOLEAN;
|
|
|
|
pix: PIX; chr, smooth: LISTS.LIST;
|
|
BEGIN
|
|
font.file.pos := n * 4;
|
|
ptr := getint(font.file) + 156;
|
|
font.file.pos := ptr;
|
|
size := getint(font.file);
|
|
INC(font.file.pos, size - 6);
|
|
xsize := ORD(getch(font.file));
|
|
ysize := ORD(getch(font.file));
|
|
ch_size := (size - 6) DIV 256;
|
|
|
|
INC(ptr, 4);
|
|
|
|
font.height := ysize;
|
|
|
|
FOR c := 0 TO 255 DO
|
|
chr := font.chars[c];
|
|
smooth := font.smooth[c];
|
|
font.file.pos := ptr + c * ch_size;
|
|
|
|
x := 0; y := 0; eoc := FALSE;
|
|
xmax := 0;
|
|
|
|
eoc := (xsize = 0) OR (ysize = 0);
|
|
|
|
WHILE ~eoc DO
|
|
|
|
s := BITS(getint(font.file));
|
|
i := 0;
|
|
|
|
WHILE i <= 31 DO
|
|
IF i IN s THEN
|
|
NEW(pix);
|
|
IF x > xmax THEN
|
|
xmax := x
|
|
END;
|
|
pix.x := x;
|
|
pix.y := y;
|
|
LISTS.push(chr, pix)
|
|
END;
|
|
INC(x);
|
|
IF x = xsize THEN
|
|
x := 0;
|
|
INC(y);
|
|
IF y = ysize THEN
|
|
eoc := TRUE;
|
|
i := 31
|
|
END
|
|
END;
|
|
INC(i)
|
|
END
|
|
|
|
END;
|
|
|
|
FOR x := 0 TO xsize - 2 DO
|
|
FOR y := 0 TO ysize - 2 DO
|
|
IF getpix(chr, x, y) & getpix(chr, x + 1, y + 1) &
|
|
~getpix(chr, x + 1, y) & ~getpix(chr, x, y + 1) THEN
|
|
|
|
IF ~getpix(smooth, x + 1, y) THEN
|
|
NEW(pix);
|
|
pix.x := x + 1;
|
|
pix.y := y;
|
|
LISTS.push(smooth, pix);
|
|
END;
|
|
|
|
IF ~getpix(smooth, x, y + 1) THEN
|
|
NEW(pix);
|
|
pix.x := x;
|
|
pix.y := y + 1;
|
|
LISTS.push(smooth, pix)
|
|
END
|
|
END
|
|
END
|
|
END;
|
|
|
|
FOR x := 1 TO xsize - 1 DO
|
|
FOR y := 0 TO ysize - 2 DO
|
|
IF getpix(chr, x, y) & getpix(chr, x - 1, y + 1) &
|
|
~getpix(chr, x - 1, y) & ~getpix(chr, x, y + 1) THEN
|
|
|
|
IF ~getpix(smooth, x - 1, y) THEN
|
|
NEW(pix);
|
|
pix.x := x - 1;
|
|
pix.y := y;
|
|
LISTS.push(smooth, pix);
|
|
END;
|
|
|
|
IF ~getpix(smooth, x, y + 1) THEN
|
|
NEW(pix);
|
|
pix.x := x;
|
|
pix.y := y + 1;
|
|
LISTS.push(smooth, pix)
|
|
END
|
|
END
|
|
END
|
|
END;
|
|
|
|
IF xmax = 0 THEN
|
|
xmax := xsize DIV 3
|
|
END;
|
|
|
|
font.width[c] := xmax
|
|
|
|
END
|
|
|
|
END process;
|
|
|
|
|
|
PROCEDURE getrgb(color: INTEGER; VAR r, g, b: INTEGER);
|
|
BEGIN
|
|
b := ORD(BITS(color) * {0..7});
|
|
g := ORD(BITS(LSR(color, 8)) * {0..7});
|
|
r := ORD(BITS(LSR(color, 16)) * {0..7})
|
|
END getrgb;
|
|
|
|
|
|
PROCEDURE rgb(r, g, b: INTEGER): INTEGER;
|
|
RETURN b + LSL(g, 8) + LSL(r, 16)
|
|
END rgb;
|
|
|
|
|
|
PROCEDURE OutChar (font: FONT; canvas: INTEGER; x, y: INTEGER; c: CHAR; color: INTEGER);
|
|
VAR
|
|
xsize, ysize: INTEGER;
|
|
pix: PIX;
|
|
bkcolor: INTEGER;
|
|
r0, b0, g0, r, g, b: INTEGER;
|
|
ptr: INTEGER;
|
|
BEGIN
|
|
sys.GET(canvas, xsize);
|
|
sys.GET(canvas, ysize);
|
|
INC(canvas, 8);
|
|
getrgb(color, r0, g0, b0);
|
|
|
|
pix := font.chars[ORD(c)].first(PIX);
|
|
WHILE pix # NIL DO
|
|
sys.PUT(canvas + ((pix.y + y) * xsize + (pix.x + x)) * 4, color);
|
|
pix := pix.next(PIX)
|
|
END;
|
|
|
|
pix := font.smooth[ORD(c)].first(PIX);
|
|
WHILE pix # NIL DO
|
|
ptr := canvas + ((pix.y + y) * xsize + (pix.x + x)) * 4;
|
|
sys.GET(ptr, bkcolor);
|
|
getrgb(bkcolor, r, g, b);
|
|
|
|
r := (r * 7 + r0 * 2) DIV 9;
|
|
g := (g * 7 + g0 * 2) DIV 9;
|
|
b := (b * 7 + b0 * 2) DIV 9;
|
|
|
|
sys.PUT(ptr, rgb(r, g, b));
|
|
pix := pix.next(PIX)
|
|
END
|
|
|
|
END OutChar;
|
|
|
|
|
|
PROCEDURE TextHeight* (font: FONT): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
IF font # NIL THEN
|
|
res := font.height
|
|
ELSE
|
|
res := 0
|
|
END
|
|
|
|
RETURN res
|
|
END TextHeight;
|
|
|
|
|
|
|
|
PROCEDURE TextOut* (font: FONT; canvas: INTEGER; x, y: INTEGER; text: INTEGER; length: INTEGER; color: INTEGER; flags: INTEGER);
|
|
VAR
|
|
c: CHAR;
|
|
x1: INTEGER;
|
|
|
|
BEGIN
|
|
IF font # NIL THEN
|
|
x1 := x;
|
|
WHILE length > 0 DO
|
|
sys.GET(text, c);
|
|
INC(text);
|
|
DEC(length);
|
|
OutChar(font, canvas, x, y, c, color);
|
|
IF BITS(bold) * BITS(flags) = BITS(bold) THEN
|
|
INC(x);
|
|
OutChar(font, canvas, x, y, c, color)
|
|
END;
|
|
INC(x, font.width[ORD(c)])
|
|
END;
|
|
IF length = -1 THEN
|
|
sys.GET(text, c);
|
|
INC(text);
|
|
WHILE c # 0X DO
|
|
OutChar(font, canvas, x, y, c, color);
|
|
IF BITS(bold) * BITS(flags) = BITS(bold) THEN
|
|
INC(x);
|
|
OutChar(font, canvas, x, y, c, color)
|
|
END;
|
|
INC(x, font.width[ORD(c)]);
|
|
sys.GET(text, c);
|
|
INC(text)
|
|
END
|
|
END
|
|
END
|
|
END TextOut;
|
|
|
|
|
|
PROCEDURE TextWidth* (font: FONT; text: INTEGER; length: INTEGER; flags: INTEGER): INTEGER;
|
|
VAR
|
|
c: CHAR;
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
res := 0;
|
|
|
|
IF font # NIL THEN
|
|
WHILE length > 0 DO
|
|
sys.GET(text, c);
|
|
INC(text);
|
|
DEC(length);
|
|
IF BITS(bold) * BITS(flags) = BITS(bold) THEN
|
|
INC(res)
|
|
END;
|
|
INC(res, font.width[ORD(c)])
|
|
END;
|
|
IF length = -1 THEN
|
|
sys.GET(text, c);
|
|
INC(text);
|
|
WHILE c # 0X DO
|
|
IF BITS(bold) * BITS(flags) = BITS(bold) THEN
|
|
INC(res)
|
|
END;
|
|
INC(res, font.width[ORD(c)]);
|
|
sys.GET(text, c);
|
|
INC(text)
|
|
END
|
|
END
|
|
END
|
|
|
|
RETURN res
|
|
END TextWidth;
|
|
|
|
|
|
PROCEDURE Enabled*(font: FONT; size: INTEGER): BOOLEAN;
|
|
VAR
|
|
offset, temp: INTEGER;
|
|
|
|
BEGIN
|
|
offset := -1;
|
|
IF (MIN_FONT_SIZE <= size) & (size <= MAX_FONT_SIZE) & (font # NIL) THEN
|
|
temp := font.file.data + (size - 8) * 4;
|
|
IF (font.file.data <= temp) & (temp <= font.file.size + font.file.data - 4) THEN
|
|
sys.GET(temp, offset)
|
|
END
|
|
END
|
|
RETURN offset # -1
|
|
END Enabled;
|
|
|
|
|
|
PROCEDURE LoadFont* (fname: ARRAY OF CHAR): FONT;
|
|
VAR
|
|
font: FONT;
|
|
c: INTEGER;
|
|
ptr: INTEGER;
|
|
|
|
BEGIN
|
|
NEW(font);
|
|
IF font # NIL THEN
|
|
font.file.data := File.Load(fname, font.file.size);
|
|
IF font.file.data # 0 THEN
|
|
ptr := KOSAPI.malloc(font.file.size + 4096);
|
|
IF ptr # 0 THEN
|
|
|
|
sys.MOVE(font.file.data, ptr, font.file.size);
|
|
font.file.data := KOSAPI.sysfunc3(68, 13, font.file.data);
|
|
font.file.data := ptr;
|
|
|
|
font.file.pos := 0;
|
|
COPY(fname, font.file.name);
|
|
|
|
FOR c := 0 TO 255 DO
|
|
font.chars[c] := LISTS.create(NIL);
|
|
font.smooth[c] := LISTS.create(NIL);
|
|
font.width[c] := 0;
|
|
font.height := 0
|
|
END
|
|
|
|
ELSE
|
|
font.file.data := KOSAPI.sysfunc3(68, 13, font.file.data);
|
|
DISPOSE(font)
|
|
END
|
|
|
|
ELSE
|
|
DISPOSE(font)
|
|
END
|
|
END
|
|
|
|
RETURN font
|
|
END LoadFont;
|
|
|
|
|
|
PROCEDURE Destroy* (VAR font: FONT);
|
|
VAR
|
|
c: INTEGER;
|
|
|
|
BEGIN
|
|
IF font # NIL THEN
|
|
FOR c := 0 TO 255 DO
|
|
LISTS.destroy(font.chars[c]);
|
|
LISTS.destroy(font.smooth[c]);
|
|
END;
|
|
IF font.file.data # 0 THEN
|
|
font.file.data := KOSAPI.sysfunc3(68, 13, font.file.data)
|
|
END;
|
|
DISPOSE(font)
|
|
END
|
|
END Destroy;
|
|
|
|
|
|
PROCEDURE SetSize* (VAR font: FONT; size: INTEGER): BOOLEAN;
|
|
VAR
|
|
res: BOOLEAN;
|
|
fname: FNAME;
|
|
|
|
BEGIN
|
|
IF Enabled(font, size) THEN
|
|
fname := font.file.name;
|
|
Destroy(font);
|
|
font := LoadFont(fname);
|
|
process(font, size - 8);
|
|
res := TRUE
|
|
ELSE
|
|
res := FALSE
|
|
END
|
|
RETURN res
|
|
END SetSize;
|
|
|
|
|
|
END kfonts.
|