XenOn/kolibrios-fun
1
1
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Wiki Activity

FB2 Reader: refactoring, reduced memory usage for images, small improvements

Browse Source 
git-svn-id: svn://kolibrios.org@9898 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2023-02-01 13:36:55 +00:00
parent 59315b183d
commit c56f682434
28 changed files with 1057 additions and 1107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/common/fb2read
View File

Binary file not shown.

98
programs/other/fb2reader/SRC/ColorDlg.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2022 Anton Krotov Copyright 2016, 2022, 2023 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by it under the terms of the GNU Lesser General Public License as published by
@ -17,70 +17,74 @@
MODULE ColorDlg; MODULE ColorDlg;
IMPORT sys := SYSTEM, KOSAPI; IMPORT SYSTEM;
TYPE TYPE
DRAW_WINDOW = PROCEDURE; DRAW_WINDOW = PROCEDURE;
TDialog = RECORD TDialog = RECORD
type, type,
procinfo, procinfo,
com_area_name, com_area_name,
com_area, com_area,
start_path: INTEGER; start_path: INTEGER;
draw_window: DRAW_WINDOW; draw_window: DRAW_WINDOW;
status*, status*,
X, Y, X, Y,
color_type, color_type,
color*: INTEGER; color*: INTEGER;
procinf: ARRAY 1024 OF CHAR; procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR s_com_area_name: ARRAY 32 OF CHAR
END; END;
Dialog* = POINTER TO TDialog; Dialog* = POINTER TO TDialog;
PROCEDURE [stdcall, "Proc_lib.obj", ""] ColorDialog_start (cd: Dialog); END; PROCEDURE [stdcall, "Proc_lib.obj", ""] ColorDialog_start (cd: Dialog); END;
PROCEDURE [stdcall, "Proc_lib.obj", ""] ColorDialog_init (cd: Dialog); END; PROCEDURE [stdcall, "Proc_lib.obj", ""] ColorDialog_init (cd: Dialog); END;
PROCEDURE Show*(cd: Dialog);
PROCEDURE Show* (cd: Dialog);
BEGIN BEGIN
IF cd # NIL THEN IF cd # NIL THEN
cd.X := 0; cd.X := 0;
cd.Y := 0; cd.Y := 0;
ColorDialog_start(cd) ColorDialog_start(cd)
END END
END Show; END Show;
PROCEDURE Create*(draw_window: DRAW_WINDOW): Dialog;
VAR res: Dialog; PROCEDURE Create* (draw_window: DRAW_WINDOW): Dialog;
VAR
res: Dialog;
BEGIN BEGIN
NEW(res); NEW(res);
IF res # NIL THEN IF res # NIL THEN
res.s_com_area_name := "FFFFFFFF_color_dlg"; res.s_com_area_name := "FFFFFFFF_color_dlg";
res.com_area := 0; res.com_area := 0;
res.type := 0; res.type := 0;
res.color_type := 0; res.color_type := 0;
res.procinfo := sys.ADR(res.procinf[0]); res.procinfo := SYSTEM.ADR(res.procinf[0]);
res.com_area_name := sys.ADR(res.s_com_area_name[0]); res.com_area_name := SYSTEM.ADR(res.s_com_area_name[0]);
res.start_path := sys.SADR("/sys/colrdial"); res.start_path := SYSTEM.SADR("/sys/colrdial");
res.draw_window := draw_window; res.draw_window := draw_window;
res.status := 0; res.status := 0;
res.X := 0; res.X := 0;
res.Y := 0; res.Y := 0;
res.color := 0; res.color := 0;
ColorDialog_init(res) ColorDialog_init(res)
END END
RETURN res RETURN res
END Create; END Create;
PROCEDURE Destroy*(VAR cd: Dialog);
PROCEDURE Destroy* (VAR cd: Dialog);
BEGIN BEGIN
IF cd # NIL THEN IF cd # NIL THEN
DISPOSE(cd) DISPOSE(cd)
END END
END Destroy; END Destroy;

84
programs/other/fb2reader/SRC/Conv.ob07
View File

@ -1,84 +0,0 @@
(*
Copyright 2016 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 Conv;
IMPORT sys := SYSTEM, Encode;
VAR table: ARRAY 65536 OF CHAR;
PROCEDURE GetUtf8 (str: INTEGER; VAR val, idx: INTEGER);
VAR ch: CHAR;
BEGIN
sys.GET(str + idx, ch); INC(idx);
IF ch < 80X THEN
val := ORD(ch)
ELSIF ch < 0E0X THEN
val := ORD(ch) - 192;
sys.GET(str + idx, ch); INC(idx);
val := val * 64 + ORD(ch) - 128
ELSE
val := ORD(ch) - 224;
sys.GET(str + idx, ch); INC(idx); val := val * 64 + ORD(ch) - 128;
sys.GET(str + idx, ch); INC(idx); val := val * 64 + ORD(ch) - 128
END
END GetUtf8;
PROCEDURE convert*(adr, adr2: INTEGER; len: INTEGER);
VAR val, idx: INTEGER;
BEGIN
idx := 0;
WHILE len > 0 DO
GetUtf8(adr, val, idx);
IF (0 <= val) & (val < LEN(table)) THEN
sys.PUT(adr2, table[val])
ELSE
sys.PUT(adr2, "?")
END;
INC(adr2);
DEC(len)
END
END convert;
PROCEDURE utf8to1251(code: INTEGER): CHAR;
VAR res: CHAR; i: INTEGER;
BEGIN
res := "?";
i := 0;
WHILE i <= 255 DO
IF Encode.W1251[i].code = code THEN
res := CHR(i);
i := 255
END;
INC(i)
END
RETURN res
END utf8to1251;
PROCEDURE main;
VAR i: INTEGER;
BEGIN
FOR i := 0 TO LEN(table) - 1 DO
table[i] := utf8to1251(i)
END
END main;
BEGIN
main
END Conv.

8
programs/other/fb2reader/SRC/Cursor.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016 Anton Krotov Copyright 2016, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -20,12 +20,12 @@
MODULE Cursor; MODULE Cursor;
IMPORT sys := SYSTEM; IMPORT SYSTEM;
PROCEDURE [stdcall] cur; PROCEDURE [stdcall] cur;
BEGIN BEGIN
sys.CODE( SYSTEM.CODE(
000H, 000H, 002H, 000H, 001H, 000H, 020H, 020H, 000H, 000H, 000H, 000H, 002H, 000H, 001H, 000H, 020H, 020H, 000H, 000H,
005H, 000H, 000H, 000H, 0A8H, 00CH, 000H, 000H, 016H, 000H, 005H, 000H, 000H, 000H, 0A8H, 00CH, 000H, 000H, 016H, 000H,
000H, 000H, 028H, 000H, 000H, 000H, 020H, 000H, 000H, 000H, 000H, 000H, 028H, 000H, 000H, 000H, 020H, 000H, 000H, 000H,
@ -357,7 +357,7 @@ END cur;
PROCEDURE GetCursor* (): INTEGER; PROCEDURE GetCursor* (): INTEGER;
RETURN sys.ADR(cur) + 3 RETURN SYSTEM.ADR(cur) + 3
END GetCursor; END GetCursor;

363
programs/other/fb2reader/SRC/DOM.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016-2022 Anton Krotov Copyright 2016-2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -20,7 +20,7 @@
MODULE DOM; MODULE DOM;
IMPORT XML, SU := SysUtils, S := Strings, Font, Window, G := Graph, LibImg, IMPORT XML, SU := SysUtils, S := Strings, Font, Window, G := Graph, LibImg,
RF := ReadFile, File, Write, Read, Ini, K := KOSAPI, sys := SYSTEM, RF := ReadFile, File, Ini, K := KOSAPI, sys := SYSTEM,
V := Vector, Cursor, box_lib, tables, Search; V := Vector, Cursor, box_lib, tables, Search;
@ -54,6 +54,7 @@ TYPE
SUP, SUP,
InterLin*, InterLin*,
Picture*, Picture*,
picture_fsize*,
SpaceW: INTEGER SpaceW: INTEGER
END; END;
@ -73,8 +74,7 @@ VAR
Settings* : TSettings; Settings* : TSettings;
Canvas_X, Canvas_Y: INTEGER; Canvas_X, Canvas_Y: INTEGER;
ColLeft : Window.TRect; ColLeft, ColRight: Window.tRect;
ColRight : Window.TRect;
Ymin, Ymax, Ycur : INTEGER; Ymin, Ymax, Ycur : INTEGER;
@ -428,6 +428,44 @@ BEGIN
END table; END table;
PROCEDURE Image (VAR tag: XML.TAG; destroy: BOOLEAN);
VAR
note : BOOLEAN;
img : XML.TAG;
URL : INTEGER;
chars : S.CHARS;
sizeY : INTEGER;
FName : S.STRING;
path : S.STRING;
BEGIN
LibImg.Destroy(tag.img);
img := XML.GetRef(tag, note, URL);
IF img # NIL THEN
IF img.child.first IS XML.WORD THEN
chars := img.child.first(XML.WORD).value;
tag.img := LibImg.GetImg(chars.first, chars.last - chars.first + 1, W, sizeY)
END
ELSIF URL # 0 THEN
S.PtrToString(URL, FName);
tag.img := LibImg.LoadFromFile(FName, W, sizeY);
IF tag.img = 0 THEN
path := FilePath;
IF FName[0] # "/" THEN
S.Append(path, "/")
END;
S.Append(path, FName);
tag.img := LibImg.LoadFromFile(path, W, sizeY)
END
END;
IF (tag.img # 0) & destroy THEN
INC(Y, (sizeY DIV LineH) * LineH);
NewLine;
tag.Ymax := Y - Y MOD LineH;
LibImg.Destroy(tag.img)
END
END Image;
PROCEDURE layout(body: XML.ELEMENT); PROCEDURE layout(body: XML.ELEMENT);
VAR VAR
cur : XML.ELEMENT; cur : XML.ELEMENT;
@ -441,51 +479,6 @@ VAR
height1 : INTEGER; height1 : INTEGER;
height2 : INTEGER; height2 : INTEGER;
PROCEDURE Image (VAR tag: XML.TAG);
VAR
note : BOOLEAN;
img : XML.TAG;
URL : INTEGER;
chars : S.CHARS;
sizeY : INTEGER;
FName : S.STRING;
path : S.STRING;
BEGIN
IF tag.img # 0 THEN
LibImg.img_destroy(tag.img)
END;
img := XML.GetRef(tag, note, URL);
IF img # NIL THEN
IF img.child.first IS XML.WORD THEN
chars := img.child.first(XML.WORD).value;
tag.img := LibImg.GetImg(chars.first, chars.last - chars.first + 1, W, sizeY);
IF tag.img # 0 THEN
INC(Y, (sizeY DIV LineH) * LineH);
NewLine;
tag.Ymax := Y - Y MOD LineH
END
END
ELSIF URL # 0 THEN
S.PtrToString(URL, FName);
tag.img := LibImg.LoadFromFile(FName, W, sizeY);
IF tag.img = 0 THEN
path := FilePath;
IF FName[0] # "/" THEN
S.Append(path, "/")
END;
S.Append(path, FName);
tag.img := LibImg.LoadFromFile(path, W, sizeY);
END;
IF tag.img # 0 THEN
INC(Y, (sizeY DIV LineH) * LineH);
NewLine;
tag.Ymax := Y - Y MOD LineH
END
END
END Image;
BEGIN BEGIN
cur := body; cur := body;
WHILE cur # NIL DO WHILE cur # NIL DO
@ -610,8 +603,7 @@ BEGIN
DEC(code); DEC(code);
Font.sysfont(code > 0) Font.sysfont(code > 0)
|XML.tag_image: |XML.tag_image:
Image(tag) Image(tag, TRUE)
|XML.tag_table: |XML.tag_table:
Y := tag.Ymin + tables.get_table_height(tag.table); Y := tag.Ymin + tables.get_table_height(tag.table);
tag.Ymax := Y - Y MOD LineH; tag.Ymax := Y - Y MOD LineH;
@ -680,52 +672,52 @@ VAR
y, y0 : INTEGER; y, y0 : INTEGER;
value : INTEGER; value : INTEGER;
PROCEDURE DrawText(Col: Window.TRect; min, max, y0, y: INTEGER; right: BOOLEAN; VAR text: XML.TEXT); PROCEDURE DrawText(Col: Window.tRect; min, max, y0, y: INTEGER; right: BOOLEAN; VAR text: XML.TEXT);
VAR word: XML.WORD; VAR word: XML.WORD;
BEGIN BEGIN
IF (min <= y0) & (y0 <= max) THEN IF (min <= y0) & (y0 <= max) THEN
Font.sysfont(code > 0); Font.sysfont(code > 0);
IF text IS XML.WORD THEN IF text IS XML.WORD THEN
word := text(XML.WORD); word := text(XML.WORD);
Font.Text(Col, word.X, y - Col.Height * ORD(right), word.value.first, word.length); Font.Text(Col, word.X, y - Col.height * ORD(right), word.value.first, word.length);
END; END;
Font.StrikeText(Col, text.X, y - Col.Height * ORD(right), text.width) Font.StrikeText(Col, text.X, y - Col.height * ORD(right), text.width)
END END
END DrawText; END DrawText;
PROCEDURE Image(VAR tag: XML.TAG); PROCEDURE DrawImage(VAR tag: XML.TAG);
VAR sizeX, sizeY, img, y: INTEGER; VAR sizeX, sizeY, img, y: INTEGER;
BEGIN BEGIN
IF tag.img # 0 THEN IF tag.img # 0 THEN
y := Ycur; y := Ycur;
LibImg.GetInf(tag.img, sizeX, sizeY, img); LibImg.GetInf(tag.img, sizeX, sizeY, img);
IF (y <= tag.Ymax) & (tag.Ymin <= y + ColLeft.Height) THEN IF (y <= tag.Ymax) & (tag.Ymin <= y + ColLeft.height) THEN
G.Image(ColLeft.Left + tag.X, tag.Ymin - y + ColLeft.Top, sizeX, sizeY, img, ColLeft.Top, ColLeft.Top + ColLeft.Height - 1) G.Image(ColLeft.left + tag.X, tag.Ymin - y + ColLeft.top, sizeX, sizeY, img, ColLeft.top, ColLeft.top + ColLeft.height - 1)
END; END;
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
y := Ycur + ColLeft.Height; y := Ycur + ColLeft.height;
IF (y <= tag.Ymax) & (tag.Ymin <= y + ColRight.Height) THEN IF (y <= tag.Ymax) & (tag.Ymin <= y + ColRight.height) THEN
G.Image(ColRight.Left + tag.X, tag.Ymin - y + ColLeft.Top, sizeX, sizeY, img, ColRight.Top, ColRight.Top + ColRight.Height - 1) G.Image(ColRight.left + tag.X, tag.Ymin - y + ColLeft.top, sizeX, sizeY, img, ColRight.top, ColRight.top + ColRight.height - 1)
END END
END END
END END
END Image; END DrawImage;
PROCEDURE td(VAR tag: XML.TAG); PROCEDURE td(VAR tag: XML.TAG);
VAR x1, y1, x2, y2, cl: INTEGER; VAR x1, y1, x2, y2, cl: INTEGER;
BEGIN BEGIN
x1 := tag.X + ColLeft.Left; x1 := tag.X + ColLeft.left;
y1 := tag.Ymin - Ycur + ColLeft.Top; y1 := tag.Ymin - Ycur + ColLeft.top;
x2 := x1 + tag.Width; x2 := x1 + tag.Width;
y2 := y1 + tables.get_height(tag.table, tag.cell); y2 := y1 + tables.get_height(tag.table, tag.cell);
cl := G.GetColor(); cl := G.GetColor();
G.SetColor(Settings.Colors[TEXT_COLOR]); G.SetColor(Settings.Colors[TEXT_COLOR]);
G.Rect(x1, y1, x2, y2); G.Rect(x1, y1, x2, y2);
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
x1 := x1 - ColLeft.Left + ColRight.Left; x1 := x1 - ColLeft.left + ColRight.left;
x2 := x2 - ColLeft.Left + ColRight.Left; x2 := x2 - ColLeft.left + ColRight.left;
y1 := y1 - ColLeft.Height; y1 := y1 - ColLeft.height;
y2 := y2 - ColLeft.Height; y2 := y2 - ColLeft.height;
G.Rect(x1, y1, x2, y2) G.Rect(x1, y1, x2, y2)
END; END;
G.SetColor(cl) G.SetColor(cl)
@ -776,7 +768,9 @@ BEGIN
INC(italic); INC(italic);
Font.Italic(TRUE, refer = 0) Font.Italic(TRUE, refer = 0)
|XML.tag_image: |XML.tag_image:
Image(tag) Image(tag, FALSE);
DrawImage(tag);
LibImg.Destroy(tag.img)
|XML.tag_code: |XML.tag_code:
INC(code) INC(code)
ELSE ELSE
@ -816,9 +810,9 @@ BEGIN
text := cur(XML.TEXT); text := cur(XML.TEXT);
y := text.Y - Ycur; y := text.Y - Ycur;
y0 := y - y MOD LineH; y0 := y - y MOD LineH;
DrawText(ColLeft, 0, ColLeft.Height - LineH, y0, y, FALSE, text); DrawText(ColLeft, 0, ColLeft.height - LineH, y0, y, FALSE, text);
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
DrawText(ColRight, ColLeft.Height, ColLeft.Height + ColRight.Height - LineH, y0, y, TRUE, text) DrawText(ColRight, ColLeft.height, ColLeft.height + ColRight.height - LineH, y0, y, TRUE, text)
END END
END; END;
cur := cur.next cur := cur.next
@ -826,12 +820,12 @@ BEGIN
END layout2; END layout2;
PROCEDURE DrawProgress(progress_color: INTEGER); PROCEDURE DrawFrame (color: INTEGER);
VAR max_X, max_Y: INTEGER; VAR max_X, max_Y: INTEGER;
BEGIN BEGIN
max_X := G.Buffer.Width - 1; max_X := G.Buffer.Width - 1;
max_Y := G.Buffer.Height - 1; max_Y := G.Buffer.Height - 1;
G.SetColor(0); G.SetColor(color);
G.HLine(0, max_X, 0); G.HLine(0, max_X, 0);
G.HLine(0, max_X, max_Y); G.HLine(0, max_X, max_Y);
G.VLine(0, 0, max_Y); G.VLine(0, 0, max_Y);
@ -839,16 +833,18 @@ BEGIN
sb.cur_area := 50; sb.cur_area := 50;
sb.position := (Ycur - Ymin) DIV LineH; sb.position := (Ycur - Ymin) DIV LineH;
box_lib.scrollbar_v_draw(sb) box_lib.scrollbar_v_draw(sb)
END DrawProgress; END DrawFrame;
PROCEDURE Draw*; PROCEDURE Draw*;
VAR back, max_X, max_Y: INTEGER; (*VAR max_Y: INTEGER;*)
BEGIN BEGIN
back := Settings.Colors[BACK_COLOR]; (*max_Y := G.Buffer.Height - 1;*)
max_X := G.Buffer.Width - 1; IF Settings.b_pict & (Settings.Picture # 0) THEN
max_Y := G.Buffer.Height - 1; G.Copy(G.BackImg, G.Buffer, 0, G.Buffer.Height, 0)
G.Copy(G.Buffer3, G.Buffer, 0, G.Buffer.Height, 0); ELSE
G.Fill(G.Buffer, Settings.Colors[BACK_COLOR])
END;
Font.SetFontColor(Settings.Colors[TEXT_COLOR]); Font.SetFontColor(Settings.Colors[TEXT_COLOR]);
IF ((body = description) OR (body = contents)) & Settings.TwoCol THEN IF ((body = description) OR (body = contents)) & Settings.TwoCol THEN
Settings.TwoCol := FALSE; Settings.TwoCol := FALSE;
@ -859,9 +855,9 @@ BEGIN
layout2(body.child.first); layout2(body.child.first);
Search.draw(body, ColLeft, ColRight, Ycur, LineH, Settings.TwoCol) Search.draw(body, ColLeft, ColRight, Ycur, LineH, Settings.TwoCol)
END; END;
G.Copy(G.Buffer3, G.Buffer, 0, ColLeft.Top + 1, 0); (*G.Copy(G.BackImg, G.Buffer, 0, ColLeft.top + 1, 0);
G.Copy(G.Buffer3, G.Buffer, max_Y - ColLeft.Top, ColLeft.Top + 1, max_Y - ColLeft.Top); G.Copy(G.BackImg, G.Buffer, max_Y - ColLeft.top, ColLeft.top + 1, max_Y - ColLeft.top);*)
DrawProgress(0); DrawFrame(0);
G.Draw(Canvas_X, Canvas_Y); G.Draw(Canvas_X, Canvas_Y);
DrawToolbar; DrawToolbar;
DrawStatus DrawStatus
@ -932,35 +928,22 @@ BEGIN
END Descr; END Descr;
PROCEDURE Up*; PROCEDURE Scroll* (n: INTEGER);
BEGIN BEGIN
DEC(Ycur, LineH); INC(Ycur, LineH*n);
SU.MinMax(Ycur, Ymin, Ymax) SU.MinMax(Ycur, Ymin, Ymax)
END Up; END Scroll;
PROCEDURE Down*;
BEGIN
INC(Ycur, LineH);
SU.MinMax(Ycur, Ymin, Ymax)
END Down;
PROCEDURE PageUp*; PROCEDURE PageUp*;
VAR i: INTEGER;
BEGIN BEGIN
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO Scroll(-Lines * (ORD(Settings.TwoCol) + 1))
Up
END
END PageUp; END PageUp;
PROCEDURE PageDown*; PROCEDURE PageDown*;
VAR i: INTEGER;
BEGIN BEGIN
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO Scroll(Lines * (ORD(Settings.TwoCol) + 1))
Down
END
END PageDown; END PageDown;
@ -1046,12 +1029,79 @@ BEGIN
END layout3; END layout3;
PROCEDURE getRefProp (VAR ref, body: XML.TAG; VAR URL: INTEGER; VAR note: BOOLEAN; VAR Y: INTEGER);
BEGIN
note := FALSE;
URL := 0;
Y := 0;
IF ref.value = XML.tag_a THEN
ref := XML.GetRef(ref, note, URL)
ELSE
ref := ref.parent(XML.TAG)
END;
IF ref # NIL THEN
Y := ref.Ymin;
END;
IF note THEN
body := ref
ELSE
body := GetBody(ref)
END
END getRefProp;
PROCEDURE zstreq (s1, s2: INTEGER): BOOLEAN;
VAR
c1, c2: CHAR;
BEGIN
REPEAT
sys.GET(s1, c1); INC(s1);
sys.GET(s2, c2); INC(s2);
UNTIL (c1 = 0X) OR (c2 = 0X)
RETURN c1 = c2
END zstreq;
PROCEDURE refeq (ref1, ref2: XML.TAG): BOOLEAN;
VAR
body1, body2: XML.TAG;
URL1, URL2: INTEGER;
note1, note2: BOOLEAN;
Y1, Y2: INTEGER;
BEGIN
getRefProp(ref1, body1, URL1, note1, Y1);
getRefProp(ref2, body2, URL2, note2, Y2);
RETURN (ref1 = ref2) & (body1 = body2) & (URL1 = 0) & (URL2 = 0) & (note1 = note2) & (Y1 = Y2) OR
(URL1 # 0) & (URL2 # 0) & zstreq(URL1, URL2)
END refeq;
PROCEDURE setVisited (ref: XML.TAG);
VAR
i: INTEGER;
cur: V.ANYPTR;
BEGIN
FOR i := 0 TO references.count - 1 DO
cur := V.get(references, i);
IF cur IS XML.TEXT THEN
cur := cur(XML.TEXT).parent;
IF refeq(cur(XML.TAG), ref) THEN
cur(XML.TAG).Visited := TRUE
END
END
END
END setVisited;
PROCEDURE MouseDown; PROCEDURE MouseDown;
BEGIN BEGIN
IF ~mouseDown THEN IF ~mouseDown THEN
mouseDown := TRUE; mouseDown := TRUE;
clickRef := ref; clickRef := ref;
ref.Clicked := TRUE; IF ref # NIL THEN
ref.Clicked := TRUE
END;
Draw Draw
END END
END MouseDown; END MouseDown;
@ -1088,17 +1138,18 @@ BEGIN
Ymin := body.Ymin; Ymin := body.Ymin;
IF ~clickRef.Visited THEN IF ~clickRef.Visited THEN
setVisited(clickRef);
clickRef.Visited := TRUE; clickRef.Visited := TRUE;
PushRef(clickRef) PushRef(clickRef)
END END
ELSIF URL # 0 THEN ELSIF URL # 0 THEN
SU.Run(Ini.Browser, URL); SU.Run(Ini.Browser, URL);
IF ~clickRef.Visited THEN IF ~clickRef.Visited THEN
setVisited(clickRef);
clickRef.Visited := TRUE; clickRef.Visited := TRUE;
PushRef(clickRef) PushRef(clickRef)
END END
END; END
END; END;
IF clickRef # NIL THEN IF clickRef # NIL THEN
clickRef.Clicked := FALSE; clickRef.Clicked := FALSE;
@ -1129,7 +1180,7 @@ BEGIN
ref := NIL; ref := NIL;
layout3(body, X, Y); layout3(body, X, Y);
IF (ref = NIL) & Settings.TwoCol THEN IF (ref = NIL) & Settings.TwoCol THEN
layout3(body, X - ColLeft.Width - Settings.PADDING.ColInter, Y + Lines * LineH); layout3(body, X - ColLeft.width - Settings.PADDING.ColInter, Y + Lines * LineH);
END; END;
hoverRef := ref; hoverRef := ref;
IF clicked THEN IF clicked THEN
@ -1165,19 +1216,6 @@ BEGIN
END Click; END Click;
PROCEDURE Scroll*(value: INTEGER);
BEGIN
value := 2 * value;
WHILE value > 0 DO
Down;
DEC(value)
ELSIF value < 0 DO
Up;
INC(value)
END
END Scroll;
PROCEDURE main(fb: XML.ELEMENT; Contents: BOOLEAN); PROCEDURE main(fb: XML.ELEMENT; Contents: BOOLEAN);
VAR VAR
cur: XML.ELEMENT; cur: XML.ELEMENT;
@ -1283,14 +1321,13 @@ BEGIN
IF y >= 0 THEN IF y >= 0 THEN
DEC(y, y MOD LineH); DEC(y, y MOD LineH);
min := Ycur; min := Ycur;
max := min + ColLeft.height - LineH;
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
max := min + ColLeft.Height + ColRight.Height - LineH INC(max, ColRight.height)
ELSE
max := min + ColLeft.Height - LineH
END; END;
IF (y < min) OR (y > max) THEN IF (y < min) OR (y > max) THEN
Ycur := MAX(y - ColLeft.Height DIV 2, 0) Ycur := MAX(y - ColLeft.height DIV 2, 0)
END; END;
DEC(Ycur, Ycur MOD LineH) DEC(Ycur, Ycur MOD LineH)
@ -1330,24 +1367,24 @@ BEGIN
Settings.PADDING.ColInter := G.Buffer.Width * Settings.PADDING.CInt DIV 100; Settings.PADDING.ColInter := G.Buffer.Width * Settings.PADDING.CInt DIV 100;
LineH := Font.FontH() + Settings.SUP + Settings.SUB + Settings.InterLin; LineH := Font.FontH() + Settings.SUP + Settings.SUB + Settings.InterLin;
Window.InitRect( Window.initRect(
ColLeft, Settings.PADDING.Left, Settings.PADDING.Top, ColLeft, Settings.PADDING.Left, Settings.PADDING.Top,
G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right, G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right,
G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom); G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom);
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
ColLeft.Width := (ColLeft.Width - Settings.PADDING.ColInter) DIV 2; ColLeft.width := (ColLeft.width - Settings.PADDING.ColInter) DIV 2;
ColRight := ColLeft; ColRight := ColLeft;
ColRight.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter ColRight.left := ColLeft.left + ColLeft.width + Settings.PADDING.ColInter
END; END;
W := ColLeft.Width; W := ColLeft.width;
Lines := ColLeft.Height DIV LineH; Lines := ColLeft.height DIV LineH;
ColLeft.Height := Lines * LineH; ColLeft.height := Lines * LineH;
ColRight.Height := ColLeft.Height; ColRight.height := ColLeft.height;
END FontSizeChange; END FontSizeChange;
PROCEDURE Resize*(Width, Height: INTEGER); PROCEDURE Resize*(Width, Height: INTEGER);
VAR d: REAL; resize: BOOLEAN; sizeX, sizeY, data: INTEGER; VAR d: REAL; resize: BOOLEAN; sizeX, sizeY, data, back_picture: INTEGER;
PROCEDURE stk1(stk: XML.LIST); PROCEDURE stk1(stk: XML.LIST);
VAR cur: StackItem; VAR cur: StackItem;
@ -1374,13 +1411,18 @@ VAR d: REAL; resize: BOOLEAN; sizeX, sizeY, data: INTEGER;
BEGIN BEGIN
resize := (Width # G.Buffer.Width) OR resized; resize := (Width # G.Buffer.Width) OR resized;
G.Resize(Width, Height); G.Resize(Width, Height);
G.SetColor(Settings.Colors[BACK_COLOR]);
IF (Settings.Picture # 0) & Settings.b_pict THEN IF (Settings.Picture # 0) & Settings.b_pict THEN
LibImg.GetInf(Settings.Picture, sizeX, sizeY, data); back_picture := LibImg.GetImg(Settings.Picture, Settings.picture_fsize, 1000000, sizeY);
G.BackImage(sizeX, sizeY, data); IF back_picture # 0 THEN
LibImg.GetInf(back_picture, sizeX, sizeY, data);
G.CreateBackImg;
G.BackImage(sizeX, sizeY, data);
LibImg.Destroy(back_picture)
END
ELSE ELSE
G.Clear; G.DestroyBackImg;
G.Copy(G.Buffer, G.Buffer3, 0, G.Buffer.Height, 0) G.Fill(G.Buffer, Settings.Colors[BACK_COLOR]);
//G.Fill(G.BackImg, Settings.Colors[BACK_COLOR])
END; END;
IF Font.FontH() # 0 THEN IF Font.FontH() # 0 THEN
@ -1389,16 +1431,16 @@ BEGIN
FontSizeChange(Settings.FontSize); FontSizeChange(Settings.FontSize);
END; END;
ColLeft.Width := G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right; ColLeft.width := G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right;
IF Settings.TwoCol THEN IF Settings.TwoCol THEN
ColLeft.Width := (ColLeft.Width - Settings.PADDING.ColInter) DIV 2; ColLeft.width := (ColLeft.width - Settings.PADDING.ColInter) DIV 2;
ColRight.Width := ColLeft.Width; ColRight.width := ColLeft.width;
ColRight.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter ColRight.left := ColLeft.left + ColLeft.width + Settings.PADDING.ColInter
END; END;
ColLeft.Height := G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom; ColLeft.height := G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom;
Lines := ColLeft.Height DIV LineH; Lines := ColLeft.height DIV LineH;
ColLeft.Height := Lines * LineH; ColLeft.height := Lines * LineH;
ColRight.Height := ColLeft.Height; ColRight.height := ColLeft.height;
IF done & resize THEN IF done & resize THEN
resized := FALSE; resized := FALSE;
@ -1408,8 +1450,8 @@ BEGIN
IF contents # NIL THEN IF contents # NIL THEN
d := FLT(Ycont) / FLT(contents.Ymax) d := FLT(Ycont) / FLT(contents.Ymax)
END; END;
W := ColLeft.Width; W := ColLeft.width;
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter; W2 := ColLeft.width + ColRight.width + Settings.PADDING.ColInter;
W1 := W; W1 := W;
main(XML.FB, FALSE); main(XML.FB, FALSE);
Search.resize; Search.resize;
@ -1505,7 +1547,7 @@ VAR history: File.FS; win_size_x, win_size_y, size, pos: INTEGER;
PROCEDURE WriteInt(history: File.FS; x: INTEGER); PROCEDURE WriteInt(history: File.FS; x: INTEGER);
BEGIN BEGIN
IF Write.Int(history, x) THEN END IF File.WriteInt(history, x) THEN END
END WriteInt; END WriteInt;
PROCEDURE WriteStk(history: File.FS; VAR stk: XML.LIST; links: BOOLEAN); PROCEDURE WriteStk(history: File.FS; VAR stk: XML.LIST; links: BOOLEAN);
@ -1533,7 +1575,7 @@ BEGIN
END; END;
size := 1 + 18*4 + 1 + 8*(XML.ListCount(b_stk) + XML.ListCount(f_stk)) + 4*XML.ListCount(vis_ref) + 12; size := 1 + 18*4 + 1 + 8*(XML.ListCount(b_stk) + XML.ListCount(f_stk)) + 4*XML.ListCount(vis_ref) + 12;
WriteInt(history, size); WriteInt(history, size);
IF Write.Char(history, 0X) THEN END; IF File.WriteChar(history, 0X) THEN END;
WriteInt(history, fsize2); WriteInt(history, fsize2);
WriteInt(history, chksum); WriteInt(history, chksum);
SU.GetWindowSize(win_size_x, win_size_y); SU.GetWindowSize(win_size_x, win_size_y);
@ -1546,7 +1588,7 @@ BEGIN
WriteInt(history, Settings.EPIGRAPH); WriteInt(history, Settings.EPIGRAPH);
WriteInt(history, Settings.InterLin); WriteInt(history, Settings.InterLin);
IF Write.Boolean(history, Settings.TwoCol) THEN END; IF File.WriteBool(history, Settings.TwoCol) THEN END;
WriteInt(history, Settings.FontSize); WriteInt(history, Settings.FontSize);
WriteInt(history, body.num); WriteInt(history, body.num);
@ -1568,7 +1610,7 @@ END Save;
PROCEDURE ReadInt(VAR x: INTEGER); PROCEDURE ReadInt(VAR x: INTEGER);
BEGIN BEGIN
IF Read.Int(history, x) THEN END IF File.ReadInt(history, x) THEN END
END ReadInt; END ReadInt;
@ -1598,8 +1640,9 @@ VAR body_num, ycur, size, pos: INTEGER;
ReadInt(num); ReadInt(num);
ref := XML.GetTagByNum(num); ref := XML.GetTagByNum(num);
IF ref # NIL THEN IF ref # NIL THEN
PushRef(ref); setVisited(ref);
ref.Visited := TRUE ref.Visited := TRUE;
PushRef(ref)
END; END;
DEC(n) DEC(n)
END END
@ -1612,7 +1655,7 @@ BEGIN
ReadInt(Settings.PARAGRAPH); ReadInt(Settings.PARAGRAPH);
ReadInt(Settings.EPIGRAPH); ReadInt(Settings.EPIGRAPH);
ReadInt(Settings.InterLin); ReadInt(Settings.InterLin);
IF Read.Boolean(history, Settings.TwoCol) THEN END; IF File.ReadBool(history, Settings.TwoCol) THEN END;
ReadInt(Settings.FontSize); ReadInt(Settings.FontSize);
SetSettings(Settings); SetSettings(Settings);
@ -1630,7 +1673,7 @@ BEGIN
ReadInt(size); ReadInt(size);
pos := File.Seek(history, -size, 1); pos := File.Seek(history, -size, 1);
pos := File.Seek(history, 4, 1); pos := File.Seek(history, 4, 1);
IF Write.Char(history, 1X) THEN END; IF File.WriteChar(history, 1X) THEN END;
Ycur := ycur; Ycur := ycur;
body := XML.GetTagByNum(body_num); body := XML.GetTagByNum(body_num);
@ -1648,15 +1691,15 @@ BEGIN
pos := File.Seek(history, -4, 2); pos := File.Seek(history, -4, 2);
last := FALSE; last := FALSE;
WHILE pos >= 0 DO WHILE pos >= 0 DO
IF Read.Int(history, size) THEN IF File.ReadInt(history, size) THEN
pos := File.Seek(history, -size + 4, 1); pos := File.Seek(history, -size + 4, 1);
END; END;
IF Read.Char(history, c) THEN END; IF File.ReadChar(history, c) THEN END;
ReadInt(fsize); ReadInt(fsize);
ReadInt(_chksum); ReadInt(_chksum);
IF (c = 0X) & (fsize = fsize2) & (_chksum = chksum) THEN IF (c = 0X) & (fsize = fsize2) & (_chksum = chksum) THEN
found := TRUE; found := TRUE;
IF Read.Int(history, x) & Read.Int(history, y) THEN IF File.ReadInt(history, x) & File.ReadInt(history, y) THEN
win_size_x := x; win_size_x := x;
win_size_y := y; win_size_y := y;
ELSE ELSE
@ -1674,7 +1717,7 @@ BEGIN
ReadInt(Settings.PARAGRAPH); ReadInt(Settings.PARAGRAPH);
ReadInt(Settings.EPIGRAPH); ReadInt(Settings.EPIGRAPH);
ReadInt(Settings.InterLin); ReadInt(Settings.InterLin);
IF Read.Boolean(history, Settings.TwoCol) THEN END; IF File.ReadBool(history, Settings.TwoCol) THEN END;
ReadInt(Settings.FontSize); ReadInt(Settings.FontSize);
END; END;
pos := File.Seek(history, pos - 8, 0) pos := File.Seek(history, pos - 8, 0)
@ -1699,11 +1742,11 @@ BEGIN
FilePath := FName; FilePath := FName;
FileName := FName; FileName := FName;
S.GetPath(FilePath); S.GetPath(FilePath);
W := ColLeft.Width; W := ColLeft.width;
W1 := W; W1 := W;
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter; W2 := ColLeft.width + ColRight.width + Settings.PADDING.ColInter;
Lines := ColLeft.Height DIV LineH; Lines := ColLeft.height DIV LineH;
ColLeft.Height := Lines * LineH; ColLeft.height := Lines * LineH;
PID := SU.NewThread(Start, Stack); PID := SU.NewThread(Start, Stack);
WHILE ~SU.IsTerminated(PID) DO WHILE ~SU.IsTerminated(PID) DO
event := SU.CheckEvent(); event := SU.CheckEvent();

266
programs/other/fb2reader/SRC/Encoding.ob07 Normal file
View File

@ -0,0 +1,266 @@
(*
Copyright 2016, 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 Encoding;
IMPORT SYSTEM;
CONST
TABLE_SIZE = 65536;
TYPE
tUtf8* = ARRAY 4 OF CHAR;
tCodePage* = ARRAY 256 OF RECORD code*, len*: INTEGER; utf8*: tUtf8 END;
VAR
cp1250*, cp1251*, cp1252*, cp866*: tCodePage;
table1251: ARRAY TABLE_SIZE OF BYTE;
PROCEDURE getUtf8Char* (VAR ptr, size: INTEGER): INTEGER;
VAR
c: BYTE;
n, k, code: INTEGER;
end: BOOLEAN;
BEGIN
code := 0;
end := FALSE;
REPEAT
SYSTEM.GET(ptr, c);
INC(ptr);
DEC(size);
CASE c OF
| 0..127:
code := c;
end := TRUE
|128..191:
code := code * 64 + c MOD 64;
DEC(n);
end := n <= 0
|192..255:
k := LSL(c, 24);
n := -2;
REPEAT
k := ROR(k, -1);
INC(n)
UNTIL k MOD 2 = 0;
k := LSL(c, n + 25);
code := LSR(k, n + 25)
END
UNTIL (size = 0) OR end
RETURN code
END getUtf8Char;
PROCEDURE convert1251* (src, dst: INTEGER; len: INTEGER);
VAR
val, size: INTEGER;
BEGIN
WHILE len > 0 DO
size := 0;
val := getUtf8Char(src, size);
IF (0 <= val) & (val < TABLE_SIZE) THEN
SYSTEM.PUT8(dst, table1251[val])
ELSE
SYSTEM.PUT8(dst, ORD("?"))
END;
INC(dst);
DEC(len)
END
END convert1251;
PROCEDURE utf8* (code: INTEGER; VAR utf8char: tUtf8);
BEGIN
utf8char[0] := 0X;
IF code < 80H THEN
utf8char[0] := CHR(code);
utf8char[1] := 0X
ELSIF code < 800H THEN
utf8char[1] := CHR(code MOD 64 + 80H);
utf8char[0] := CHR(code DIV 64 + 0C0H);
utf8char[2] := 0X
ELSIF code < 10000H THEN
utf8char[2] := CHR(code MOD 64 + 80H);
code := code DIV 64;
utf8char[1] := CHR(code MOD 64 + 80H);
utf8char[0] := CHR(code DIV 64 + 0E0H);
utf8char[3] := 0X
(*
ELSIF code < 200000H THEN
ELSIF code < 4000000H THEN
ELSE *)
END
END utf8;
PROCEDURE ucs2to1251 (code: INTEGER): BYTE;
VAR
i: INTEGER;
BEGIN
i := 255;
WHILE (i >= 0) & (cp1251[i].code # code) DO
DEC(i)
END;
IF i < 0 THEN
i := ORD("?")
END
RETURN i
END ucs2to1251;
PROCEDURE initCP (VAR cp: tCodePage);
VAR
i: INTEGER;
BEGIN
FOR i := 0H TO 7FH DO
cp[i].code := i
END;
FOR i := 0H TO 0FFH DO
utf8(cp[i].code, cp[i].utf8);
cp[i].len := LENGTH(cp[i].utf8)
END
END initCP;
PROCEDURE init8 (VAR cp: tCodePage; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER);
BEGIN
cp[n].code := a; INC(n);
cp[n].code := b; INC(n);
cp[n].code := c; INC(n);
cp[n].code := d; INC(n);
cp[n].code := e; INC(n);
cp[n].code := f; INC(n);
cp[n].code := g; INC(n);
cp[n].code := h; INC(n);
END init8;
PROCEDURE init1250 (VAR cp: tCodePage);
VAR
n: INTEGER;
BEGIN
n := 80H;
init8(cp, n, 20ACH, 20H, 201AH, 20H, 201EH, 2026H, 2020H, 2021H);
init8(cp, n, 20H, 2030H, 0160H, 2039H, 015AH, 0164H, 017DH, 0179H);
init8(cp, n, 20H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
init8(cp, n, 20H, 2122H, 0161H, 203AH, 015BH, 0165H, 017EH, 017AH);
init8(cp, n, 00A0H, 02C7H, 02D8H, 0141H, 00A4H, 0104H, 00A6H, 00A7H);
init8(cp, n, 00A8H, 00A9H, 015EH, 00ABH, 00ACH, 00ADH, 00AEH, 017BH);
init8(cp, n, 00B0H, 00B1H, 02DBH, 0142H, 00B4H, 00B5H, 00B6H, 00B7H);
init8(cp, n, 00B8H, 0105H, 015FH, 00BBH, 013DH, 02DDH, 013EH, 017CH);
init8(cp, n, 0154H, 00C1H, 00C2H, 0102H, 00C4H, 0139H, 0106H, 00C7H);
init8(cp, n, 010CH, 00C9H, 0118H, 00CBH, 011AH, 00CDH, 00CEH, 010EH);
init8(cp, n, 0110H, 0143H, 0147H, 00D3H, 00D4H, 0150H, 00D6H, 00D7H);
init8(cp, n, 0158H, 016EH, 00DAH, 0170H, 00DCH, 00DDH, 0162H, 00DFH);
init8(cp, n, 0155H, 00E1H, 00E2H, 0103H, 00E4H, 013AH, 0107H, 00E7H);
init8(cp, n, 010DH, 00E9H, 0119H, 00EBH, 011BH, 00EDH, 00EEH, 010FH);
init8(cp, n, 0111H, 0144H, 0148H, 00F3H, 00F4H, 0151H, 00F6H, 00F7H);
init8(cp, n, 0159H, 016FH, 00FAH, 0171H, 00FCH, 00FDH, 0163H, 02D9H);
initCP(cp)
END init1250;
PROCEDURE init1251 (VAR cp: tCodePage);
VAR
n, i: INTEGER;
BEGIN
n := 80H;
init8(cp, n, 0402H, 0403H, 201AH, 0453H, 201EH, 2026H, 2020H, 2021H);
init8(cp, n, 20ACH, 2030H, 0409H, 2039H, 040AH, 040CH, 040BH, 040FH);
init8(cp, n, 0452H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
init8(cp, n, 20H, 2122H, 0459H, 203AH, 045AH, 045CH, 045BH, 045FH);
init8(cp, n, 00A0H, 040EH, 045EH, 0408H, 00A4H, 0490H, 00A6H, 00A7H);
init8(cp, n, 0401H, 00A9H, 0404H, 00ABH, 00ACH, 00ADH, 00AEH, 0407H);
init8(cp, n, 00B0H, 00B1H, 0406H, 0456H, 0491H, 00B5H, 00B6H, 00B7H);
init8(cp, n, 0451H, 2116H, 0454H, 00BBH, 0458H, 0405H, 0455H, 0457H);
FOR i := 0410H TO 044FH DO
cp[i - 350H].code := i
END;
initCP(cp)
END init1251;
PROCEDURE init1252 (VAR cp: tCodePage);
VAR
n, i: INTEGER;
BEGIN
n := 80H;
init8(cp, n, 20ACH, 20H, 201AH, 0192H, 201EH, 2026H, 2020H, 2021H);
init8(cp, n, 02C6H, 2030H, 0160H, 2039H, 0152H, 20H, 017DH, 20H);
init8(cp, n, 20H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
init8(cp, n, 02DCH, 2122H, 0161H, 203AH, 0153H, 20H, 017EH, 0178H);
FOR i := 0A0H TO 0FFH DO
cp[i].code := i
END;
initCP(cp)
END init1252;
PROCEDURE init866 (VAR cp: tCodePage);
VAR
n, i: INTEGER;
BEGIN
FOR i := 0410H TO 043FH DO
cp[i - 0410H + 80H].code := i
END;
FOR i := 0440H TO 044FH DO
cp[i - 0440H + 0E0H].code := i
END;
n := 0B0H;
init8(cp, n, 2591H, 2592H, 2593H, 2502H, 2524H, 2561H, 2562H, 2556H);
init8(cp, n, 2555H, 2563H, 2551H, 2557H, 255DH, 255CH, 255BH, 2510H);
init8(cp, n, 2514H, 2534H, 252CH, 251CH, 2500H, 253CH, 255EH, 255FH);
init8(cp, n, 255AH, 2554H, 2569H, 2566H, 2560H, 2550H, 256CH, 2567H);
init8(cp, n, 2568H, 2564H, 2565H, 2559H, 2558H, 2552H, 2553H, 256BH);
init8(cp, n, 256AH, 2518H, 250CH, 2588H, 2584H, 258CH, 2590H, 2580H);
n := 0F0H;
init8(cp, n, 0401H, 0451H, 0404H, 0454H, 0407H, 0457H, 040EH, 045EH);
init8(cp, n, 00B0H, 2219H, 00B7H, 221AH, 2116H, 00A4H, 25A0H, 00A0H);
initCP(cp)
END init866;
PROCEDURE init;
VAR
i: INTEGER;
BEGIN
init1250(cp1250);
init1251(cp1251);
init1252(cp1252);
init866(cp866);
FOR i := 0 TO TABLE_SIZE - 1 DO
table1251[i] := ucs2to1251(i)
END
END init;
BEGIN
init
END Encoding.

131
programs/other/fb2reader/SRC/FB2READ.ob07
View File

@ -35,16 +35,16 @@ CONST
SETTINGS = 20; SETTINGS = 20;
SEARCH = 21; SEARCH = 21;
KEY_DOWN_CODE = 177; KEY_DOWN = 80;
KEY_UP_CODE = 178; KEY_UP = 72;
KEY_PG_DOWN_CODE = 183; KEY_PG_DOWN = 81;
KEY_PG_UP_CODE = 184; KEY_PG_UP = 73;
KEY_HOME_CODE = 180; KEY_HOME = 71;
KEY_END_CODE = 181; KEY_END = 79;
KEY_F2_CODE = 51; KEY_F2 = 60;
KEY_F3_CODE = 52; KEY_F3 = 61;
KEY_F4_CODE = 53; KEY_F4 = 62;
KEY_F10_CODE = 49; KEY_F10 = 68;
TOOLBAR_LEFT = 5; TOOLBAR_LEFT = 5;
TOOLBAR_TOP = 6; TOOLBAR_TOP = 6;
@ -60,7 +60,7 @@ CONST
VAR VAR
Window : W.TWindow; Window : W.tWindow;
toolbar : Toolbar.tToolbar; toolbar : Toolbar.tToolbar;
SkinHeight : INTEGER; SkinHeight : INTEGER;
Open : OpenDlg.Dialog; Open : OpenDlg.Dialog;
@ -90,15 +90,15 @@ END ToolBar;
PROCEDURE Resize; PROCEDURE Resize;
VAR Width, Height: INTEGER; VAR Width, Height: INTEGER;
BEGIN BEGIN
SU.GetWindowPos(Window.Left, Window.Top); SU.GetWindowPos(Window.left, Window.top);
SU.GetWindowSize(Width, Height); SU.GetWindowSize(Width, Height);
IF (Window.Width # Width) OR (Window.Height # Height) OR (SkinHeight # SU.SkinHeight()) THEN IF (Window.width # Width) OR (Window.height # Height) OR (SkinHeight # SU.SkinHeight()) THEN
SU.MinMax(Width, 640, 65535); SU.MinMax(Width, 640, 65535);
SU.MinMax(Height, 400, 65535); SU.MinMax(Height, 400, 65535);
Window.dWidth := Width - Window.Width; Window.dWidth := Width - Window.width;
Window.dHeight := Height - Window.Height; Window.dHeight := Height - Window.height;
Window.Width := Width; Window.width := Width;
Window.Height := Height; Window.height := Height;
SU.SetWindowSize(Width, Height); SU.SetWindowSize(Width, Height);
DOM.Resize(G.Buffer.Width + Window.dWidth, G.Buffer.Height + Window.dHeight + (SkinHeight - SU.SkinHeight())); DOM.Resize(G.Buffer.Width + Window.dWidth, G.Buffer.Height + Window.dHeight + (SkinHeight - SU.SkinHeight()));
SkinHeight := SU.SkinHeight() SkinHeight := SU.SkinHeight()
@ -108,12 +108,12 @@ END Resize;
PROCEDURE DrawStatus; PROCEDURE DrawStatus;
BEGIN BEGIN
SU.DrawRect(0, Window.Height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1, Window.Width - 2 * WINDOW_BEVEL - 1, STATUSBAR_HEIGHT, SU.winColor); SU.DrawRect(0, Window.height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1, Window.width - 2 * WINDOW_BEVEL - 1, STATUSBAR_HEIGHT, SU.winColor);
IF DOM.urlstr # "" THEN IF DOM.urlstr # "" THEN
SU.OutText(CANVAS_LEFT, Window.Height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 2, DOM.urlstr, SU.OutText(CANVAS_LEFT, Window.height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 2, DOM.urlstr,
MIN(LENGTH(DOM.urlstr), (Window.Width - 2 * WINDOW_BEVEL - 1 - CANVAS_LEFT * 2) DIV 8), SU.textColor) MIN(LENGTH(DOM.urlstr), (Window.width - 2 * WINDOW_BEVEL - 1 - CANVAS_LEFT * 2) DIV 8), SU.textColor)
ELSIF DOM.found() THEN ELSIF DOM.found() THEN
SU.OutText(CANVAS_LEFT, Window.Height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 2, SU.OutText(CANVAS_LEFT, Window.height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 2,
"F2 - first | F3 - next | F4 - prev. | F10 - exit", 48, SU.textColor) "F2 - first | F3 - next | F4 - prev. | F10 - exit", 48, SU.textColor)
END END
END DrawStatus; END DrawStatus;
@ -123,17 +123,17 @@ PROCEDURE DrawWindow;
BEGIN BEGIN
SU.GetSystemColors; SU.GetSystemColors;
SU.WindowRedrawStatus(1); SU.WindowRedrawStatus(1);
IF Window.Created THEN IF Window.created THEN
Resize Resize
ELSE ELSE
Window.Created := TRUE Window.created := TRUE
END; END;
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1, 2}), 4) + 4 - ORD(DOM.loaded), Window.Caption); SU.winColor, LSL(ORD({0, 1, 2}), 4) + 4 - ORD(DOM.loaded), Window.caption);
SU.DrawRect(0, 0, Window.Width - 2 * WINDOW_BEVEL - 1, CANVAS_TOP, SU.winColor); SU.DrawRect(0, 0, Window.width - 2 * WINDOW_BEVEL - 1, CANVAS_TOP, SU.winColor);
SU.DrawRect(0, Window.Height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1, Window.Width - 2 * WINDOW_BEVEL - 1, STATUSBAR_HEIGHT, SU.winColor); SU.DrawRect(0, Window.height - SkinHeight - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1, Window.width - 2 * WINDOW_BEVEL - 1, STATUSBAR_HEIGHT, SU.winColor);
SU.DrawRect(0, 0, CANVAS_LEFT, Window.Height - SkinHeight - WINDOW_BEVEL, SU.winColor); SU.DrawRect(0, 0, CANVAS_LEFT, Window.height - SkinHeight - WINDOW_BEVEL, SU.winColor);
SU.DrawRect(Window.Width - 2 * WINDOW_BEVEL - CANVAS_LEFT - 1 - SCROLLBAR_WIDTH - 2, 0, CANVAS_LEFT + SCROLLBAR_WIDTH + 2, Window.Height - SkinHeight - WINDOW_BEVEL, SU.winColor); SU.DrawRect(Window.width - 2 * WINDOW_BEVEL - CANVAS_LEFT - 1 - SCROLLBAR_WIDTH - 2, 0, CANVAS_LEFT + SCROLLBAR_WIDTH + 2, Window.height - SkinHeight - WINDOW_BEVEL, SU.winColor);
IF DOM.loaded THEN IF DOM.loaded THEN
ToolBar; ToolBar;
DOM.Draw; DOM.Draw;
@ -145,8 +145,8 @@ END DrawWindow;
PROCEDURE ConvMousePos(VAR X, Y: INTEGER); PROCEDURE ConvMousePos(VAR X, Y: INTEGER);
BEGIN BEGIN
X := X - Window.Left - WINDOW_BEVEL - 1; X := X - Window.left - WINDOW_BEVEL - 1;
Y := Y - Window.Top - SkinHeight Y := Y - Window.top - SkinHeight
END ConvMousePos; END ConvMousePos;
@ -177,22 +177,28 @@ END ButtonClick;
PROCEDURE KeyDown; PROCEDURE KeyDown;
VAR
key: INTEGER;
shift, ctrl: BOOLEAN;
BEGIN BEGIN
CASE SU.GetKeyCode() OF SU.getKBState(shift, ctrl);
|KEY_DOWN_CODE : DOM.Down key := SU.GetKey() DIV 65536;
|KEY_UP_CODE : DOM.Up CASE key OF
|KEY_PG_DOWN_CODE : DOM.PageDown |KEY_DOWN : DOM.Scroll(1)
|KEY_PG_UP_CODE : DOM.PageUp |KEY_UP : DOM.Scroll(-1)
|KEY_HOME_CODE : DOM.Home |KEY_PG_DOWN : DOM.PageDown
|KEY_END_CODE : DOM.End |KEY_PG_UP : DOM.PageUp
|KEY_F2_CODE : DOM.Find(0) |KEY_HOME : DOM.Home
|KEY_F3_CODE : DOM.Find(1) |KEY_END : DOM.End
|KEY_F4_CODE : DOM.Find(-1) |KEY_F2 : DOM.Find(0)
|KEY_F10_CODE : DOM.CloseSearch |KEY_F3 : DOM.Find(1)
ELSE |KEY_F4 : DOM.Find(-1)
END; |KEY_F10 : DOM.CloseSearch
DOM.Draw; |33 : IF ctrl THEN DOM.OpenSearch END (* ctrl-F *)
DrawStatus ELSE
END;
DOM.Draw;
DrawStatus
END KeyDown; END KeyDown;
@ -204,13 +210,10 @@ END CanvasIsClicked;
PROCEDURE MouseEvent; PROCEDURE MouseEvent;
VAR VAR
mouse_status : SET; mouse_status : SET;
X, Y : INTEGER; X, Y : INTEGER;
scroll : INTEGER; scroll : INTEGER;
BEGIN BEGIN
SU.MousePos(X, Y); SU.MousePos(X, Y);
mouse_status := SU.MouseStatus(); mouse_status := SU.MouseStatus();
@ -223,7 +226,7 @@ BEGIN
DOM.Click(X, Y, TRUE) DOM.Click(X, Y, TRUE)
END END
ELSIF scroll # 0 THEN ELSIF scroll # 0 THEN
DOM.Scroll(scroll); DOM.Scroll(scroll*2);
DOM.Draw DOM.Draw
ELSE ELSE
ConvMousePos(X, Y); ConvMousePos(X, Y);
@ -267,7 +270,7 @@ END IsFB2;
PROCEDURE main(title: ARRAY OF CHAR); PROCEDURE main(title: ARRAY OF CHAR);
VAR WinW, X1, Y1, X2, Y2, scr_pos: INTEGER; Win2: W.TWindow; resize: BOOLEAN; FilePath: S.STRING; defpath: BOOLEAN; VAR WinW, X1, Y1, X2, Y2, scr_pos: INTEGER; Win2: W.tWindow; resize: BOOLEAN; FilePath: S.STRING; defpath: BOOLEAN;
BEGIN BEGIN
SkinHeight := SU.SkinHeight(); SkinHeight := SU.SkinHeight();
sb := box_lib.kolibri_new_scrollbar(10 * 65536 + 200, 10 * 65536 + 30, 25, 15, 10, 0, 0, 0, 0, 0); sb := box_lib.kolibri_new_scrollbar(10 * 65536 + 200, 10 * 65536 + 30, 25, 15, 10, 0, 0, 0, 0, 0);
@ -299,31 +302,31 @@ BEGIN
SU.SetEventsMask({0, 1, 2, 5, 31}); SU.SetEventsMask({0, 1, 2, 5, 31});
SU.GetScreenArea(X1, Y1, X2, Y2); SU.GetScreenArea(X1, Y1, X2, Y2);
WinW := (X2 - X1) DIV 2; WinW := (X2 - X1) DIV 2;
W.InitWindow(Window, WinW DIV 2, Y1, WinW, Y2 - Y1, title); W.init(Window, WinW DIV 2, Y1, WinW, Y2 - Y1, title);
Settings.Default; Settings.Default;
DOM.GetWinSize(FileName, Window.Width, Window.Height); DOM.GetWinSize(FileName, Window.width, Window.height);
Win2 := Window; Win2 := Window;
resize := FALSE; resize := FALSE;
IF Win2.Width > X2 - X1 THEN IF Win2.width > X2 - X1 THEN
Win2.Width := X2 - X1; Win2.width := X2 - X1;
resize := TRUE resize := TRUE
END; END;
IF Win2.Height > Y2 - Y1 THEN IF Win2.height > Y2 - Y1 THEN
Win2.Height := Y2 - Y1; Win2.height := Y2 - Y1;
resize := TRUE resize := TRUE
END; END;
DOM.Init(CANVAS_LEFT, CANVAS_TOP, DOM.Init(CANVAS_LEFT, CANVAS_TOP,
Window.Width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH - 2, Window.width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH - 2,
Window.Height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1); Window.height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1);
DOM.SetColors; DOM.SetColors;
DOM.Set_b_pict(Ini.b_pict); DOM.Set_b_pict(Ini.b_pict);
Window := Win2; Window := Win2;
G.Resize2(Window.Width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH, Window.Height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL + 1 - STATUSBAR_HEIGHT); G.InitSize(Window.width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH, Window.height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL + 1 - STATUSBAR_HEIGHT);
S.Append(Window.Caption, " - "); S.Append(Window.caption, " - ");
S.Append(Window.Caption, FileName); S.Append(Window.caption, FileName);
Toolbar.create(toolbar, TOOLBAR_LEFT, TOOLBAR_TOP); Toolbar.create(toolbar, TOOLBAR_LEFT, TOOLBAR_TOP);
Toolbar.add(toolbar, BACK, 30, ""); Toolbar.add(toolbar, BACK, 30, "");
@ -339,7 +342,7 @@ BEGIN
DOM.Open(FileName, DrawWindow, DrawStatus, DrawToolbar); DOM.Open(FileName, DrawWindow, DrawStatus, DrawToolbar);
IF resize THEN IF resize THEN
DOM.Resize(Window.Width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH, Window.Height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL + 1 - STATUSBAR_HEIGHT) DOM.Resize(Window.width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH, Window.height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL + 1 - STATUSBAR_HEIGHT)
END; END;
DrawWindow; DrawWindow;
@ -362,5 +365,5 @@ END main;
BEGIN BEGIN
main("FB2 Reader v0.97") main("FB2 Reader v0.97a")
END FB2READ. END FB2READ.

33
programs/other/fb2reader/SRC/File.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2019 Anton Krotov Copyright 2016, 2019, 2023 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by it under the terms of the GNU Lesser General Public License as published by
@ -252,4 +252,35 @@ BEGIN
RETURN res = 0 RETURN res = 0
END DeleteDir; END DeleteDir;
PROCEDURE ReadChar* (F: FS; VAR x: CHAR): BOOLEAN;
RETURN Read(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
END ReadChar;
PROCEDURE ReadInt* (F: FS; VAR x: INTEGER): BOOLEAN;
RETURN Read(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
END ReadInt;
PROCEDURE ReadBool* (F: FS; VAR x: BOOLEAN): BOOLEAN;
RETURN Read(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
END ReadBool;
PROCEDURE WriteChar*(F: FS; x: CHAR): BOOLEAN;
RETURN Write(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
END WriteChar;
PROCEDURE WriteInt*(F: FS; x: INTEGER): BOOLEAN;
RETURN Write(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
END WriteInt;
PROCEDURE WriteBool*(F: FS; x: BOOLEAN): BOOLEAN;
RETURN Write(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
END WriteBool;
END File. END File.

33
programs/other/fb2reader/SRC/Font.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2018, 2022 Anton Krotov Copyright 2016, 2018, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,11 +19,13 @@
MODULE Font; MODULE Font;
IMPORT W := Window, S := Strings, G := Graph, sys := SYSTEM, K := KOSAPI, Conv, Ini, KF := kfonts; IMPORT
W := Window, S := Strings, G := Graph, sys := SYSTEM, K := KOSAPI,
Encoding, Ini, KF := kfonts;
VAR VAR
kf_font, kf_loaded, kf_enabled: BOOLEAN; kf_font, kf_enabled: BOOLEAN;
cp1251buf: ARRAY 102400 OF CHAR; cp1251buf: ARRAY 102400 OF CHAR;
KFont*: KF.TFont; KFont*: KF.TFont;
@ -39,9 +41,9 @@ VAR
ItalicColor, NormalColor: INTEGER; ItalicColor, NormalColor: INTEGER;
PROCEDURE KFText(X, Y: INTEGER; first, quantity: INTEGER; canvas: G.PBuffer); PROCEDURE KFText(X, Y: INTEGER; first, quantity: INTEGER; canvas: G.tBuffer);
BEGIN BEGIN
KF.TextOut(KFont, canvas.adr - 8, X, Y, first, quantity, Font.color, ORD(Font.bold) + ORD(Font.italic) * 2 + ORD(Font.strike) * 8) 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; END KFText;
@ -110,7 +112,7 @@ PROCEDURE TextWidth*(text: S.CHARS; length: INTEGER): INTEGER;
VAR res: INTEGER; VAR res: INTEGER;
BEGIN BEGIN
IF kf_font THEN IF kf_font THEN
Conv.convert(text.first, sys.ADR(cp1251buf[0]), length); 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) res := KF.TextWidth(KFont, sys.ADR(cp1251buf[0]), length, ORD(Font.bold) + ORD(Font.italic) * 2)
ELSE ELSE
res := length * FontW() res := length * FontW()
@ -124,30 +126,30 @@ PROCEDURE MonoWidth*(): INTEGER;
END MonoWidth; END MonoWidth;
PROCEDURE StrikeText*(Rect: W.TRect; X, Y: INTEGER; width: INTEGER); PROCEDURE StrikeText*(Rect: W.tRect; X, Y: INTEGER; width: INTEGER);
VAR y: INTEGER; VAR y: INTEGER;
BEGIN BEGIN
IF Font.strike THEN IF Font.strike THEN
y := Y + FontH() DIV 2; y := Y + FontH() DIV 2;
// X := X + ORD(Font.italic & kf_font) * ((KF.TextHeight(KFont) DIV 2) DIV 3); // X := X + ORD(Font.italic & kf_font) * ((KF.TextHeight(KFont) DIV 2) DIV 3);
G.SetColor(Font.color); G.SetColor(Font.color);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top); G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);
IF Font.size >= 28 THEN IF Font.size >= 28 THEN
INC(y); INC(y);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top); G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);
END END
END END
END StrikeText; END StrikeText;
PROCEDURE Text*(Rect: W.TRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER); PROCEDURE Text*(Rect: W.tRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER);
BEGIN BEGIN
IF kf_font THEN IF kf_font THEN
Conv.convert(adr, sys.ADR(cp1251buf[0]), length); Encoding.convert1251(adr, sys.ADR(cp1251buf[0]), length);
KFText(X + Rect.Left, Y + Rect.Top, sys.ADR(cp1251buf[0]), length, G.Buffer) KFText(X + Rect.left, Y + Rect.top, sys.ADR(cp1251buf[0]), length, G.Buffer)
ELSE ELSE
G.SetColor(Font.color); G.SetColor(Font.color);
G.TextOut(X + Rect.Left, Y + Rect.Top, adr, length, Font.size, params()) G.TextOut(X + Rect.left, Y + Rect.top, adr, length, Font.size, params())
END END
END Text; END Text;
@ -170,7 +172,6 @@ END Init;
BEGIN BEGIN
KFont := KF.LoadFont(Ini.Font); KFont := KF.LoadFont(Ini.Font);
kf_loaded := KFont # NIL; kf_font := KFont # NIL;
kf_font := kf_loaded; kf_enabled := kf_font
kf_enabled := kf_loaded
END Font. END Font.

144
programs/other/fb2reader/SRC/Graph.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016-2020, 2022 Anton Krotov Copyright 2016-2020, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,44 +19,44 @@
MODULE Graph; MODULE Graph;
IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils, LibImg; IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils;
TYPE TYPE
TBuffer = RECORD Width*, Height*, adr*, Color: INTEGER END; tBuffer* = POINTER TO RECORD Width*, Height*, bitmap*, Color: INTEGER END;
PBuffer* = POINTER TO TBuffer;
VAR VAR
Buffer*, Buffer2, Buffer3*: PBuffer; Buffer*, BackImg*: tBuffer;
Width0, Height0: INTEGER;
PROCEDURE [stdcall-, "rasterworks.obj", ""] drawText (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; END; PROCEDURE [stdcall-, "rasterworks.obj", ""] drawText (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; END;
PROCEDURE Destroy*(VAR Buffer: PBuffer); PROCEDURE Destroy*(VAR Buffer: tBuffer);
BEGIN BEGIN
IF Buffer # NIL THEN IF Buffer # NIL THEN
IF Buffer.adr # 0 THEN IF Buffer.bitmap # 0 THEN
DEC(Buffer.adr, 8); DEC(Buffer.bitmap, 8);
Buffer.adr := K.free(Buffer.adr) Buffer.bitmap := K.free(Buffer.bitmap)
END; END;
DISPOSE(Buffer) DISPOSE(Buffer)
END END
END Destroy; END Destroy;
PROCEDURE Create*(Width, Height: INTEGER): PBuffer; PROCEDURE Create*(Width, Height: INTEGER): tBuffer;
VAR res: PBuffer; VAR res: tBuffer;
BEGIN BEGIN
NEW(res); NEW(res);
res.adr := K.malloc(Width * Height * 4 + 8); res.bitmap := K.malloc(Width * Height * 4 + 8);
sys.PUT(res.adr, Width); sys.PUT(res.bitmap, Width);
sys.PUT(res.adr + 4, Height); sys.PUT(res.bitmap + 4, Height);
res.Width := Width; res.Width := Width;
res.Height := Height; res.Height := Height;
INC(res.adr, 8); INC(res.bitmap, 8);
RETURN res RETURN res
END Create; END Create;
@ -69,15 +69,15 @@ BEGIN
END getRGB; END getRGB;
PROCEDURE Fill*(Buffer: PBuffer; Color: INTEGER); PROCEDURE Fill* (Buffer: tBuffer; Color: INTEGER);
VAR p, n, i: INTEGER; VAR p, n, i: INTEGER;
BEGIN BEGIN
p := Buffer.adr; p := Buffer.bitmap;
n := Buffer.Width * Buffer.Height; n := Buffer.Width * Buffer.Height;
FOR i := 1 TO n DO FOR i := 1 TO n DO
sys.PUT(p, Color); sys.PUT(p, Color);
INC(p, 4) INC(p, 4)
END END
END Fill; END Fill;
@ -89,7 +89,7 @@ BEGIN
IF X1 <= X2 THEN IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1); SU.MinMax(Y, 0, Buffer.Height - 1);
color := Buffer.Color; color := Buffer.Color;
p1 := Buffer.adr + 4 * (Y * Buffer.Width + X1); p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4; p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO FOR i := p1 TO p2 BY 4 DO
sys.PUT(i, color) sys.PUT(i, color)
@ -106,7 +106,7 @@ VAR
BEGIN BEGIN
IF X1 <= X2 THEN IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1); SU.MinMax(Y, 0, Buffer.Height - 1);
p1 := Buffer.adr + 4 * (Y * Buffer.Width + X1); p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4; p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO FOR i := p1 TO p2 BY 4 DO
sys.GET(i, pix); sys.GET(i, pix);
@ -125,7 +125,7 @@ BEGIN
SU.MinMax(Y2, 0, Buffer.Height - 1); SU.MinMax(Y2, 0, Buffer.Height - 1);
color := Buffer.Color; color := Buffer.Color;
line_size := Buffer.Width * 4; line_size := Buffer.Width * 4;
p1 := Buffer.adr + line_size * Y1 + 4 * X; p1 := Buffer.bitmap + line_size * Y1 + 4 * X;
p2 := p1 + (Y2 - Y1) * line_size; p2 := p1 + (Y2 - Y1) * line_size;
WHILE p1 <= p2 DO WHILE p1 <= p2 DO
sys.PUT(p1, color); sys.PUT(p1, color);
@ -165,15 +165,15 @@ END GetColor;
PROCEDURE TextOut*(X, Y: INTEGER; Text: INTEGER; length: INTEGER; size, params: INTEGER); PROCEDURE TextOut*(X, Y: INTEGER; Text: INTEGER; length: INTEGER; size, params: INTEGER);
BEGIN BEGIN
drawText(Buffer.adr - 8, X, Y, Text, length, 0FF000000H + Buffer.Color, params) drawText(Buffer.bitmap - 8, X, Y, Text, length, 0FF000000H + Buffer.Color, params)
END TextOut; END TextOut;
PROCEDURE Resize2*(Width, Height: INTEGER); PROCEDURE InitSize* (Width, Height: INTEGER);
BEGIN BEGIN
Buffer2.Width := Width; Width0 := Width;
Buffer2.Height := Height; Height0 := Height;
END Resize2; END InitSize;
PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER); PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER);
@ -183,14 +183,14 @@ BEGIN
ASSERT(sizeX <= Buffer.Width); ASSERT(sizeX <= Buffer.Width);
FOR y := 0 TO sizeY - 1 DO FOR y := 0 TO sizeY - 1 DO
IF (Ymin <= Y) & (Y < Ymax) THEN IF (Ymin <= Y) & (Y < Ymax) THEN
sys.MOVE(ptr + sizeX*4*y, Buffer.adr + (Buffer.Width*Y + X)*4, sizeX*4) sys.MOVE(ptr + sizeX*4*y, Buffer.bitmap + (Buffer.Width*Y + X)*4, sizeX*4)
END; END;
INC(Y) INC(Y)
END END
END Image; END Image;
PROCEDURE Image2(Buffer: PBuffer; X, Y, sizeX, sizeY, ptr: INTEGER); PROCEDURE Image2(Buffer: tBuffer; X, Y, sizeX, sizeY, ptr: INTEGER);
VAR x, y, pix, left: INTEGER; VAR x, y, pix, left: INTEGER;
BEGIN BEGIN
left := X; left := X;
@ -199,7 +199,7 @@ BEGIN
FOR x := 0 TO sizeX - 1 DO FOR x := 0 TO sizeX - 1 DO
sys.GET32(ptr + (y*sizeX + x)*4, pix); sys.GET32(ptr + (y*sizeX + x)*4, pix);
IF (X < Buffer.Width) & (Y < Buffer.Height) THEN IF (X < Buffer.Width) & (Y < Buffer.Height) THEN
sys.PUT32(Buffer.adr + (Buffer.Width*Y + X)*4, pix) sys.PUT32(Buffer.bitmap + (Buffer.Width*Y + X)*4, pix)
END; END;
INC(X) INC(X)
END; END;
@ -213,10 +213,10 @@ VAR x, y: INTEGER;
BEGIN BEGIN
IF ptr # 0 THEN IF ptr # 0 THEN
y := 0; y := 0;
WHILE y < Buffer3.Height DO WHILE y < BackImg.Height DO
x := 0; x := 0;
WHILE x < Buffer3.Width DO WHILE x < BackImg.Width DO
Image2(Buffer3, x, y, sizeX, sizeY, ptr); Image2(BackImg, x, y, sizeX, sizeY, ptr);
INC(x, sizeX) INC(x, sizeX)
END; END;
INC(y, sizeY) INC(y, sizeY)
@ -225,25 +225,15 @@ BEGIN
END BackImage; END BackImage;
PROCEDURE Copy*(src, dst: PBuffer; y_src, lines, y_dst: INTEGER); PROCEDURE Copy*(src, dst: tBuffer; y_src, lines, y_dst: INTEGER);
BEGIN BEGIN
sys.MOVE(src.adr + y_src * src.Width * 4, dst.adr + y_dst * dst.Width * 4, lines * dst.Width * 4) sys.MOVE(src.bitmap + y_src * src.Width * 4, dst.bitmap + y_dst * dst.Width * 4, lines * dst.Width * 4)
END Copy; END Copy;
PROCEDURE Clear*;
VAR p, color: INTEGER;
BEGIN
color := Buffer.Color;
FOR p := Buffer.adr TO Buffer.adr + Buffer.Width * Buffer.Height * 4 - 4 BY 4 DO
sys.PUT(p, color)
END
END Clear;
PROCEDURE Draw*(X, Y: INTEGER); PROCEDURE Draw*(X, Y: INTEGER);
BEGIN BEGIN
K.sysfunc7(65, Buffer.adr, Buffer.Width * 65536 + Buffer.Height, X * 65536 + Y, 32, 0, 0) K.sysfunc7(65, Buffer.bitmap, Buffer.Width * 65536 + Buffer.Height, X * 65536 + Y, 32, 0, 0)
END Draw; END Draw;
@ -259,11 +249,10 @@ END Rect;
PROCEDURE Progress*(value: REAL); PROCEDURE Progress*(value: REAL);
VAR W4, W2, H2: INTEGER; VAR W4, W2, H2: INTEGER;
BEGIN BEGIN
W4 := Buffer2.Width DIV 4; W2 := Width0 DIV 2;
W2 := Buffer2.Width DIV 2; W4 := W2 DIV 2;
H2 := Buffer2.Height DIV 2; H2 := Height0 DIV 2;
SetColor(0FFFFFFH); Fill(Buffer, 0FFFFFFH);
Clear;
SetColor(0); SetColor(0);
Rect(W4, H2 - 50, 3 * W4, H2 + 30); Rect(W4, H2 - 50, 3 * W4, H2 + 30);
TextOut(W2 - 10 * 8 DIV 2, H2 - 50 + 15, sys.SADR("Loading..."), 10, 1, 16 + 0 + LSL(3, 16) + LSL(128, 24)); TextOut(W2 - 10 * 8 DIV 2, H2 - 50 + 15, sys.SADR("Loading..."), 10, 1, 16 + 0 + LSL(3, 16) + LSL(128, 24));
@ -272,39 +261,54 @@ BEGIN
END Progress; END Progress;
PROCEDURE Resize3(Buffer: PBuffer; Width, Height: INTEGER); PROCEDURE _resize (Buffer: tBuffer; Width, Height: INTEGER);
BEGIN BEGIN
IF Buffer.adr # 0 THEN IF Buffer.bitmap # 0 THEN
DEC(Buffer.adr, 8) DEC(Buffer.bitmap, 8)
END; END;
Buffer.adr := K.realloc(Buffer.adr, Width * Height * 4 + 8); Buffer.bitmap := K.realloc(Buffer.bitmap, Width * Height * 4 + 8);
SU.MemError(Buffer.adr = 0); SU.MemError(Buffer.bitmap = 0);
sys.PUT(Buffer.adr, Width); sys.PUT(Buffer.bitmap, Width);
sys.PUT(Buffer.adr + 4, Height); sys.PUT(Buffer.bitmap + 4, Height);
INC(Buffer.adr, 8); INC(Buffer.bitmap, 8);
Buffer.Width := Width; Buffer.Width := Width;
Buffer.Height := Height Buffer.Height := Height
END Resize3; END _resize;
PROCEDURE Resize*(Width, Height: INTEGER); PROCEDURE Resize*(Width, Height: INTEGER);
BEGIN BEGIN
Resize3(Buffer, Width, Height); _resize(Buffer, Width, Height);
Resize3(Buffer3, Width, Height); IF BackImg # NIL THEN
_resize(BackImg, Width, Height)
END
END Resize; END Resize;
PROCEDURE Init; PROCEDURE Init;
VAR Width, Height: INTEGER; VAR Width, Height: INTEGER;
BEGIN BEGIN
NEW(Buffer); BackImg := NIL;
NEW(Buffer2); NEW(Buffer);
NEW(Buffer3); SU.GetScreenSize(Width, Height);
SU.GetScreenSize(Width, Height); Resize(Width, Height)
Resize(Width, Height)
END Init; END Init;
PROCEDURE CreateBackImg*;
BEGIN
IF BackImg = NIL THEN
BackImg := Create(Buffer.Width, Buffer.Height)
END
END CreateBackImg;
PROCEDURE DestroyBackImg*;
BEGIN
Destroy(BackImg)
END DestroyBackImg;
BEGIN BEGIN
Init Init
END Graph. END Graph.

30
programs/other/fb2reader/SRC/Libimg.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2022 Anton Krotov Copyright 2016, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,21 +19,29 @@
MODULE LibImg; MODULE LibImg;
IMPORT sys := SYSTEM, KOSAPI, File, S := Strings; IMPORT SYSTEM, KOSAPI, File, S := Strings;
PROCEDURE [stdcall, "Libimg.obj", ""] img_decode (data, size, options: INTEGER): INTEGER; END; PROCEDURE [stdcall, "Libimg.obj", ""] img_decode (data, size, options: INTEGER): INTEGER; END;
PROCEDURE [stdcall, "Libimg.obj", ""] img_to_rgb2 (data, data_rgb: INTEGER); END;
PROCEDURE [stdcall, "Libimg.obj", ""] img_scale (src, crop_x, crop_y, crop_width, crop_height, dst, scale, inter, param1, param2: INTEGER): INTEGER; END; PROCEDURE [stdcall, "Libimg.obj", ""] img_scale (src, crop_x, crop_y, crop_width, crop_height, dst, scale, inter, param1, param2: INTEGER): INTEGER; END;
PROCEDURE [stdcall, "Libimg.obj", ""] img_destroy* (img: INTEGER); END; PROCEDURE [stdcall, "Libimg.obj", ""] img_destroy (img: INTEGER); END;
PROCEDURE [stdcall, "Libimg.obj", ""] img_convert (src, dst, dst_type, flags, param: INTEGER): INTEGER; END; PROCEDURE [stdcall, "Libimg.obj", ""] img_convert (src, dst, dst_type, flags, param: INTEGER): INTEGER; END;
PROCEDURE Destroy* (VAR img: INTEGER);
BEGIN
IF img # 0 THEN
img_destroy(img);
img := 0
END
END Destroy;
PROCEDURE GetInf* (img: INTEGER; VAR sizeX, sizeY, data: INTEGER); PROCEDURE GetInf* (img: INTEGER; VAR sizeX, sizeY, data: INTEGER);
BEGIN BEGIN
sys.GET(img + 4, sizeX); SYSTEM.GET(img + 4, sizeX);
sys.GET(img + 8, sizeY); SYSTEM.GET(img + 8, sizeY);
sys.GET(img + 24, data) SYSTEM.GET(img + 24, data)
END GetInf; END GetInf;
@ -43,9 +51,9 @@ VAR
BEGIN BEGIN
image_data := img_decode(ptr, size, 0); image_data := img_decode(ptr, size, 0);
IF image_data # 0 THEN IF image_data # 0 THEN
sys.GET(image_data + 4, x); SYSTEM.GET(image_data + 4, x);
sys.GET(image_data + 8, y); SYSTEM.GET(image_data + 8, y);
sys.GET(image_data + 20, type); SYSTEM.GET(image_data + 20, type);
IF type # 3 THEN IF type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0); dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data); img_destroy(image_data);
@ -57,7 +65,7 @@ BEGIN
image_data := dst image_data := dst
END; END;
IF image_data # 0 THEN IF image_data # 0 THEN
sys.GET(image_data + 8, sizeY) SYSTEM.GET(image_data + 8, sizeY)
END END
END END
RETURN image_data RETURN image_data

4
programs/other/fb2reader/SRC/OpenDlg.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2022 Anton Krotov Copyright 2016, 2022, 2023 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by it under the terms of the GNU Lesser General Public License as published by
@ -17,7 +17,7 @@
MODULE OpenDlg; MODULE OpenDlg;
IMPORT sys := SYSTEM, KOSAPI, S := Strings; IMPORT sys := SYSTEM;
TYPE TYPE

42
programs/other/fb2reader/SRC/Read.ob07
View File

@ -1,42 +0,0 @@
(*
Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Read;
IMPORT File, sys := SYSTEM;
PROCEDURE Char*(F: File.FS; VAR x: CHAR): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
END Char;
PROCEDURE Int*(F: File.FS; VAR x: INTEGER): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
END Int;
PROCEDURE Real*(F: File.FS; VAR x: REAL): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
END Real;
PROCEDURE Boolean*(F: File.FS; VAR x: BOOLEAN): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
END Boolean;
PROCEDURE Set*(F: File.FS; VAR x: SET): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
END Set;
END Read.

6
programs/other/fb2reader/SRC/ReadFile.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2022 Anton Krotov Copyright 2016, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,7 +19,7 @@
MODULE ReadFile; MODULE ReadFile;
IMPORT sys := SYSTEM, K := KOSAPI, S := Strings, File, SU := SysUtils, Encode; IMPORT sys := SYSTEM, K := KOSAPI, S := Strings, File, SU := SysUtils, Encoding;
VAR VAR
@ -87,7 +87,7 @@ BEGIN
END Free; END Free;
PROCEDURE Conv*(cp: Encode.CP); PROCEDURE Conv*(cp: Encoding.tCodePage);
VAR m, nov, mem2, k: INTEGER; c: CHAR; VAR m, nov, mem2, k: INTEGER; c: CHAR;
BEGIN BEGIN
m := Mem; m := Mem;

84
programs/other/fb2reader/SRC/Search.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2020, 2022 Anton Krotov Copyright 2020, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -22,7 +22,7 @@ MODULE Search;
IMPORT IMPORT
XML, G := Graph, Window, Font, S := Strings, LISTS, SYSTEM, XML, G := Graph, Window, Font, S := Strings, LISTS, SYSTEM,
SU := SysUtils, K := KOSAPI, SearchForm; SU := SysUtils, K := KOSAPI, SearchForm, Encoding;
TYPE TYPE
@ -72,7 +72,7 @@ VAR
Find: PFind; Find: PFind;
PROCEDURE SelText (Col: Window.TRect; min, max, Ycur, LineH: INTEGER; right: BOOLEAN; rect: TRect; cur: BOOLEAN); PROCEDURE SelText (Col: Window.tRect; min, max, Ycur, LineH: INTEGER; right: BOOLEAN; rect: TRect; cur: BOOLEAN);
VAR VAR
y, y0, color: INTEGER; y, y0, color: INTEGER;
@ -85,12 +85,12 @@ BEGIN
ELSE ELSE
color := 0 color := 0
END; END;
G.BoxNotXOR(Col.Left + rect.x1 + 1, Col.Top + y - Col.Height * ORD(right), Col.Left + rect.x2, Col.Top + y - Col.Height * ORD(right) + Font.FontH(), color) G.BoxNotXOR(Col.left + rect.x1 + 1, Col.top + y - Col.height * ORD(right), Col.left + rect.x2, Col.top + y - Col.height * ORD(right) + Font.FontH(), color)
END END
END SelText; END SelText;
PROCEDURE draw* (body: XML.TAG; ColLeft, ColRight: Window.TRect; Ycur, LineH: INTEGER; TwoCol: BOOLEAN); PROCEDURE draw* (body: XML.TAG; ColLeft, ColRight: Window.tRect; Ycur, LineH: INTEGER; TwoCol: BOOLEAN);
VAR VAR
rect: TRect; rect: TRect;
pos, cur: TPos; pos, cur: TPos;
@ -107,9 +107,9 @@ BEGIN
WHILE pos # NIL DO WHILE pos # NIL DO
rect := pos.RectList.first(TRect); rect := pos.RectList.first(TRect);
WHILE rect # NIL DO WHILE rect # NIL DO
SelText(ColLeft, 0, ColLeft.Height - LineH, Ycur, LineH, FALSE, rect, pos = cur); SelText(ColLeft, 0, ColLeft.height - LineH, Ycur, LineH, FALSE, rect, pos = cur);
IF TwoCol THEN IF TwoCol THEN
SelText(ColRight, ColLeft.Height, ColLeft.Height + ColRight.Height - LineH, Ycur, LineH, TRUE, rect, pos = cur) SelText(ColRight, ColLeft.height, ColLeft.height + ColRight.height - LineH, Ycur, LineH, TRUE, rect, pos = cur)
END; END;
rect := rect.next(TRect) rect := rect.next(TRect)
END; END;
@ -118,45 +118,6 @@ BEGIN
END draw; END draw;
PROCEDURE getc_utf8 (VAR text, size, code: INTEGER);
VAR
c: BYTE;
n, k: INTEGER;
end: BOOLEAN;
BEGIN
ASSERT(size > 0);
code := 0;
end := FALSE;
REPEAT
SYSTEM.GET(text, c);
INC(text);
DEC(size);
CASE c OF
| 0..127:
code := c;
end := TRUE
|128..191:
code := code * 64 + c MOD 64;
DEC(n);
end := n <= 0
|192..255:
k := LSL(c, 24);
n := -2;
REPEAT
k := ROR(k, -1);
INC(n)
UNTIL ~ODD(k);
k := LSL(c, n + 25);
code := LSR(k, n + 25)
END
UNTIL (size = 0) OR end
END getc_utf8;
PROCEDURE textlen (body: XML.ELEMENT; VAR length: INTEGER); PROCEDURE textlen (body: XML.ELEMENT; VAR length: INTEGER);
VAR VAR
cur: XML.ELEMENT; cur: XML.ELEMENT;
@ -214,20 +175,18 @@ BEGIN
END cap; END cap;
PROCEDURE UpCase (s1, s2, length: INTEGER); PROCEDURE upcase (src, dst, length: INTEGER);
VAR VAR
code, n: INTEGER; n: INTEGER;
u: S.UTF8; u: Encoding.tUtf8;
BEGIN BEGIN
WHILE length > 0 DO WHILE length > 0 DO
getc_utf8(s1, length, code); Encoding.utf8(cap(Encoding.getUtf8Char(src, length)), u);
S.utf8(cap(code), u);
n := LENGTH(u); n := LENGTH(u);
SYSTEM.MOVE(SYSTEM.ADR(u[0]), s2, n); SYSTEM.MOVE(SYSTEM.ADR(u[0]), dst, n);
INC(s2, n) INC(dst, n)
END END
END UpCase; END upcase;
PROCEDURE create (body: XML.ELEMENT); PROCEDURE create (body: XML.ELEMENT);
@ -304,7 +263,7 @@ BEGIN
buf1 := K.malloc(length); buf1 := K.malloc(length);
SU.MemError(buf1 = 0); SU.MemError(buf1 = 0);
UpCase(buf, buf1, length); upcase(buf, buf1, length);
NEW(text.idx1); NEW(text.idx1);
index(text.idx1, buf1, text.idx0.size); index(text.idx1, buf1, text.idx0.size);
@ -482,7 +441,7 @@ BEGIN
text.PosList := LISTS.create(NIL); text.PosList := LISTS.create(NIL);
text.str0 := str; text.str0 := str;
UpCase(SYSTEM.ADR(str[0]), SYSTEM.ADR(text.str1[0]), LENGTH(str)); upcase(SYSTEM.ADR(str[0]), SYSTEM.ADR(text.str1[0]), LENGTH(str));
IF text.case THEN IF text.case THEN
idx := text.idx0; idx := text.idx0;
@ -588,6 +547,7 @@ PROCEDURE close*;
VAR VAR
text: Text; text: Text;
body: XML.TAG; body: XML.TAG;
nullptr: INTEGER;
BEGIN BEGIN
body := Body; body := Body;
@ -596,7 +556,15 @@ BEGIN
LISTS.destroy(text.PosList); LISTS.destroy(text.PosList);
text.PosList := LISTS.create(NIL); text.PosList := LISTS.create(NIL);
text.found := 0; text.found := 0;
text.curPos := NIL text.curPos := NIL;
nullptr := K.free(text.idx0.table);
nullptr := K.free(text.idx0.data);
nullptr := K.free(text.idx1.table);
nullptr := K.free(text.idx1.data);
DISPOSE(text.idx0);
DISPOSE(text.idx1);
DISPOSE(text);
body.text := NIL
END END
END close; END close;

28
programs/other/fb2reader/SRC/SearchForm.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2020-2021 Anton Krotov Copyright 2020-2021, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -21,7 +21,7 @@ MODULE SearchForm;
IMPORT IMPORT
SYSTEM, SU := SysUtils, W := Window, box_lib, K := KOSAPI, Encode, S := Strings; SYSTEM, SU := SysUtils, W := Window, box_lib, K := KOSAPI, Encoding;
CONST CONST
@ -49,7 +49,7 @@ VAR
PID, Slot: INTEGER; PID, Slot: INTEGER;
Stack: ARRAY 1000000 OF CHAR; Stack: ARRAY 1000000 OF CHAR;
Window: W.TWindow; Window: W.tWindow;
str: STRING; str: STRING;
callback: PROC; callback: PROC;
@ -80,8 +80,8 @@ PROCEDURE DrawWindow;
BEGIN BEGIN
SU.GetSystemColors; SU.GetSystemColors;
SU.WindowRedrawStatus(1); SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption); SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
buttons; buttons;
SU.WindowRedrawStatus(2) SU.WindowRedrawStatus(2)
END DrawWindow; END DrawWindow;
@ -92,7 +92,7 @@ VAR
pid, i, j, k, n: INTEGER; pid, i, j, k, n: INTEGER;
found: BOOLEAN; found: BOOLEAN;
str0: STRING; str0: STRING;
u: S.UTF8; u: Encoding.tUtf8;
BEGIN BEGIN
found := TRUE; found := TRUE;
@ -103,8 +103,8 @@ BEGIN
j := 0; j := 0;
i := 0; i := 0;
WHILE str[i] # 0X DO WHILE str[i] # 0X DO
u := Encode.CP866[ORD(str[i])].utf8; u := Encoding.cp866[ORD(str[i])].utf8;
n := Encode.CP866[ORD(str[i])].len; n := Encoding.cp866[ORD(str[i])].len;
FOR k := 0 TO n - 1 DO FOR k := 0 TO n - 1 DO
str0[j] := u[k]; str0[j] := u[k];
INC(j) INC(j)
@ -148,19 +148,19 @@ VAR
BEGIN BEGIN
SU.SetEventsMask({0, 1, 2, 5, 30, 31}); SU.SetEventsMask({0, 1, 2, 5, 30, 31});
W.InitWindow(Window, 0, 0, 320, 140, "Search"); W.init(Window, 0, 0, 320, 140, "Search");
SU.GetScreenSize(scrWidth, scrHeight); SU.GetScreenSize(scrWidth, scrHeight);
Window.Left := (scrWidth - Window.Width) DIV 2; Window.left := (scrWidth - Window.width) DIV 2;
Window.Top := (scrHeight - Window.Height) DIV 2; Window.top := (scrHeight - Window.height) DIV 2;
DrawWindow; DrawWindow;
WHILE TRUE DO WHILE TRUE DO
CASE SU.WaitForEvent() OF CASE SU.WaitForEvent() OF
|1: DrawWindow |1: DrawWindow
|2: key := K.sysfunc1(2); |2: key := SU.GetKey();
IF key DIV 65536 = 28 THEN IF key DIV 65536 = 28 THEN (* enter *)
close(TRUE) close(TRUE)
ELSIF key DIV 65536 = 1 THEN ELSIF key DIV 65536 = 1 THEN (* esc *)
close(FALSE) close(FALSE)
ELSE ELSE
box_lib.edit_box_key_safe(text, key) box_lib.edit_box_key_safe(text, key)

175
programs/other/fb2reader/SRC/SelEnc.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2018, 2020-2022 Anton Krotov Copyright 2016, 2018, 2020-2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -20,40 +20,42 @@
MODULE SelEnc; MODULE SelEnc;
IMPORT IMPORT
SU := SysUtils, W := Window, S := Strings, SYSTEM, K := KOSAPI, File;
SU := SysUtils, W := Window, OpenDlg, S := Strings, TXT := Txt2FB2, SYSTEM, K := KOSAPI, Settings, File;
CONST CONST
AUTO = 15;
CP866 = 16;
CP1251 = 17;
CP1252 = 18;
CP1250 = 19;
UTF8 = 20;
BtnH = 30; BtnH = 30;
BtnW = 150; BtnW = 150;
BtnX = 5; BtnX = 5;
BtnY = 10; BtnY = 10;
BtnInter = 10; BtnInter = 10;
tempfile* = "/tmp0/1/~temp.fb2"; tempfile* = "/tmp0/1/~temp.fb2";
VAR VAR
Window: W.tWindow;
Window : W.TWindow; pos, mem, mem2, pos2: INTEGER;
ENCODING* : INTEGER;
FileName : S.STRING;
PROCEDURE Buttons; PROCEDURE Buttons;
VAR VAR
Y : INTEGER; Y : INTEGER;
BEGIN BEGIN
Y := BtnY; Y := BtnY;
SU.CreateButton(TXT.AUTO, BtnX, Y, BtnW, BtnH, SU.btnColor, "AUTO" ); INC(Y, BtnH + BtnInter); SU.CreateButton(AUTO, BtnX, Y, BtnW, BtnH, SU.btnColor, "AUTO" ); INC(Y, BtnH + BtnInter);
SU.CreateButton(TXT.CP866, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-866" ); INC(Y, BtnH + BtnInter); SU.CreateButton(CP866, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-866" ); INC(Y, BtnH + BtnInter);
SU.CreateButton(TXT.CP1251, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1251"); INC(Y, BtnH + BtnInter); SU.CreateButton(CP1251, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1251"); INC(Y, BtnH + BtnInter);
SU.CreateButton(TXT.CP1252, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1252"); INC(Y, BtnH + BtnInter); SU.CreateButton(CP1252, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1252"); INC(Y, BtnH + BtnInter);
SU.CreateButton(TXT.CP1250, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1250"); INC(Y, BtnH + BtnInter); SU.CreateButton(CP1250, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1250"); INC(Y, BtnH + BtnInter);
SU.CreateButton(TXT.UTF8, BtnX, Y, BtnW, BtnH, SU.btnColor, "UTF-8" ) SU.CreateButton(UTF8, BtnX, Y, BtnW, BtnH, SU.btnColor, "UTF-8" )
END Buttons; END Buttons;
@ -61,16 +63,94 @@ PROCEDURE DrawWindow;
BEGIN BEGIN
SU.GetSystemColors; SU.GetSystemColors;
SU.WindowRedrawStatus(1); SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption); SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
Buttons; Buttons;
SU.WindowRedrawStatus(2) SU.WindowRedrawStatus(2)
END DrawWindow; END DrawWindow;
PROCEDURE auto (fname: S.STRING): INTEGER; PROCEDURE getch (): CHAR;
VAR VAR
enc, data, size, ptr: INTEGER; ch: CHAR;
BEGIN
SYSTEM.GET(mem + pos, ch);
INC(pos)
RETURN ch
END getch;
PROCEDURE WriteStr (s: ARRAY OF CHAR);
BEGIN
SYSTEM.MOVE(SYSTEM.ADR(s[0]), mem2 + pos2, LENGTH(s));
pos2 := pos2 + LENGTH(s)
END WriteStr;
PROCEDURE WriteChar (ch: CHAR);
BEGIN
SYSTEM.PUT(mem2 + pos2, ch);
INC(pos2)
END WriteChar;
PROCEDURE convert (ibuf, size: INTEGER; out: S.STRING; encoding: INTEGER);
CONST
buf_size = 1024*16;
VAR
F: File.FS;
n: INTEGER;
CR: BOOLEAN;
ch: CHAR;
buffer: ARRAY buf_size OF BYTE;
BEGIN
mem := ibuf;
pos := 0;
F := File.Create(out);
mem2 := SYSTEM.ADR(buffer[0]);
pos2 := 0;
WriteStr('<?xml encoding = "');
CASE encoding OF
|CP866 : WriteStr("cp866")
|CP1251 : WriteStr("windows-1251")
|CP1252 : WriteStr("windows-1252")
|CP1250 : WriteStr("windows-1250")
|UTF8 : WriteStr("utf-8")
ELSE
SU.Halt
END;
WriteStr('"?>' + 0DX + 0AX + "<FictionBook><body>");
WHILE pos < size DO
IF pos2 > buf_size - 32 THEN
n := File.Write(F, mem2, pos2);
pos2 := 0
END;
ch := getch();
CASE ch OF
|"<": WriteStr("&lt;")
|">": WriteStr("&gt;")
|"&": WriteStr("&amp;")
|"'": WriteStr("&apos;")
|'"': WriteStr("&quot;")
|0DX: WriteStr("<empty-line/>")
|0AX: IF ~CR THEN WriteStr("<empty-line/>") END
| 0X: WriteChar(20X)
ELSE
WriteChar(ch)
END;
CR := ch = 0DX
END;
WriteStr("</body></FictionBook>");
n := File.Write(F, mem2, pos2);
File.Close(F)
END convert;
PROCEDURE auto (ptr, size: INTEGER): INTEGER;
VAR
enc: INTEGER;
PROCEDURE SearchPair (ptr, size: INTEGER; chr1, chr2: BYTE): BOOLEAN; PROCEDURE SearchPair (ptr, size: INTEGER; chr1, chr2: BYTE): BOOLEAN;
@ -96,39 +176,32 @@ VAR
BEGIN BEGIN
data := File.Load(fname, size);
SU.ErrorIf(data = 0, 1);
ptr := data;
IF SearchPair(ptr, size, 208, 190) THEN IF SearchPair(ptr, size, 208, 190) THEN
enc := TXT.UTF8 enc := UTF8
ELSE ELSE
IF SearchPair(ptr, size, 239, 240) OR SearchPair(ptr, size, 241, 242) THEN IF SearchPair(ptr, size, 239, 240) OR SearchPair(ptr, size, 241, 242) THEN
enc := TXT.CP1251 enc := CP1251
ELSE ELSE
enc := TXT.CP866 enc := CP866
END END
END; END
data := K.free(data)
RETURN enc RETURN enc
END auto; END auto;
PROCEDURE ButtonClick; PROCEDURE ButtonClick (fname: S.STRING);
VAR VAR
btn_code: INTEGER; encoding: INTEGER;
program, file: S.STRING; program, file: S.STRING;
data, size: INTEGER;
BEGIN BEGIN
btn_code := SU.GetButtonCode(); data := File.Load(fname, size);
IF btn_code = TXT.AUTO THEN SU.ErrorIf(data = 0, 1);
ENCODING := auto(FileName) encoding := SU.GetButtonCode();
ELSE IF encoding = AUTO THEN
ENCODING := btn_code encoding := auto(data, size)
END; END;
TXT.convert(FileName, tempfile, ENCODING); convert(data, size, tempfile, encoding);
S.PtrToString(K.GetName(), program); S.PtrToString(K.GetName(), program);
file := tempfile; file := tempfile;
file[0] := "!"; file[0] := "!";
@ -137,27 +210,23 @@ BEGIN
END ButtonClick; END ButtonClick;
PROCEDURE Show*(FName: S.STRING); PROCEDURE Show* (fname: S.STRING);
VAR VAR
X1, Y1, X2, Y2: INTEGER; X1, Y1, X2, Y2: INTEGER;
BEGIN BEGIN
FileName := FName;
SU.SetEventsMask({0, 2, 31}); SU.SetEventsMask({0, 2, 31});
SU.GetScreenArea(X1, Y1, X2, Y2); SU.GetScreenArea(X1, Y1, X2, Y2);
W.InitWindow(Window, 0, 0, BtnX * 2 + BtnW + 10, (BtnH + BtnInter) * 6 + BtnY * 2 + SU.SkinHeight() - 5, "Encoding"); W.init(Window, 0, 0, BtnX * 2 + BtnW + 10, (BtnH + BtnInter) * 6 + BtnY * 2 + SU.SkinHeight() - 5, "Encoding");
Window.Left := (X2 - X1 - Window.Width) DIV 2; Window.left := (X2 - X1 - Window.width) DIV 2;
Window.Top := (Y2 - Y1 - Window.Height) DIV 2; Window.top := (Y2 - Y1 - Window.height) DIV 2;
DrawWindow; DrawWindow;
WHILE TRUE DO WHILE TRUE DO
CASE SU.WaitForEvent() OF CASE SU.WaitForEvent() OF
|1 : DrawWindow |1: DrawWindow
|3 : ButtonClick |3: ButtonClick(fname)
END END
END END
END Show; END Show;
BEGIN
ENCODING := 0
END SelEnc. END SelEnc.

64
programs/other/fb2reader/SRC/Settings.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2018, 2020-2022 Anton Krotov Copyright 2016, 2018, 2020-2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,7 +19,7 @@
MODULE Settings; MODULE Settings;
IMPORT SU := SysUtils, W := Window, C := ColorDlg, DOM, S := Strings, IMPORT SU := SysUtils, W := Window, C := ColorDlg, DOM, S := Strings, K := KOSAPI, File,
Font, KF := kfonts, OD := OpenDlg, LibImg, G := Graph, Ini, box_lib, sys := SYSTEM; Font, KF := kfonts, OD := OpenDlg, LibImg, G := Graph, Ini, box_lib, sys := SYSTEM;
@ -56,7 +56,7 @@ CONST
VAR VAR
Window : W.TWindow; Window : W.tWindow;
PID : INTEGER; PID : INTEGER;
Slot : INTEGER; Slot : INTEGER;
Color : C.Dialog; Color : C.Dialog;
@ -69,6 +69,7 @@ VAR
check2 : box_lib.checkbox; check2 : box_lib.checkbox;
OpenPict : OD.Dialog; OpenPict : OD.Dialog;
picture : INTEGER; picture : INTEGER;
picture_fsize : INTEGER;
picture_path : S.STRING; picture_path : S.STRING;
@ -79,8 +80,9 @@ BEGIN
IF PID # 0 THEN IF PID # 0 THEN
pid := PID; pid := PID;
PID := 0; PID := 0;
IF (picture # 0) & (picture # Data.Picture) THEN IF (picture # Data.Picture) & (picture # 0) THEN
LibImg.img_destroy(picture) picture := K.free(picture);
picture_fsize := 0
END; END;
C.Destroy(Color); C.Destroy(Color);
OD.Destroy(OpenPict); OD.Destroy(OpenPict);
@ -91,7 +93,7 @@ END Close;
PROCEDURE ClearWindow; PROCEDURE ClearWindow;
BEGIN BEGIN
SU.Box(0, 0, Window.Width - 10, Window.Height - SU.SkinHeight() - 5, SU.winColor, SU.winColor) SU.Box(0, 0, Window.width - 10, Window.height - SU.SkinHeight() - 5, SU.winColor, SU.winColor)
END ClearWindow; END ClearWindow;
@ -130,18 +132,18 @@ VAR
X, Y, TextY : INTEGER; X, Y, TextY : INTEGER;
WinW, WinH, SkinH : INTEGER; WinW, WinH, SkinH : INTEGER;
i : INTEGER; i : INTEGER;
Rect : W.TRect; Rect : W.tRect;
BEGIN BEGIN
Rect.Left := 10; Rect.left := 10;
Rect.Top := 85; Rect.top := 85;
Rect.Width := 210; Rect.width := 210;
Rect.Height := 255; Rect.height := 255;
SU.Box(Rect.Left, Rect.Top, Rect.Width, Rect.Height, SU.winColor, SU.borderColor); SU.Box(Rect.left, Rect.top, Rect.width, Rect.height, SU.winColor, SU.borderColor);
SU.Box(Rect.Left + 230, Rect.Top, Rect.Width + 170, Rect.Height, SU.winColor, SU.borderColor); SU.Box(Rect.left + 230, Rect.top, Rect.width + 170, Rect.height, SU.winColor, SU.borderColor);
WinW := Window.Width; WinW := Window.width;
WinH := Window.Height; WinH := Window.height;
SkinH := SU.SkinHeight(); SkinH := SU.SkinHeight();
X := 125; X := 125;
Y := 10; Y := 10;
@ -178,8 +180,8 @@ BEGIN
Y := Y - 6; Y := Y - 6;
SU.CreateButton(DAY, (Rect.Width - (BtnW + 5 + BtnW)) DIV 2 + Rect.Left, Y, 80, BtnH, SU.btnColor, "Day" ); SU.CreateButton(DAY, (Rect.width - (BtnW + 5 + BtnW)) DIV 2 + Rect.left, Y, 80, BtnH, SU.btnColor, "Day" );
SU.CreateButton(NIGHT, (Rect.Width - (BtnW + 5 + BtnW)) DIV 2 + Rect.Left + 5 + BtnW, Y, 80, BtnH, SU.btnColor, "Night" ); SU.CreateButton(NIGHT, (Rect.width - (BtnW + 5 + BtnW)) DIV 2 + Rect.left + 5 + BtnW, Y, 80, BtnH, SU.btnColor, "Night" );
SU.CreateButton(APPLY, (WinW - (BtnW + 5 + BtnW) - 10) DIV 2, WinH - BtnH - SkinH - 10, 80, BtnH, SU.btnColor, "Apply" ); SU.CreateButton(APPLY, (WinW - (BtnW + 5 + BtnW) - 10) DIV 2, WinH - BtnH - SkinH - 10, 80, BtnH, SU.btnColor, "Apply" );
SU.CreateButton(CANCEL, (WinW - (BtnW + 5 + BtnW) - 10) DIV 2 + 5 + BtnW, WinH - BtnH - SkinH - 10, 80, BtnH, SU.btnColor, "Cancel"); SU.CreateButton(CANCEL, (WinW - (BtnW + 5 + BtnW) - 10) DIV 2 + 5 + BtnW, WinH - BtnH - SkinH - 10, 80, BtnH, SU.btnColor, "Cancel");
@ -197,8 +199,8 @@ PROCEDURE DrawWindow;
BEGIN BEGIN
SU.GetSystemColors; SU.GetSystemColors;
SU.WindowRedrawStatus(1); SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption); SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
Buttons; Buttons;
SU.WindowRedrawStatus(2) SU.WindowRedrawStatus(2)
END DrawWindow; END DrawWindow;
@ -258,28 +260,31 @@ BEGIN
Data.PARAGRAPH := sb[4].position; Data.PARAGRAPH := sb[4].position;
Data.EPIGRAPH := sb[5].position; Data.EPIGRAPH := sb[5].position;
Data.InterLin := sb[6].position; Data.InterLin := sb[6].position;
IF Data.Picture # picture THEN IF (picture # 0) & (picture # Data.Picture) THEN
IF Data.Picture # 0 THEN IF Data.Picture # 0 THEN
LibImg.img_destroy(Data.Picture) Data.Picture := K.free(Data.Picture)
END; END;
Data.Picture := picture; Data.Picture := picture;
Data.picture_fsize := picture_fsize;
Ini.SetPicturePath(picture_path) Ini.SetPicturePath(picture_path)
END; END;
picture := 0; picture := 0;
picture_fsize := 0;
DOM.SetSettings(Data); DOM.SetSettings(Data);
Close Close
END Apply; END Apply;
PROCEDURE LoadPicture(file_path: S.STRING); PROCEDURE LoadPicture(file_path: S.STRING);
VAR ysize, img: INTEGER; VAR fsize, img: INTEGER;
BEGIN BEGIN
img := LibImg.LoadFromFile(file_path, 10240000, ysize); img := File.Load(file_path, fsize);
IF img # 0 THEN IF img # 0 THEN
IF (picture # 0) & (picture # Data.Picture) THEN IF (picture # 0) & (picture # Data.Picture) THEN
LibImg.img_destroy(picture) picture := K.free(picture)
END; END;
picture := img; picture := img;
picture_fsize := fsize;
picture_path := file_path picture_path := file_path
END END
END LoadPicture; END LoadPicture;
@ -335,6 +340,7 @@ BEGIN
Data.EPIGRAPH := 100; Data.EPIGRAPH := 100;
Data.InterLin := 0; Data.InterLin := 0;
Data.Picture := picture; Data.Picture := picture;
Data.picture_fsize := picture_fsize;
DOM.SetSettings(Data) DOM.SetSettings(Data)
END Default; END Default;
@ -343,14 +349,15 @@ PROCEDURE Show;
VAR i, scrWidth, scrHeight: INTEGER; VAR i, scrWidth, scrHeight: INTEGER;
BEGIN BEGIN
SU.SetEventsMask({0, 2, 5, 30, 31}); SU.SetEventsMask({0, 2, 5, 30, 31});
W.InitWindow(Window, 0, 0, 640, 420, "Settings"); W.init(Window, 0, 0, 640, 420, "Settings");
SU.GetScreenSize(scrWidth, scrHeight); SU.GetScreenSize(scrWidth, scrHeight);
Window.Left := (scrWidth - Window.Width) DIV 2; Window.left := (scrWidth - Window.width) DIV 2;
Window.Top := (scrHeight - Window.Height) DIV 2; Window.top := (scrHeight - Window.height) DIV 2;
Color := C.Create(DrawWindow); Color := C.Create(DrawWindow);
OpenPict := OD.Create(DrawWindow, 0, "/sys", "JPG|PNG|BMP|GIF"); OpenPict := OD.Create(DrawWindow, 0, "/sys", "JPG|PNG|BMP|GIF");
Data := DOM.Settings; Data := DOM.Settings;
picture := Data.Picture; picture := Data.Picture;
picture_fsize := Data.picture_fsize;
DrawWindow; DrawWindow;
WHILE TRUE DO WHILE TRUE DO
CASE SU.WaitForEvent() OF CASE SU.WaitForEvent() OF
@ -409,6 +416,7 @@ BEGIN
check2 := box_lib.kolibri_new_check_box(TextLeft, 10 + 5, 16, 16, sys.SADR(""), LENGTH(bpicture) * 8 + 5); check2 := box_lib.kolibri_new_check_box(TextLeft, 10 + 5, 16, 16, sys.SADR(""), LENGTH(bpicture) * 8 + 5);
check1 := box_lib.kolibri_new_check_box(TextLeft, 10 + (BtnH + 10) + 5, 16, 16, sys.SADR(""), LENGTH(twocol) * 8 + 5); check1 := box_lib.kolibri_new_check_box(TextLeft, 10 + (BtnH + 10) + 5, 16, 16, sys.SADR(""), LENGTH(twocol) * 8 + 5);
picture := 0; picture := 0;
picture_fsize := 0;
IF Ini.Picture # "" THEN IF Ini.Picture # "" THEN
LoadPicture(Ini.Picture) LoadPicture(Ini.Picture)
END END

34
programs/other/fb2reader/SRC/Strings.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2019, 2022 Anton Krotov Copyright 2016, 2019, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,15 +19,13 @@
MODULE Strings; MODULE Strings;
IMPORT sys := SYSTEM, KOSAPI; IMPORT sys := SYSTEM, Encoding;
TYPE TYPE
STRING* = ARRAY 1024 OF CHAR; STRING* = ARRAY 1024 OF CHAR;
UTF8* = ARRAY 8 OF CHAR;
CHARS* = RECORD first*, last* : INTEGER END; CHARS* = RECORD first*, last* : INTEGER END;
@ -290,30 +288,6 @@ BEGIN
END Replace; END Replace;
PROCEDURE utf8*(code: INTEGER; VAR uchar: UTF8);
BEGIN
uchar[0] := 0X;
IF code < 80H THEN
uchar[0] := CHR(code);
uchar[1] := 0X
ELSIF code < 800H THEN
uchar[1] := CHR(ORD(BITS(code) * {0..5}) + 80H);
uchar[0] := CHR(ASR(code, 6) + 0C0H);
uchar[2] := 0X
ELSIF code < 10000H THEN
uchar[2] := CHR(ORD(BITS(code) * {0..5}) + 80H);
code := ASR(code, 6);
uchar[1] := CHR(ORD(BITS(code) * {0..5}) + 80H);
uchar[0] := CHR(ASR(code, 6) + 0E0H);
uchar[3] := 0X
(*
ELSIF code < 200000H THEN
ELSIF code < 4000000H THEN
ELSE *)
END
END utf8;
PROCEDURE EntOct*(VAR chars: CHARS): BOOLEAN; PROCEDURE EntOct*(VAR chars: CHARS): BOOLEAN;
VAR VAR
i : INTEGER; i : INTEGER;
@ -324,7 +298,7 @@ VAR
exit : BOOLEAN; exit : BOOLEAN;
str : STRING; str : STRING;
str2 : STRING; str2 : STRING;
uchar : UTF8; uchar : Encoding.tUtf8;
res : BOOLEAN; res : BOOLEAN;
BEGIN BEGIN
@ -361,7 +335,7 @@ BEGIN
IF c = ";" THEN IF c = ";" THEN
str2[0] := c; str2[0] := c;
Append(str, str2); Append(str, str2);
utf8(val, uchar); Encoding.utf8(val, uchar);
Replace(chars, str, uchar); Replace(chars, str, uchar);
res := TRUE; res := TRUE;
i := chars.last - chars.first i := chars.last - chars.first

25
programs/other/fb2reader/SRC/SysUtils.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2019, 2021, 2022 Anton Krotov Copyright 2016, 2019, 2021-2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -135,7 +135,7 @@ END MouseVScroll;
PROCEDURE MouseStatus*(): SET; PROCEDURE MouseStatus*(): SET;
RETURN BITS(K.sysfunc2(37, 2)) RETURN BITS(K.sysfunc2(37, 3))
END MouseStatus; END MouseStatus;
@ -167,9 +167,24 @@ BEGIN
END SetEventsMask; END SetEventsMask;
PROCEDURE GetKeyCode*(): INTEGER; PROCEDURE GetKey* (): INTEGER;
RETURN LSR(LSL(K.sysfunc1(2), 16), 24) RETURN K.sysfunc1(2)
END GetKeyCode; END GetKey;
PROCEDURE GetControlKeys* (): SET;
RETURN BITS(K.sysfunc2(66, 3))
END GetControlKeys;
PROCEDURE getKBState* (VAR shift, ctrl: BOOLEAN);
VAR
kbState: SET;
BEGIN
kbState := GetControlKeys();
shift := {0, 1} * kbState # {};
ctrl := {2, 3} * kbState # {};
END getKBState;
PROCEDURE GetButtonCode*(): INTEGER; PROCEDURE GetButtonCode*(): INTEGER;

129
programs/other/fb2reader/SRC/Txt2fb2.ob07
View File

@ -1,129 +0,0 @@
(*
Copyright 2016, 2020 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 Txt2FB2;
IMPORT File, sys := SYSTEM, K := KOSAPI, S := Strings, SU := SysUtils;
CONST
AUTO* = 15;
CP866* = 16;
CP1251* = 17;
CP1252* = 18;
CP1250* = 19;
UTF8* = 20;
VAR F: File.FS; ch: CHAR; pos, mem, mem2, pos2: INTEGER;
PROCEDURE getch;
BEGIN
sys.GET(mem + pos, ch);
INC(pos)
END getch;
PROCEDURE WriteStr(s: ARRAY OF CHAR);
BEGIN
sys.MOVE(sys.ADR(s[0]), mem2 + pos2, LENGTH(s));
pos2 := pos2 + LENGTH(s)
END WriteStr;
PROCEDURE WriteChar(ch: CHAR);
BEGIN
sys.PUT(mem2 + pos2, ch);
INC(pos2)
END WriteChar;
PROCEDURE convert*(in, out: S.STRING; encoding: INTEGER);
CONST buf_size = 1024*16;
VAR n, size: INTEGER; CR: BOOLEAN;
BEGIN
F := File.Open(in);
size := File.Seek(F, 0, 2);
n := File.Seek(F, 0, 0);
mem := K.malloc(size + 1024);
SU.MemError(mem = 0);
n := File.Read(F, mem, size);
File.Close(F);
pos := 0;
F := File.Create(out);
mem2 := K.malloc(buf_size);
SU.MemError(mem2 = 0);
pos2 := 0;
WriteStr("<?xml encoding = ");
WriteStr(22X);
CASE encoding OF
|CP866 : WriteStr("cp866")
|CP1251 : WriteStr("windows-1251")
|CP1252 : WriteStr("windows-1252")
|CP1250 : WriteStr("windows-1250")
|UTF8 : WriteStr("utf-8")
ELSE
SU.Halt
END;
WriteStr(22X);
WriteStr("?>");
WriteChar(0DX);
WriteChar(0AX);
WriteStr("<FictionBook><body>");
WHILE pos < size DO
IF pos2 > buf_size - 32 THEN
n := File.Write(F, mem2, pos2);
pos2 := 0
END;
getch;
IF ch = "<" THEN
WriteStr("&lt;")
ELSIF ch = ">" THEN
WriteStr("&gt;")
ELSIF ch = "&" THEN
WriteStr("&amp;")
ELSIF ch = "'" THEN
WriteStr("&apos;")
ELSIF ch = 22X THEN
WriteStr("&quot;")
ELSIF ch = 0DX THEN
WriteStr("<empty-line/>")
ELSIF ch = 0AX THEN
IF ~CR THEN
WriteStr("<empty-line/>")
END
ELSIF ch = 0X THEN
WriteChar(20X)
ELSE
WriteChar(ch)
END;
CR := ch = 0DX
END;
WriteStr("</body></FictionBook>");
n := File.Write(F, mem2, pos2);
File.Close(F);
mem := K.free(mem);
mem2 := K.free(mem2)
END convert;
END Txt2FB2.

90
programs/other/fb2reader/SRC/Vector.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016 Anton Krotov Copyright 2016, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,86 +19,90 @@
MODULE Vector; MODULE Vector;
IMPORT SYSTEM, K := KOSAPI;
IMPORT sys := SYSTEM, K := KOSAPI;
CONST
ptr_size = 4;
TYPE TYPE
DESC_VECTOR = RECORD DESC_VECTOR = RECORD
data : INTEGER;
count* : INTEGER;
size : INTEGER
END;
data : INTEGER; VECTOR* = POINTER TO DESC_VECTOR;
count* : INTEGER;
size : INTEGER
END; ANYREC* = RECORD END;
VECTOR* = POINTER TO DESC_VECTOR; ANYPTR* = POINTER TO ANYREC;
ANYREC* = RECORD END; DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
ANYPTR* = POINTER TO ANYREC;
DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
PROCEDURE push* (vector: VECTOR; value: ANYPTR); PROCEDURE push* (vector: VECTOR; value: ANYPTR);
BEGIN BEGIN
IF vector.count = vector.size THEN IF vector.count = vector.size THEN
vector.data := K.realloc(vector.data, (vector.size + 1024) * 4); vector.data := K.realloc(vector.data, (vector.size + 1024) * ptr_size);
vector.size := vector.size + 1024 vector.size := vector.size + 1024
END; END;
sys.PUT(vector.data + vector.count * 4, value); SYSTEM.PUT(vector.data + vector.count * ptr_size, value);
INC(vector.count) INC(vector.count)
END push; END push;
PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR; PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR;
VAR res: ANYPTR; VAR
res: ANYPTR;
BEGIN BEGIN
ASSERT( (0 <= idx) & (idx < vector.count) ); ASSERT( (0 <= idx) & (idx < vector.count) );
sys.GET(vector.data + idx * 4, res) SYSTEM.GET(vector.data + idx * ptr_size, res)
RETURN res RETURN res
END get; END get;
PROCEDURE put* (vector: VECTOR; idx: INTEGER; value: ANYPTR); PROCEDURE put* (vector: VECTOR; idx: INTEGER; value: ANYPTR);
BEGIN BEGIN
ASSERT( (0 <= idx) & (idx < vector.count) ); ASSERT( (0 <= idx) & (idx < vector.count) );
sys.PUT(vector.data + idx * 4, value) SYSTEM.PUT(vector.data + idx * ptr_size, value)
END put; END put;
PROCEDURE create* (size: INTEGER): VECTOR; PROCEDURE create* (size: INTEGER): VECTOR;
VAR vector: VECTOR; VAR
vector: VECTOR;
BEGIN BEGIN
NEW(vector); NEW(vector);
vector.data := K.malloc(4 * size); vector.data := K.malloc(ptr_size * size);
vector.size := size; vector.size := size;
vector.count := 0 vector.count := 0
RETURN vector RETURN vector
END create; END create;
PROCEDURE def_destructor (VAR any: ANYPTR); PROCEDURE def_destructor (VAR any: ANYPTR);
BEGIN BEGIN
DISPOSE(any) DISPOSE(any)
END def_destructor; END def_destructor;
PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR); PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR);
VAR i: INTEGER; VAR
any: ANYPTR; i: INTEGER;
any: ANYPTR;
BEGIN BEGIN
IF destructor = NIL THEN IF destructor = NIL THEN
destructor := def_destructor destructor := def_destructor
END; END;
FOR i := 0 TO vector.count - 1 DO FOR i := 0 TO vector.count - 1 DO
any := get(vector, i); any := get(vector, i);
destructor(any) destructor(any)
END; END;
vector.data := K.free(vector.data); vector.data := K.free(vector.data);
DISPOSE(vector) DISPOSE(vector)
END destroy; END destroy;

48
programs/other/fb2reader/SRC/Window.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2021 Anton Krotov Copyright 2016, 2021, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -23,36 +23,34 @@ IMPORT S := Strings;
TYPE TYPE
TRect* = RECORD tRect* = RECORD
Left*, Top*, Width*, Height* : INTEGER left*, top*, width*, height* : INTEGER
END; END;
TWindow* = RECORD (TRect) tWindow* = RECORD (tRect)
Caption* : S.STRING; caption* : S.STRING;
Created* : BOOLEAN; created* : BOOLEAN;
dWidth*, dHeight* : INTEGER dWidth*, dHeight* : INTEGER
END; END;
PROCEDURE InitWindow*(VAR Window: TWindow; Left, Top, Width, Height: INTEGER; Caption: ARRAY OF CHAR);
PROCEDURE initRect* (VAR Rect: tRect; left, top, width, height: INTEGER);
BEGIN BEGIN
Window.Left := Left; Rect.left := left;
Window.Top := Top; Rect.top := top;
Window.Width := Width; Rect.width := width;
Window.Height := Height; Rect.height := height
Window.Created := FALSE; END initRect;
Window.dWidth := 0;
Window.dHeight := 0;
COPY(Caption, Window.Caption)
END InitWindow;
PROCEDURE InitRect*(VAR Rect: TRect; Left, Top, Width, Height: INTEGER); PROCEDURE init* (VAR window: tWindow; left, top, width, height: INTEGER; caption: ARRAY OF CHAR);
BEGIN BEGIN
Rect.Left := Left; initRect(window, left, top, width, height);
Rect.Top := Top; window.created := FALSE;
Rect.Width := Width; window.dWidth := 0;
Rect.Height := Height window.dHeight := 0;
END InitRect; COPY(caption, window.caption)
END init;
END Window. END Window.

42
programs/other/fb2reader/SRC/Write.ob07
View File

@ -1,42 +0,0 @@
(*
Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Write;
IMPORT File, sys := SYSTEM;
PROCEDURE Char*(F: File.FS; x: CHAR): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
END Char;
PROCEDURE Int*(F: File.FS; x: INTEGER): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
END Int;
PROCEDURE Real*(F: File.FS; x: REAL): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
END Real;
PROCEDURE Boolean*(F: File.FS; x: BOOLEAN): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
END Boolean;
PROCEDURE Set*(F: File.FS; x: SET): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
END Set;
END Write.

48
programs/other/fb2reader/SRC/XML.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2020, 2022 Anton Krotov Copyright 2016, 2020, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -19,7 +19,7 @@
MODULE XML; MODULE XML;
IMPORT SU := SysUtils, RF := ReadFile, S := Strings, Encode, V := Vector, tables, LISTS; IMPORT SU := SysUtils, RF := ReadFile, S := Strings, E := Encoding, V := Vector, tables, LISTS;
CONST CONST
@ -135,7 +135,7 @@ VAR
tire1, tire2, nbsp, ellipsis, apo, tire1, tire2, nbsp, ellipsis, apo,
quot1, quot2, quot3, quot4, quot5, quot6, quot7, quot1, quot2, quot3, quot4, quot5, quot6, quot7,
number, bullet, euro, number, bullet, euro,
dash1, dash2: S.UTF8; dash1, dash2: E.tUtf8;
num: INTEGER; num: INTEGER;
Tags: V.VECTOR; Tags: V.VECTOR;
@ -678,13 +678,13 @@ BEGIN
DEC(chars.last); DEC(chars.last);
S.SetCS(FALSE); S.SetCS(FALSE);
IF S.CharsEqStr(chars, "windows-1250") THEN IF S.CharsEqStr(chars, "windows-1250") THEN
RF.Conv(Encode.W1250) RF.Conv(E.cp1250)
ELSIF S.CharsEqStr(chars, "windows-1251") THEN ELSIF S.CharsEqStr(chars, "windows-1251") THEN
RF.Conv(Encode.W1251) RF.Conv(E.cp1251)
ELSIF S.CharsEqStr(chars, "windows-1252") THEN ELSIF S.CharsEqStr(chars, "windows-1252") THEN
RF.Conv(Encode.W1252) RF.Conv(E.cp1252)
ELSIF S.CharsEqStr(chars, "cp866" ) THEN ELSIF S.CharsEqStr(chars, "cp866" ) THEN
RF.Conv(Encode.CP866) RF.Conv(E.cp866)
ELSIF S.CharsEqStr(chars, "utf-8" ) THEN ELSIF S.CharsEqStr(chars, "utf-8" ) THEN
RF.SeekBeg RF.SeekBeg
ELSE ELSE
@ -729,23 +729,23 @@ END Open;
PROCEDURE Init; PROCEDURE Init;
BEGIN BEGIN
S.utf8(8212, tire1); E.utf8(8212, tire1);
S.utf8(8211, tire2); E.utf8(8211, tire2);
S.utf8( 160, nbsp); E.utf8( 160, nbsp);
S.utf8(8230, ellipsis); E.utf8(8230, ellipsis);
S.utf8(8217, apo); E.utf8(8217, apo);
S.utf8(8220, quot1); E.utf8(8220, quot1);
S.utf8(8221, quot2); E.utf8(8221, quot2);
S.utf8(8222, quot3); E.utf8(8222, quot3);
S.utf8(8216, quot4); E.utf8(8216, quot4);
S.utf8(8218, quot5); E.utf8(8218, quot5);
S.utf8(8249, quot6); E.utf8(8249, quot6);
S.utf8(8250, quot7); E.utf8(8250, quot7);
S.utf8(8470, number); E.utf8(8470, number);
S.utf8(8208, dash1); E.utf8(8208, dash1);
S.utf8(8209, dash2); E.utf8(8209, dash2);
S.utf8(8226, bullet); E.utf8(8226, bullet);
S.utf8(8364, euro); E.utf8(8364, euro);
Tags := V.create(1024) Tags := V.create(1024)
END Init; END Init;

4
programs/other/fb2reader/SRC/box_lib.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2016, 2017, 2020, 2022 Anton Krotov Copyright 2016, 2017, 2020, 2022, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.
@ -48,7 +48,7 @@ TYPE
scrollbar* = POINTER TO RECORD scrollbar* = POINTER TO RECORD
x_w: INTEGER; x_w*: INTEGER;
y_h*: INTEGER; y_h*: INTEGER;
btn_height: INTEGER; btn_height: INTEGER;
typ: INTEGER; typ: INTEGER;

149
programs/other/fb2reader/SRC/encode.ob07
View File

@ -1,149 +0,0 @@
(*
Copyright 2016 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 Encode;
IMPORT S := Strings;
TYPE
CP* = ARRAY 256 OF RECORD code*, len*: INTEGER; utf8*: S.UTF8 END;
VAR
W1250*, W1251*, W1252*, CP866*: CP;
PROCEDURE InitCP(VAR cp: CP);
VAR i: INTEGER;
BEGIN
FOR i := 0H TO 7FH DO
cp[i].code := i
END;
FOR i := 0H TO 0FFH DO
S.utf8(cp[i].code, cp[i].utf8);
cp[i].len := LENGTH(cp[i].utf8)
END
END InitCP;
PROCEDURE Init8(VAR cp: CP; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER);
BEGIN
cp[n].code := a; INC(n);
cp[n].code := b; INC(n);
cp[n].code := c; INC(n);
cp[n].code := d; INC(n);
cp[n].code := e; INC(n);
cp[n].code := f; INC(n);
cp[n].code := g; INC(n);
cp[n].code := h; INC(n);
END Init8;
PROCEDURE InitW1250(VAR cp: CP);
VAR n: INTEGER;
BEGIN
n := 80H;
Init8(cp, n, 20ACH, 20H, 201AH, 20H, 201EH, 2026H, 2020H, 2021H);
Init8(cp, n, 20H, 2030H, 0160H, 2039H, 015AH, 0164H, 017DH, 0179H);
Init8(cp, n, 20H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
Init8(cp, n, 20H, 2122H, 0161H, 203AH, 015BH, 0165H, 017EH, 017AH);
Init8(cp, n, 00A0H, 02C7H, 02D8H, 0141H, 00A4H, 0104H, 00A6H, 00A7H);
Init8(cp, n, 00A8H, 00A9H, 015EH, 00ABH, 00ACH, 00ADH, 00AEH, 017BH);
Init8(cp, n, 00B0H, 00B1H, 02DBH, 0142H, 00B4H, 00B5H, 00B6H, 00B7H);
Init8(cp, n, 00B8H, 0105H, 015FH, 00BBH, 013DH, 02DDH, 013EH, 017CH);
Init8(cp, n, 0154H, 00C1H, 00C2H, 0102H, 00C4H, 0139H, 0106H, 00C7H);
Init8(cp, n, 010CH, 00C9H, 0118H, 00CBH, 011AH, 00CDH, 00CEH, 010EH);
Init8(cp, n, 0110H, 0143H, 0147H, 00D3H, 00D4H, 0150H, 00D6H, 00D7H);
Init8(cp, n, 0158H, 016EH, 00DAH, 0170H, 00DCH, 00DDH, 0162H, 00DFH);
Init8(cp, n, 0155H, 00E1H, 00E2H, 0103H, 00E4H, 013AH, 0107H, 00E7H);
Init8(cp, n, 010DH, 00E9H, 0119H, 00EBH, 011BH, 00EDH, 00EEH, 010FH);
Init8(cp, n, 0111H, 0144H, 0148H, 00F3H, 00F4H, 0151H, 00F6H, 00F7H);
Init8(cp, n, 0159H, 016FH, 00FAH, 0171H, 00FCH, 00FDH, 0163H, 02D9H);
InitCP(cp)
END InitW1250;
PROCEDURE InitW1251(VAR cp: CP);
VAR n, i: INTEGER;
BEGIN
n := 80H;
Init8(cp, n, 0402H, 0403H, 201AH, 0453H, 201EH, 2026H, 2020H, 2021H);
Init8(cp, n, 20ACH, 2030H, 0409H, 2039H, 040AH, 040CH, 040BH, 040FH);
Init8(cp, n, 0452H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
Init8(cp, n, 20H, 2122H, 0459H, 203AH, 045AH, 045CH, 045BH, 045FH);
Init8(cp, n, 00A0H, 040EH, 045EH, 0408H, 00A4H, 0490H, 00A6H, 00A7H);
Init8(cp, n, 0401H, 00A9H, 0404H, 00ABH, 00ACH, 00ADH, 00AEH, 0407H);
Init8(cp, n, 00B0H, 00B1H, 0406H, 0456H, 0491H, 00B5H, 00B6H, 00B7H);
Init8(cp, n, 0451H, 2116H, 0454H, 00BBH, 0458H, 0405H, 0455H, 0457H);
FOR i := 0410H TO 044FH DO
cp[i - 350H].code := i
END;
InitCP(cp)
END InitW1251;
PROCEDURE InitW1252(VAR cp: CP);
VAR n, i: INTEGER;
BEGIN
n := 80H;
Init8(cp, n, 20ACH, 20H, 201AH, 0192H, 201EH, 2026H, 2020H, 2021H);
Init8(cp, n, 02C6H, 2030H, 0160H, 2039H, 0152H, 20H, 017DH, 20H);
Init8(cp, n, 20H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
Init8(cp, n, 02DCH, 2122H, 0161H, 203AH, 0153H, 20H, 017EH, 0178H);
FOR i := 0A0H TO 0FFH DO
cp[i].code := i
END;
InitCP(cp)
END InitW1252;
PROCEDURE InitCP866(VAR cp: CP);
VAR n, i: INTEGER;
BEGIN
FOR i := 0410H TO 043FH DO
cp[i - 0410H + 80H].code := i
END;
FOR i := 0440H TO 044FH DO
cp[i - 0440H + 0E0H].code := i
END;
n := 0B0H;
Init8(cp, n, 2591H, 2592H, 2593H, 2502H, 2524H, 2561H, 2562H, 2556H);
Init8(cp, n, 2555H, 2563H, 2551H, 2557H, 255DH, 255CH, 255BH, 2510H);
Init8(cp, n, 2514H, 2534H, 252CH, 251CH, 2500H, 253CH, 255EH, 255FH);
Init8(cp, n, 255AH, 2554H, 2569H, 2566H, 2560H, 2550H, 256CH, 2567H);
Init8(cp, n, 2568H, 2564H, 2565H, 2559H, 2558H, 2552H, 2553H, 256BH);
Init8(cp, n, 256AH, 2518H, 250CH, 2588H, 2584H, 258CH, 2590H, 2580H);
n := 0F0H;
Init8(cp, n, 0401H, 0451H, 0404H, 0454H, 0407H, 0457H, 040EH, 045EH);
Init8(cp, n, 00B0H, 2219H, 00B7H, 221AH, 2116H, 00A4H, 25A0H, 00A0H);
InitCP(cp)
END InitCP866;
BEGIN
InitW1250(W1250);
InitW1251(W1251);
InitW1252(W1252);
InitCP866(CP866);
END Encode.

2
programs/other/fb2reader/SRC/kfonts.ob07
View File

@ -1,5 +1,5 @@
(* (*
Copyright 2018-2020 Anton Krotov Copyright 2018-2020, 2023 Anton Krotov
This file is part of fb2read. This file is part of fb2read.