Aren/kolibrios
1
0
Fork 0
mirror of https://github.com/KolibriOS/kolibrios.git synced 2024-11-22 17:01:40 +03:00
Code Issues Packages Projects Releases 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
it under the terms of the GNU Lesser General Public License as published by
@ -17,70 +17,74 @@
MODULE ColorDlg;
IMPORT sys := SYSTEM, KOSAPI;
IMPORT SYSTEM;
TYPE
DRAW_WINDOW = PROCEDURE;
DRAW_WINDOW = PROCEDURE;
TDialog = RECORD
type,
procinfo,
com_area_name,
com_area,
start_path: INTEGER;
draw_window: DRAW_WINDOW;
status*,
X, Y,
color_type,
color*: INTEGER;
TDialog = RECORD
type,
procinfo,
com_area_name,
com_area,
start_path: INTEGER;
draw_window: DRAW_WINDOW;
status*,
X, Y,
color_type,
color*: INTEGER;
procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR
END;
procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR
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_init (cd: Dialog); END;
PROCEDURE Show*(cd: Dialog);
PROCEDURE Show* (cd: Dialog);
BEGIN
IF cd # NIL THEN
cd.X := 0;
cd.Y := 0;
ColorDialog_start(cd)
END
IF cd # NIL THEN
cd.X := 0;
cd.Y := 0;
ColorDialog_start(cd)
END
END Show;
PROCEDURE Create*(draw_window: DRAW_WINDOW): Dialog;
VAR res: Dialog;
PROCEDURE Create* (draw_window: DRAW_WINDOW): Dialog;
VAR
res: Dialog;
BEGIN
NEW(res);
IF res # NIL THEN
res.s_com_area_name := "FFFFFFFF_color_dlg";
res.com_area := 0;
res.type := 0;
res.color_type := 0;
res.procinfo := sys.ADR(res.procinf[0]);
res.com_area_name := sys.ADR(res.s_com_area_name[0]);
res.start_path := sys.SADR("/sys/colrdial");
res.draw_window := draw_window;
res.status := 0;
res.X := 0;
res.Y := 0;
res.color := 0;
ColorDialog_init(res)
END
RETURN res
NEW(res);
IF res # NIL THEN
res.s_com_area_name := "FFFFFFFF_color_dlg";
res.com_area := 0;
res.type := 0;
res.color_type := 0;
res.procinfo := SYSTEM.ADR(res.procinf[0]);
res.com_area_name := SYSTEM.ADR(res.s_com_area_name[0]);
res.start_path := SYSTEM.SADR("/sys/colrdial");
res.draw_window := draw_window;
res.status := 0;
res.X := 0;
res.Y := 0;
res.color := 0;
ColorDialog_init(res)
END
RETURN res
END Create;
PROCEDURE Destroy*(VAR cd: Dialog);
PROCEDURE Destroy* (VAR cd: Dialog);
BEGIN
IF cd # NIL THEN
DISPOSE(cd)
END
IF cd # NIL THEN
DISPOSE(cd)
END
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.
@ -20,12 +20,12 @@
MODULE Cursor;
IMPORT sys := SYSTEM;
IMPORT SYSTEM;
PROCEDURE [stdcall] cur;
BEGIN
sys.CODE(
SYSTEM.CODE(
000H, 000H, 002H, 000H, 001H, 000H, 020H, 020H, 000H, 000H,
005H, 000H, 000H, 000H, 0A8H, 00CH, 000H, 000H, 016H, 000H,
000H, 000H, 028H, 000H, 000H, 000H, 020H, 000H, 000H, 000H,
@ -357,7 +357,7 @@ END cur;
PROCEDURE GetCursor* (): INTEGER;
RETURN sys.ADR(cur) + 3
RETURN SYSTEM.ADR(cur) + 3
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.
@ -20,7 +20,7 @@
MODULE DOM;
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;
@ -54,6 +54,7 @@ TYPE
SUP,
InterLin*,
Picture*,
picture_fsize*,
SpaceW: INTEGER
END;
@ -73,8 +74,7 @@ VAR
Settings* : TSettings;
Canvas_X, Canvas_Y: INTEGER;
ColLeft : Window.TRect;
ColRight : Window.TRect;
ColLeft, ColRight: Window.tRect;
Ymin, Ymax, Ycur : INTEGER;
@ -428,6 +428,44 @@ BEGIN
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);
VAR
cur : XML.ELEMENT;
@ -441,51 +479,6 @@ VAR
height1 : 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
cur := body;
WHILE cur # NIL DO
@ -610,8 +603,7 @@ BEGIN
DEC(code);
Font.sysfont(code > 0)
|XML.tag_image:
Image(tag)
Image(tag, TRUE)
|XML.tag_table:
Y := tag.Ymin + tables.get_table_height(tag.table);
tag.Ymax := Y - Y MOD LineH;
@ -680,52 +672,52 @@ VAR
y, y0 : 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;
BEGIN
IF (min <= y0) & (y0 <= max) THEN
Font.sysfont(code > 0);
IF text IS XML.WORD THEN
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;
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 DrawText;
PROCEDURE Image(VAR tag: XML.TAG);
PROCEDURE DrawImage(VAR tag: XML.TAG);
VAR sizeX, sizeY, img, y: INTEGER;
BEGIN
IF tag.img # 0 THEN
y := Ycur;
LibImg.GetInf(tag.img, sizeX, sizeY, img);
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)
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)
END;
IF Settings.TwoCol THEN
y := Ycur + ColLeft.Height;
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)
y := Ycur + ColLeft.height;
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)
END
END
END
END Image;
END DrawImage;
PROCEDURE td(VAR tag: XML.TAG);
VAR x1, y1, x2, y2, cl: INTEGER;
BEGIN
x1 := tag.X + ColLeft.Left;
y1 := tag.Ymin - Ycur + ColLeft.Top;
x1 := tag.X + ColLeft.left;
y1 := tag.Ymin - Ycur + ColLeft.top;
x2 := x1 + tag.Width;
y2 := y1 + tables.get_height(tag.table, tag.cell);
cl := G.GetColor();
G.SetColor(Settings.Colors[TEXT_COLOR]);
G.Rect(x1, y1, x2, y2);
IF Settings.TwoCol THEN
x1 := x1 - ColLeft.Left + ColRight.Left;
x2 := x2 - ColLeft.Left + ColRight.Left;
y1 := y1 - ColLeft.Height;
y2 := y2 - ColLeft.Height;
x1 := x1 - ColLeft.left + ColRight.left;
x2 := x2 - ColLeft.left + ColRight.left;
y1 := y1 - ColLeft.height;
y2 := y2 - ColLeft.height;
G.Rect(x1, y1, x2, y2)
END;
G.SetColor(cl)
@ -776,7 +768,9 @@ BEGIN
INC(italic);
Font.Italic(TRUE, refer = 0)
|XML.tag_image:
Image(tag)
Image(tag, FALSE);
DrawImage(tag);
LibImg.Destroy(tag.img)
|XML.tag_code:
INC(code)
ELSE
@ -816,9 +810,9 @@ BEGIN
text := cur(XML.TEXT);
y := text.Y - Ycur;
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
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;
cur := cur.next
@ -826,12 +820,12 @@ BEGIN
END layout2;
PROCEDURE DrawProgress(progress_color: INTEGER);
PROCEDURE DrawFrame (color: INTEGER);
VAR max_X, max_Y: INTEGER;
BEGIN
max_X := G.Buffer.Width - 1;
max_Y := G.Buffer.Height - 1;
G.SetColor(0);
G.SetColor(color);
G.HLine(0, max_X, 0);
G.HLine(0, max_X, max_Y);
G.VLine(0, 0, max_Y);
@ -839,16 +833,18 @@ BEGIN
sb.cur_area := 50;
sb.position := (Ycur - Ymin) DIV LineH;
box_lib.scrollbar_v_draw(sb)
END DrawProgress;
END DrawFrame;
PROCEDURE Draw*;
VAR back, max_X, max_Y: INTEGER;
(*VAR max_Y: INTEGER;*)
BEGIN
back := Settings.Colors[BACK_COLOR];
max_X := G.Buffer.Width - 1;
max_Y := G.Buffer.Height - 1;
G.Copy(G.Buffer3, G.Buffer, 0, G.Buffer.Height, 0);
(*max_Y := G.Buffer.Height - 1;*)
IF Settings.b_pict & (Settings.Picture # 0) THEN
G.Copy(G.BackImg, G.Buffer, 0, G.Buffer.Height, 0)
ELSE
G.Fill(G.Buffer, Settings.Colors[BACK_COLOR])
END;
Font.SetFontColor(Settings.Colors[TEXT_COLOR]);
IF ((body = description) OR (body = contents)) & Settings.TwoCol THEN
Settings.TwoCol := FALSE;
@ -859,9 +855,9 @@ BEGIN
layout2(body.child.first);
Search.draw(body, ColLeft, ColRight, Ycur, LineH, Settings.TwoCol)
END;
G.Copy(G.Buffer3, G.Buffer, 0, ColLeft.Top + 1, 0);
G.Copy(G.Buffer3, G.Buffer, max_Y - ColLeft.Top, ColLeft.Top + 1, max_Y - ColLeft.Top);
DrawProgress(0);
(*G.Copy(G.BackImg, G.Buffer, 0, ColLeft.top + 1, 0);
G.Copy(G.BackImg, G.Buffer, max_Y - ColLeft.top, ColLeft.top + 1, max_Y - ColLeft.top);*)
DrawFrame(0);
G.Draw(Canvas_X, Canvas_Y);
DrawToolbar;
DrawStatus
@ -932,35 +928,22 @@ BEGIN
END Descr;
PROCEDURE Up*;
PROCEDURE Scroll* (n: INTEGER);
BEGIN
DEC(Ycur, LineH);
SU.MinMax(Ycur, Ymin, Ymax)
END Up;
PROCEDURE Down*;
BEGIN
INC(Ycur, LineH);
SU.MinMax(Ycur, Ymin, Ymax)
END Down;
INC(Ycur, LineH*n);
SU.MinMax(Ycur, Ymin, Ymax)
END Scroll;
PROCEDURE PageUp*;
VAR i: INTEGER;
BEGIN
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO
Up
END
Scroll(-Lines * (ORD(Settings.TwoCol) + 1))
END PageUp;
PROCEDURE PageDown*;
VAR i: INTEGER;
BEGIN
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO
Down
END
Scroll(Lines * (ORD(Settings.TwoCol) + 1))
END PageDown;
@ -1046,12 +1029,79 @@ BEGIN
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;
BEGIN
IF ~mouseDown THEN
mouseDown := TRUE;
clickRef := ref;
ref.Clicked := TRUE;
IF ref # NIL THEN
ref.Clicked := TRUE
END;
Draw
END
END MouseDown;
@ -1088,17 +1138,18 @@ BEGIN
Ymin := body.Ymin;
IF ~clickRef.Visited THEN
setVisited(clickRef);
clickRef.Visited := TRUE;
PushRef(clickRef)
END
ELSIF URL # 0 THEN
SU.Run(Ini.Browser, URL);
IF ~clickRef.Visited THEN
setVisited(clickRef);
clickRef.Visited := TRUE;
PushRef(clickRef)
END
END;
END
END;
IF clickRef # NIL THEN
clickRef.Clicked := FALSE;
@ -1129,7 +1180,7 @@ BEGIN
ref := NIL;
layout3(body, X, Y);
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;
hoverRef := ref;
IF clicked THEN
@ -1165,19 +1216,6 @@ BEGIN
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);
VAR
cur: XML.ELEMENT;
@ -1283,14 +1321,13 @@ BEGIN
IF y >= 0 THEN
DEC(y, y MOD LineH);
min := Ycur;
max := min + ColLeft.height - LineH;
IF Settings.TwoCol THEN
max := min + ColLeft.Height + ColRight.Height - LineH
ELSE
max := min + ColLeft.Height - LineH
INC(max, ColRight.height)
END;
IF (y < min) OR (y > max) THEN
Ycur := MAX(y - ColLeft.Height DIV 2, 0)
Ycur := MAX(y - ColLeft.height DIV 2, 0)
END;
DEC(Ycur, Ycur MOD LineH)
@ -1330,24 +1367,24 @@ BEGIN
Settings.PADDING.ColInter := G.Buffer.Width * Settings.PADDING.CInt DIV 100;
LineH := Font.FontH() + Settings.SUP + Settings.SUB + Settings.InterLin;
Window.InitRect(
Window.initRect(
ColLeft, Settings.PADDING.Left, Settings.PADDING.Top,
G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right,
G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom);
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.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter
ColRight.left := ColLeft.left + ColLeft.width + Settings.PADDING.ColInter
END;
W := ColLeft.Width;
Lines := ColLeft.Height DIV LineH;
ColLeft.Height := Lines * LineH;
ColRight.Height := ColLeft.Height;
W := ColLeft.width;
Lines := ColLeft.height DIV LineH;
ColLeft.height := Lines * LineH;
ColRight.height := ColLeft.height;
END FontSizeChange;
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);
VAR cur: StackItem;
@ -1374,13 +1411,18 @@ VAR d: REAL; resize: BOOLEAN; sizeX, sizeY, data: INTEGER;
BEGIN
resize := (Width # G.Buffer.Width) OR resized;
G.Resize(Width, Height);
G.SetColor(Settings.Colors[BACK_COLOR]);
IF (Settings.Picture # 0) & Settings.b_pict THEN
LibImg.GetInf(Settings.Picture, sizeX, sizeY, data);
G.BackImage(sizeX, sizeY, data);
back_picture := LibImg.GetImg(Settings.Picture, Settings.picture_fsize, 1000000, sizeY);
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
G.Clear;
G.Copy(G.Buffer, G.Buffer3, 0, G.Buffer.Height, 0)
G.DestroyBackImg;
G.Fill(G.Buffer, Settings.Colors[BACK_COLOR]);
//G.Fill(G.BackImg, Settings.Colors[BACK_COLOR])
END;
IF Font.FontH() # 0 THEN
@ -1389,16 +1431,16 @@ BEGIN
FontSizeChange(Settings.FontSize);
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
ColLeft.Width := (ColLeft.Width - Settings.PADDING.ColInter) DIV 2;
ColRight.Width := ColLeft.Width;
ColRight.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter
ColLeft.width := (ColLeft.width - Settings.PADDING.ColInter) DIV 2;
ColRight.width := ColLeft.width;
ColRight.left := ColLeft.left + ColLeft.width + Settings.PADDING.ColInter
END;
ColLeft.Height := G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom;
Lines := ColLeft.Height DIV LineH;
ColLeft.Height := Lines * LineH;
ColRight.Height := ColLeft.Height;
ColLeft.height := G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom;
Lines := ColLeft.height DIV LineH;
ColLeft.height := Lines * LineH;
ColRight.height := ColLeft.height;
IF done & resize THEN
resized := FALSE;
@ -1408,8 +1450,8 @@ BEGIN
IF contents # NIL THEN
d := FLT(Ycont) / FLT(contents.Ymax)
END;
W := ColLeft.Width;
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter;
W := ColLeft.width;
W2 := ColLeft.width + ColRight.width + Settings.PADDING.ColInter;
W1 := W;
main(XML.FB, FALSE);
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);
BEGIN
IF Write.Int(history, x) THEN END
IF File.WriteInt(history, x) THEN END
END WriteInt;
PROCEDURE WriteStk(history: File.FS; VAR stk: XML.LIST; links: BOOLEAN);
@ -1533,7 +1575,7 @@ BEGIN
END;
size := 1 + 18*4 + 1 + 8*(XML.ListCount(b_stk) + XML.ListCount(f_stk)) + 4*XML.ListCount(vis_ref) + 12;
WriteInt(history, size);
IF Write.Char(history, 0X) THEN END;
IF File.WriteChar(history, 0X) THEN END;
WriteInt(history, fsize2);
WriteInt(history, chksum);
SU.GetWindowSize(win_size_x, win_size_y);
@ -1546,7 +1588,7 @@ BEGIN
WriteInt(history, Settings.EPIGRAPH);
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, body.num);
@ -1568,7 +1610,7 @@ END Save;
PROCEDURE ReadInt(VAR x: INTEGER);
BEGIN
IF Read.Int(history, x) THEN END
IF File.ReadInt(history, x) THEN END
END ReadInt;
@ -1598,8 +1640,9 @@ VAR body_num, ycur, size, pos: INTEGER;
ReadInt(num);
ref := XML.GetTagByNum(num);
IF ref # NIL THEN
PushRef(ref);
ref.Visited := TRUE
setVisited(ref);
ref.Visited := TRUE;
PushRef(ref)
END;
DEC(n)
END
@ -1612,7 +1655,7 @@ BEGIN
ReadInt(Settings.PARAGRAPH);
ReadInt(Settings.EPIGRAPH);
ReadInt(Settings.InterLin);
IF Read.Boolean(history, Settings.TwoCol) THEN END;
IF File.ReadBool(history, Settings.TwoCol) THEN END;
ReadInt(Settings.FontSize);
SetSettings(Settings);
@ -1630,7 +1673,7 @@ BEGIN
ReadInt(size);
pos := File.Seek(history, -size, 1);
pos := File.Seek(history, 4, 1);
IF Write.Char(history, 1X) THEN END;
IF File.WriteChar(history, 1X) THEN END;
Ycur := ycur;
body := XML.GetTagByNum(body_num);
@ -1648,15 +1691,15 @@ BEGIN
pos := File.Seek(history, -4, 2);
last := FALSE;
WHILE pos >= 0 DO
IF Read.Int(history, size) THEN
IF File.ReadInt(history, size) THEN
pos := File.Seek(history, -size + 4, 1);
END;
IF Read.Char(history, c) THEN END;
IF File.ReadChar(history, c) THEN END;
ReadInt(fsize);
ReadInt(_chksum);
IF (c = 0X) & (fsize = fsize2) & (_chksum = chksum) THEN
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_y := y;
ELSE
@ -1674,7 +1717,7 @@ BEGIN
ReadInt(Settings.PARAGRAPH);
ReadInt(Settings.EPIGRAPH);
ReadInt(Settings.InterLin);
IF Read.Boolean(history, Settings.TwoCol) THEN END;
IF File.ReadBool(history, Settings.TwoCol) THEN END;
ReadInt(Settings.FontSize);
END;
pos := File.Seek(history, pos - 8, 0)
@ -1699,11 +1742,11 @@ BEGIN
FilePath := FName;
FileName := FName;
S.GetPath(FilePath);
W := ColLeft.Width;
W := ColLeft.width;
W1 := W;
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter;
Lines := ColLeft.Height DIV LineH;
ColLeft.Height := Lines * LineH;
W2 := ColLeft.width + ColRight.width + Settings.PADDING.ColInter;
Lines := ColLeft.height DIV LineH;
ColLeft.height := Lines * LineH;
PID := SU.NewThread(Start, Stack);
WHILE ~SU.IsTerminated(PID) DO
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;
SEARCH = 21;
KEY_DOWN_CODE = 177;
KEY_UP_CODE = 178;
KEY_PG_DOWN_CODE = 183;
KEY_PG_UP_CODE = 184;
KEY_HOME_CODE = 180;
KEY_END_CODE = 181;
KEY_F2_CODE = 51;
KEY_F3_CODE = 52;
KEY_F4_CODE = 53;
KEY_F10_CODE = 49;
KEY_DOWN = 80;
KEY_UP = 72;
KEY_PG_DOWN = 81;
KEY_PG_UP = 73;
KEY_HOME = 71;
KEY_END = 79;
KEY_F2 = 60;
KEY_F3 = 61;
KEY_F4 = 62;
KEY_F10 = 68;
TOOLBAR_LEFT = 5;
TOOLBAR_TOP = 6;
@ -60,7 +60,7 @@ CONST
VAR
Window : W.TWindow;
Window : W.tWindow;
toolbar : Toolbar.tToolbar;
SkinHeight : INTEGER;
Open : OpenDlg.Dialog;
@ -90,15 +90,15 @@ END ToolBar;
PROCEDURE Resize;
VAR Width, Height: INTEGER;
BEGIN
SU.GetWindowPos(Window.Left, Window.Top);
SU.GetWindowPos(Window.left, Window.top);
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(Height, 400, 65535);
Window.dWidth := Width - Window.Width;
Window.dHeight := Height - Window.Height;
Window.Width := Width;
Window.Height := Height;
Window.dWidth := Width - Window.width;
Window.dHeight := Height - Window.height;
Window.width := Width;
Window.height := Height;
SU.SetWindowSize(Width, Height);
DOM.Resize(G.Buffer.Width + Window.dWidth, G.Buffer.Height + Window.dHeight + (SkinHeight - SU.SkinHeight()));
SkinHeight := SU.SkinHeight()
@ -108,12 +108,12 @@ END Resize;
PROCEDURE DrawStatus;
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
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)
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)
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)
END
END DrawStatus;
@ -123,17 +123,17 @@ PROCEDURE DrawWindow;
BEGIN
SU.GetSystemColors;
SU.WindowRedrawStatus(1);
IF Window.Created THEN
IF Window.created THEN
Resize
ELSE
Window.Created := TRUE
Window.created := TRUE
END;
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.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, 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.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
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, 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(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
ToolBar;
DOM.Draw;
@ -145,8 +145,8 @@ END DrawWindow;
PROCEDURE ConvMousePos(VAR X, Y: INTEGER);
BEGIN
X := X - Window.Left - WINDOW_BEVEL - 1;
Y := Y - Window.Top - SkinHeight
X := X - Window.left - WINDOW_BEVEL - 1;
Y := Y - Window.top - SkinHeight
END ConvMousePos;
@ -177,22 +177,28 @@ END ButtonClick;
PROCEDURE KeyDown;
VAR
key: INTEGER;
shift, ctrl: BOOLEAN;
BEGIN
CASE SU.GetKeyCode() OF
|KEY_DOWN_CODE : DOM.Down
|KEY_UP_CODE : DOM.Up
|KEY_PG_DOWN_CODE : DOM.PageDown
|KEY_PG_UP_CODE : DOM.PageUp
|KEY_HOME_CODE : DOM.Home
|KEY_END_CODE : DOM.End
|KEY_F2_CODE : DOM.Find(0)
|KEY_F3_CODE : DOM.Find(1)
|KEY_F4_CODE : DOM.Find(-1)
|KEY_F10_CODE : DOM.CloseSearch
ELSE
END;
DOM.Draw;
DrawStatus
SU.getKBState(shift, ctrl);
key := SU.GetKey() DIV 65536;
CASE key OF
|KEY_DOWN : DOM.Scroll(1)
|KEY_UP : DOM.Scroll(-1)
|KEY_PG_DOWN : DOM.PageDown
|KEY_PG_UP : DOM.PageUp
|KEY_HOME : DOM.Home
|KEY_END : DOM.End
|KEY_F2 : DOM.Find(0)
|KEY_F3 : DOM.Find(1)
|KEY_F4 : DOM.Find(-1)
|KEY_F10 : DOM.CloseSearch
|33 : IF ctrl THEN DOM.OpenSearch END (* ctrl-F *)
ELSE
END;
DOM.Draw;
DrawStatus
END KeyDown;
@ -204,13 +210,10 @@ END CanvasIsClicked;
PROCEDURE MouseEvent;
VAR
mouse_status : SET;
X, Y : INTEGER;
scroll : INTEGER;
BEGIN
SU.MousePos(X, Y);
mouse_status := SU.MouseStatus();
@ -223,7 +226,7 @@ BEGIN
DOM.Click(X, Y, TRUE)
END
ELSIF scroll # 0 THEN
DOM.Scroll(scroll);
DOM.Scroll(scroll*2);
DOM.Draw
ELSE
ConvMousePos(X, Y);
@ -267,7 +270,7 @@ END IsFB2;
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
SkinHeight := SU.SkinHeight();
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.GetScreenArea(X1, Y1, X2, Y2);
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;
DOM.GetWinSize(FileName, Window.Width, Window.Height);
DOM.GetWinSize(FileName, Window.width, Window.height);
Win2 := Window;
resize := FALSE;
IF Win2.Width > X2 - X1 THEN
Win2.Width := X2 - X1;
IF Win2.width > X2 - X1 THEN
Win2.width := X2 - X1;
resize := TRUE
END;
IF Win2.Height > Y2 - Y1 THEN
Win2.Height := Y2 - Y1;
IF Win2.height > Y2 - Y1 THEN
Win2.height := Y2 - Y1;
resize := TRUE
END;
DOM.Init(CANVAS_LEFT, CANVAS_TOP,
Window.Width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH - 2,
Window.Height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1);
Window.width - 2 * CANVAS_LEFT - 2 * WINDOW_BEVEL - 1 - SCROLLBAR_WIDTH - 2,
Window.height - SkinHeight - CANVAS_TOP - WINDOW_BEVEL - STATUSBAR_HEIGHT + 1);
DOM.SetColors;
DOM.Set_b_pict(Ini.b_pict);
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);
S.Append(Window.Caption, " - ");
S.Append(Window.Caption, FileName);
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, FileName);
Toolbar.create(toolbar, TOOLBAR_LEFT, TOOLBAR_TOP);
Toolbar.add(toolbar, BACK, 30, "");
@ -339,7 +342,7 @@ BEGIN
DOM.Open(FileName, DrawWindow, DrawStatus, DrawToolbar);
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;
DrawWindow;
@ -362,5 +365,5 @@ END main;
BEGIN
main("FB2 Reader v0.97")
main("FB2 Reader v0.97a")
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
it under the terms of the GNU Lesser General Public License as published by
@ -252,4 +252,35 @@ BEGIN
RETURN res = 0
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.

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.
@ -19,11 +19,13 @@
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
kf_font, kf_loaded, kf_enabled: BOOLEAN;
kf_font, kf_enabled: BOOLEAN;
cp1251buf: ARRAY 102400 OF CHAR;
KFont*: KF.TFont;
@ -39,9 +41,9 @@ VAR
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
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;
@ -110,7 +112,7 @@ PROCEDURE TextWidth*(text: S.CHARS; length: INTEGER): INTEGER;
VAR res: INTEGER;
BEGIN
IF kf_font THEN
Conv.convert(text.first, sys.ADR(cp1251buf[0]), length);
Encoding.convert1251(text.first, sys.ADR(cp1251buf[0]), length);
res := KF.TextWidth(KFont, sys.ADR(cp1251buf[0]), length, ORD(Font.bold) + ORD(Font.italic) * 2)
ELSE
res := length * FontW()
@ -124,30 +126,30 @@ PROCEDURE MonoWidth*(): INTEGER;
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;
BEGIN
IF Font.strike THEN
y := Y + FontH() DIV 2;
// X := X + ORD(Font.italic & kf_font) * ((KF.TextHeight(KFont) DIV 2) DIV 3);
G.SetColor(Font.color);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top);
G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);
IF Font.size >= 28 THEN
INC(y);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top);
G.HLine(X + Rect.left, X + Rect.left + width, y + Rect.top);
END
END
END StrikeText;
PROCEDURE Text*(Rect: W.TRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER);
PROCEDURE Text*(Rect: W.tRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER);
BEGIN
IF kf_font THEN
Conv.convert(adr, sys.ADR(cp1251buf[0]), length);
KFText(X + Rect.Left, Y + Rect.Top, sys.ADR(cp1251buf[0]), length, G.Buffer)
Encoding.convert1251(adr, sys.ADR(cp1251buf[0]), length);
KFText(X + Rect.left, Y + Rect.top, sys.ADR(cp1251buf[0]), length, G.Buffer)
ELSE
G.SetColor(Font.color);
G.TextOut(X + Rect.Left, Y + Rect.Top, adr, length, Font.size, params())
G.TextOut(X + Rect.left, Y + Rect.top, adr, length, Font.size, params())
END
END Text;
@ -170,7 +172,6 @@ END Init;
BEGIN
KFont := KF.LoadFont(Ini.Font);
kf_loaded := KFont # NIL;
kf_font := kf_loaded;
kf_enabled := kf_loaded
kf_font := KFont # NIL;
kf_enabled := kf_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.
@ -19,44 +19,44 @@
MODULE Graph;
IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils, LibImg;
IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils;
TYPE
TBuffer = RECORD Width*, Height*, adr*, Color: INTEGER END;
PBuffer* = POINTER TO TBuffer;
tBuffer* = POINTER TO RECORD Width*, Height*, bitmap*, Color: INTEGER END;
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 Destroy*(VAR Buffer: PBuffer);
PROCEDURE Destroy*(VAR Buffer: tBuffer);
BEGIN
IF Buffer # NIL THEN
IF Buffer.adr # 0 THEN
DEC(Buffer.adr, 8);
Buffer.adr := K.free(Buffer.adr)
IF Buffer.bitmap # 0 THEN
DEC(Buffer.bitmap, 8);
Buffer.bitmap := K.free(Buffer.bitmap)
END;
DISPOSE(Buffer)
END
END Destroy;
PROCEDURE Create*(Width, Height: INTEGER): PBuffer;
VAR res: PBuffer;
PROCEDURE Create*(Width, Height: INTEGER): tBuffer;
VAR res: tBuffer;
BEGIN
NEW(res);
res.adr := K.malloc(Width * Height * 4 + 8);
sys.PUT(res.adr, Width);
sys.PUT(res.adr + 4, Height);
res.bitmap := K.malloc(Width * Height * 4 + 8);
sys.PUT(res.bitmap, Width);
sys.PUT(res.bitmap + 4, Height);
res.Width := Width;
res.Height := Height;
INC(res.adr, 8);
INC(res.bitmap, 8);
RETURN res
END Create;
@ -69,15 +69,15 @@ BEGIN
END getRGB;
PROCEDURE Fill*(Buffer: PBuffer; Color: INTEGER);
PROCEDURE Fill* (Buffer: tBuffer; Color: INTEGER);
VAR p, n, i: INTEGER;
BEGIN
p := Buffer.adr;
n := Buffer.Width * Buffer.Height;
FOR i := 1 TO n DO
sys.PUT(p, Color);
INC(p, 4)
END
p := Buffer.bitmap;
n := Buffer.Width * Buffer.Height;
FOR i := 1 TO n DO
sys.PUT(p, Color);
INC(p, 4)
END
END Fill;
@ -89,7 +89,7 @@ BEGIN
IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1);
color := Buffer.Color;
p1 := Buffer.adr + 4 * (Y * Buffer.Width + X1);
p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO
sys.PUT(i, color)
@ -106,7 +106,7 @@ VAR
BEGIN
IF X1 <= X2 THEN
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;
FOR i := p1 TO p2 BY 4 DO
sys.GET(i, pix);
@ -125,7 +125,7 @@ BEGIN
SU.MinMax(Y2, 0, Buffer.Height - 1);
color := Buffer.Color;
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;
WHILE p1 <= p2 DO
sys.PUT(p1, color);
@ -165,15 +165,15 @@ END GetColor;
PROCEDURE TextOut*(X, Y: INTEGER; Text: INTEGER; length: INTEGER; size, params: INTEGER);
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;
PROCEDURE Resize2*(Width, Height: INTEGER);
PROCEDURE InitSize* (Width, Height: INTEGER);
BEGIN
Buffer2.Width := Width;
Buffer2.Height := Height;
END Resize2;
Width0 := Width;
Height0 := Height;
END InitSize;
PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER);
@ -183,14 +183,14 @@ BEGIN
ASSERT(sizeX <= Buffer.Width);
FOR y := 0 TO sizeY - 1 DO
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;
INC(Y)
END
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;
BEGIN
left := X;
@ -199,7 +199,7 @@ BEGIN
FOR x := 0 TO sizeX - 1 DO
sys.GET32(ptr + (y*sizeX + x)*4, pix);
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;
INC(X)
END;
@ -213,10 +213,10 @@ VAR x, y: INTEGER;
BEGIN
IF ptr # 0 THEN
y := 0;
WHILE y < Buffer3.Height DO
WHILE y < BackImg.Height DO
x := 0;
WHILE x < Buffer3.Width DO
Image2(Buffer3, x, y, sizeX, sizeY, ptr);
WHILE x < BackImg.Width DO
Image2(BackImg, x, y, sizeX, sizeY, ptr);
INC(x, sizeX)
END;
INC(y, sizeY)
@ -225,25 +225,15 @@ BEGIN
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
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;
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);
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;
@ -259,11 +249,10 @@ END Rect;
PROCEDURE Progress*(value: REAL);
VAR W4, W2, H2: INTEGER;
BEGIN
W4 := Buffer2.Width DIV 4;
W2 := Buffer2.Width DIV 2;
H2 := Buffer2.Height DIV 2;
SetColor(0FFFFFFH);
Clear;
W2 := Width0 DIV 2;
W4 := W2 DIV 2;
H2 := Height0 DIV 2;
Fill(Buffer, 0FFFFFFH);
SetColor(0);
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));
@ -272,39 +261,54 @@ BEGIN
END Progress;
PROCEDURE Resize3(Buffer: PBuffer; Width, Height: INTEGER);
PROCEDURE _resize (Buffer: tBuffer; Width, Height: INTEGER);
BEGIN
IF Buffer.adr # 0 THEN
DEC(Buffer.adr, 8)
IF Buffer.bitmap # 0 THEN
DEC(Buffer.bitmap, 8)
END;
Buffer.adr := K.realloc(Buffer.adr, Width * Height * 4 + 8);
SU.MemError(Buffer.adr = 0);
sys.PUT(Buffer.adr, Width);
sys.PUT(Buffer.adr + 4, Height);
INC(Buffer.adr, 8);
Buffer.bitmap := K.realloc(Buffer.bitmap, Width * Height * 4 + 8);
SU.MemError(Buffer.bitmap = 0);
sys.PUT(Buffer.bitmap, Width);
sys.PUT(Buffer.bitmap + 4, Height);
INC(Buffer.bitmap, 8);
Buffer.Width := Width;
Buffer.Height := Height
END Resize3;
END _resize;
PROCEDURE Resize*(Width, Height: INTEGER);
BEGIN
Resize3(Buffer, Width, Height);
Resize3(Buffer3, Width, Height);
_resize(Buffer, Width, Height);
IF BackImg # NIL THEN
_resize(BackImg, Width, Height)
END
END Resize;
PROCEDURE Init;
VAR Width, Height: INTEGER;
BEGIN
NEW(Buffer);
NEW(Buffer2);
NEW(Buffer3);
SU.GetScreenSize(Width, Height);
Resize(Width, Height)
BackImg := NIL;
NEW(Buffer);
SU.GetScreenSize(Width, Height);
Resize(Width, Height)
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
Init
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.
@ -19,21 +19,29 @@
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_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_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 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);
BEGIN
sys.GET(img + 4, sizeX);
sys.GET(img + 8, sizeY);
sys.GET(img + 24, data)
SYSTEM.GET(img + 4, sizeX);
SYSTEM.GET(img + 8, sizeY);
SYSTEM.GET(img + 24, data)
END GetInf;
@ -43,9 +51,9 @@ VAR
BEGIN
image_data := img_decode(ptr, size, 0);
IF image_data # 0 THEN
sys.GET(image_data + 4, x);
sys.GET(image_data + 8, y);
sys.GET(image_data + 20, type);
SYSTEM.GET(image_data + 4, x);
SYSTEM.GET(image_data + 8, y);
SYSTEM.GET(image_data + 20, type);
IF type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data);
@ -57,7 +65,7 @@ BEGIN
image_data := dst
END;
IF image_data # 0 THEN
sys.GET(image_data + 8, sizeY)
SYSTEM.GET(image_data + 8, sizeY)
END
END
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
it under the terms of the GNU Lesser General Public License as published by
@ -17,7 +17,7 @@
MODULE OpenDlg;
IMPORT sys := SYSTEM, KOSAPI, S := Strings;
IMPORT sys := SYSTEM;
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.
@ -19,7 +19,7 @@
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
@ -87,7 +87,7 @@ BEGIN
END Free;
PROCEDURE Conv*(cp: Encode.CP);
PROCEDURE Conv*(cp: Encoding.tCodePage);
VAR m, nov, mem2, k: INTEGER; c: CHAR;
BEGIN
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.
@ -22,7 +22,7 @@ MODULE Search;
IMPORT
XML, G := Graph, Window, Font, S := Strings, LISTS, SYSTEM,
SU := SysUtils, K := KOSAPI, SearchForm;
SU := SysUtils, K := KOSAPI, SearchForm, Encoding;
TYPE
@ -72,7 +72,7 @@ VAR
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
y, y0, color: INTEGER;
@ -85,12 +85,12 @@ BEGIN
ELSE
color := 0
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 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
rect: TRect;
pos, cur: TPos;
@ -107,9 +107,9 @@ BEGIN
WHILE pos # NIL DO
rect := pos.RectList.first(TRect);
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
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;
rect := rect.next(TRect)
END;
@ -118,45 +118,6 @@ BEGIN
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);
VAR
cur: XML.ELEMENT;
@ -214,20 +175,18 @@ BEGIN
END cap;
PROCEDURE UpCase (s1, s2, length: INTEGER);
PROCEDURE upcase (src, dst, length: INTEGER);
VAR
code, n: INTEGER;
u: S.UTF8;
n: INTEGER;
u: Encoding.tUtf8;
BEGIN
WHILE length > 0 DO
getc_utf8(s1, length, code);
S.utf8(cap(code), u);
Encoding.utf8(cap(Encoding.getUtf8Char(src, length)), u);
n := LENGTH(u);
SYSTEM.MOVE(SYSTEM.ADR(u[0]), s2, n);
INC(s2, n)
SYSTEM.MOVE(SYSTEM.ADR(u[0]), dst, n);
INC(dst, n)
END
END UpCase;
END upcase;
PROCEDURE create (body: XML.ELEMENT);
@ -304,7 +263,7 @@ BEGIN
buf1 := K.malloc(length);
SU.MemError(buf1 = 0);
UpCase(buf, buf1, length);
upcase(buf, buf1, length);
NEW(text.idx1);
index(text.idx1, buf1, text.idx0.size);
@ -482,7 +441,7 @@ BEGIN
text.PosList := LISTS.create(NIL);
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
idx := text.idx0;
@ -588,6 +547,7 @@ PROCEDURE close*;
VAR
text: Text;
body: XML.TAG;
nullptr: INTEGER;
BEGIN
body := Body;
@ -596,7 +556,15 @@ BEGIN
LISTS.destroy(text.PosList);
text.PosList := LISTS.create(NIL);
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 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.
@ -21,7 +21,7 @@ MODULE SearchForm;
IMPORT
SYSTEM, SU := SysUtils, W := Window, box_lib, K := KOSAPI, Encode, S := Strings;
SYSTEM, SU := SysUtils, W := Window, box_lib, K := KOSAPI, Encoding;
CONST
@ -49,7 +49,7 @@ VAR
PID, Slot: INTEGER;
Stack: ARRAY 1000000 OF CHAR;
Window: W.TWindow;
Window: W.tWindow;
str: STRING;
callback: PROC;
@ -80,8 +80,8 @@ PROCEDURE DrawWindow;
BEGIN
SU.GetSystemColors;
SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption);
SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
@ -92,7 +92,7 @@ VAR
pid, i, j, k, n: INTEGER;
found: BOOLEAN;
str0: STRING;
u: S.UTF8;
u: Encoding.tUtf8;
BEGIN
found := TRUE;
@ -103,8 +103,8 @@ BEGIN
j := 0;
i := 0;
WHILE str[i] # 0X DO
u := Encode.CP866[ORD(str[i])].utf8;
n := Encode.CP866[ORD(str[i])].len;
u := Encoding.cp866[ORD(str[i])].utf8;
n := Encoding.cp866[ORD(str[i])].len;
FOR k := 0 TO n - 1 DO
str0[j] := u[k];
INC(j)
@ -148,19 +148,19 @@ VAR
BEGIN
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);
Window.Left := (scrWidth - Window.Width) DIV 2;
Window.Top := (scrHeight - Window.Height) DIV 2;
Window.left := (scrWidth - Window.width) DIV 2;
Window.top := (scrHeight - Window.height) DIV 2;
DrawWindow;
WHILE TRUE DO
CASE SU.WaitForEvent() OF
|1: DrawWindow
|2: key := K.sysfunc1(2);
IF key DIV 65536 = 28 THEN
|2: key := SU.GetKey();
IF key DIV 65536 = 28 THEN (* enter *)
close(TRUE)
ELSIF key DIV 65536 = 1 THEN
ELSIF key DIV 65536 = 1 THEN (* esc *)
close(FALSE)
ELSE
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.
@ -20,40 +20,42 @@
MODULE SelEnc;
IMPORT
SU := SysUtils, W := Window, OpenDlg, S := Strings, TXT := Txt2FB2, SYSTEM, K := KOSAPI, Settings, File;
SU := SysUtils, W := Window, S := Strings, SYSTEM, K := KOSAPI, File;
CONST
AUTO = 15;
CP866 = 16;
CP1251 = 17;
CP1252 = 18;
CP1250 = 19;
UTF8 = 20;
BtnH = 30;
BtnW = 150;
BtnX = 5;
BtnY = 10;
BtnInter = 10;
BtnH = 30;
BtnW = 150;
BtnX = 5;
BtnY = 10;
BtnInter = 10;
tempfile* = "/tmp0/1/~temp.fb2";
VAR
Window : W.TWindow;
ENCODING* : INTEGER;
FileName : S.STRING;
Window: W.tWindow;
pos, mem, mem2, pos2: INTEGER;
PROCEDURE Buttons;
VAR
Y : INTEGER;
BEGIN
Y := BtnY;
SU.CreateButton(TXT.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(TXT.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(TXT.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(AUTO, BtnX, Y, BtnW, BtnH, SU.btnColor, "AUTO" ); INC(Y, BtnH + BtnInter);
SU.CreateButton(CP866, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-866" ); INC(Y, BtnH + BtnInter);
SU.CreateButton(CP1251, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1251"); INC(Y, BtnH + BtnInter);
SU.CreateButton(CP1252, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1252"); INC(Y, BtnH + BtnInter);
SU.CreateButton(CP1250, BtnX, Y, BtnW, BtnH, SU.btnColor, "CP-1250"); INC(Y, BtnH + BtnInter);
SU.CreateButton(UTF8, BtnX, Y, BtnW, BtnH, SU.btnColor, "UTF-8" )
END Buttons;
@ -61,16 +63,94 @@ PROCEDURE DrawWindow;
BEGIN
SU.GetSystemColors;
SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption);
SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
Buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
PROCEDURE auto (fname: S.STRING): INTEGER;
PROCEDURE getch (): CHAR;
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;
@ -96,39 +176,32 @@ VAR
BEGIN
data := File.Load(fname, size);
SU.ErrorIf(data = 0, 1);
ptr := data;
IF SearchPair(ptr, size, 208, 190) THEN
enc := TXT.UTF8
enc := UTF8
ELSE
IF SearchPair(ptr, size, 239, 240) OR SearchPair(ptr, size, 241, 242) THEN
enc := TXT.CP1251
enc := CP1251
ELSE
enc := TXT.CP866
enc := CP866
END
END;
data := K.free(data)
END
RETURN enc
END auto;
PROCEDURE ButtonClick;
PROCEDURE ButtonClick (fname: S.STRING);
VAR
btn_code: INTEGER;
encoding: INTEGER;
program, file: S.STRING;
data, size: INTEGER;
BEGIN
btn_code := SU.GetButtonCode();
IF btn_code = TXT.AUTO THEN
ENCODING := auto(FileName)
ELSE
ENCODING := btn_code
data := File.Load(fname, size);
SU.ErrorIf(data = 0, 1);
encoding := SU.GetButtonCode();
IF encoding = AUTO THEN
encoding := auto(data, size)
END;
TXT.convert(FileName, tempfile, ENCODING);
convert(data, size, tempfile, encoding);
S.PtrToString(K.GetName(), program);
file := tempfile;
file[0] := "!";
@ -137,27 +210,23 @@ BEGIN
END ButtonClick;
PROCEDURE Show*(FName: S.STRING);
PROCEDURE Show* (fname: S.STRING);
VAR
X1, Y1, X2, Y2: INTEGER;
BEGIN
FileName := FName;
SU.SetEventsMask({0, 2, 31});
SU.GetScreenArea(X1, Y1, X2, Y2);
W.InitWindow(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.Top := (Y2 - Y1 - Window.Height) DIV 2;
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.top := (Y2 - Y1 - Window.height) DIV 2;
DrawWindow;
WHILE TRUE DO
CASE SU.WaitForEvent() OF
|1 : DrawWindow
|3 : ButtonClick
|1: DrawWindow
|3: ButtonClick(fname)
END
END
END Show;
BEGIN
ENCODING := 0
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.
@ -19,7 +19,7 @@
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;
@ -56,7 +56,7 @@ CONST
VAR
Window : W.TWindow;
Window : W.tWindow;
PID : INTEGER;
Slot : INTEGER;
Color : C.Dialog;
@ -69,6 +69,7 @@ VAR
check2 : box_lib.checkbox;
OpenPict : OD.Dialog;
picture : INTEGER;
picture_fsize : INTEGER;
picture_path : S.STRING;
@ -79,8 +80,9 @@ BEGIN
IF PID # 0 THEN
pid := PID;
PID := 0;
IF (picture # 0) & (picture # Data.Picture) THEN
LibImg.img_destroy(picture)
IF (picture # Data.Picture) & (picture # 0) THEN
picture := K.free(picture);
picture_fsize := 0
END;
C.Destroy(Color);
OD.Destroy(OpenPict);
@ -91,7 +93,7 @@ END Close;
PROCEDURE ClearWindow;
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;
@ -130,18 +132,18 @@ VAR
X, Y, TextY : INTEGER;
WinW, WinH, SkinH : INTEGER;
i : INTEGER;
Rect : W.TRect;
Rect : W.tRect;
BEGIN
Rect.Left := 10;
Rect.Top := 85;
Rect.Width := 210;
Rect.Height := 255;
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);
Rect.left := 10;
Rect.top := 85;
Rect.width := 210;
Rect.height := 255;
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);
WinW := Window.Width;
WinH := Window.Height;
WinW := Window.width;
WinH := Window.height;
SkinH := SU.SkinHeight();
X := 125;
Y := 10;
@ -178,8 +180,8 @@ BEGIN
Y := Y - 6;
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(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(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");
@ -197,8 +199,8 @@ PROCEDURE DrawWindow;
BEGIN
SU.GetSystemColors;
SU.WindowRedrawStatus(1);
SU.DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.Caption);
SU.DefineAndDrawWindow(Window.left, Window.top, Window.width, Window.height,
SU.winColor, LSL(ORD({0, 1}), 4) + 4, Window.caption);
Buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
@ -258,28 +260,31 @@ BEGIN
Data.PARAGRAPH := sb[4].position;
Data.EPIGRAPH := sb[5].position;
Data.InterLin := sb[6].position;
IF Data.Picture # picture THEN
IF Data.Picture # 0 THEN
LibImg.img_destroy(Data.Picture)
IF (picture # 0) & (picture # Data.Picture) THEN
IF Data.Picture # 0 THEN
Data.Picture := K.free(Data.Picture)
END;
Data.Picture := picture;
Data.picture_fsize := picture_fsize;
Ini.SetPicturePath(picture_path)
END;
picture := 0;
picture_fsize := 0;
DOM.SetSettings(Data);
Close
END Apply;
PROCEDURE LoadPicture(file_path: S.STRING);
VAR ysize, img: INTEGER;
VAR fsize, img: INTEGER;
BEGIN
img := LibImg.LoadFromFile(file_path, 10240000, ysize);
img := File.Load(file_path, fsize);
IF img # 0 THEN
IF (picture # 0) & (picture # Data.Picture) THEN
LibImg.img_destroy(picture)
picture := K.free(picture)
END;
picture := img;
picture_fsize := fsize;
picture_path := file_path
END
END LoadPicture;
@ -335,6 +340,7 @@ BEGIN
Data.EPIGRAPH := 100;
Data.InterLin := 0;
Data.Picture := picture;
Data.picture_fsize := picture_fsize;
DOM.SetSettings(Data)
END Default;
@ -343,14 +349,15 @@ PROCEDURE Show;
VAR i, scrWidth, scrHeight: INTEGER;
BEGIN
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);
Window.Left := (scrWidth - Window.Width) DIV 2;
Window.Top := (scrHeight - Window.Height) DIV 2;
Window.left := (scrWidth - Window.width) DIV 2;
Window.top := (scrHeight - Window.height) DIV 2;
Color := C.Create(DrawWindow);
OpenPict := OD.Create(DrawWindow, 0, "/sys", "JPG|PNG|BMP|GIF");
Data := DOM.Settings;
picture := Data.Picture;
picture_fsize := Data.picture_fsize;
DrawWindow;
WHILE TRUE DO
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);
check1 := box_lib.kolibri_new_check_box(TextLeft, 10 + (BtnH + 10) + 5, 16, 16, sys.SADR(""), LENGTH(twocol) * 8 + 5);
picture := 0;
picture_fsize := 0;
IF Ini.Picture # "" THEN
LoadPicture(Ini.Picture)
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.
@ -19,15 +19,13 @@
MODULE Strings;
IMPORT sys := SYSTEM, KOSAPI;
IMPORT sys := SYSTEM, Encoding;
TYPE
STRING* = ARRAY 1024 OF CHAR;
UTF8* = ARRAY 8 OF CHAR;
CHARS* = RECORD first*, last* : INTEGER END;
@ -290,30 +288,6 @@ BEGIN
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;
VAR
i : INTEGER;
@ -324,7 +298,7 @@ VAR
exit : BOOLEAN;
str : STRING;
str2 : STRING;
uchar : UTF8;
uchar : Encoding.tUtf8;
res : BOOLEAN;
BEGIN
@ -361,7 +335,7 @@ BEGIN
IF c = ";" THEN
str2[0] := c;
Append(str, str2);
utf8(val, uchar);
Encoding.utf8(val, uchar);
Replace(chars, str, uchar);
res := TRUE;
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.
@ -135,7 +135,7 @@ END MouseVScroll;
PROCEDURE MouseStatus*(): SET;
RETURN BITS(K.sysfunc2(37, 2))
RETURN BITS(K.sysfunc2(37, 3))
END MouseStatus;
@ -167,9 +167,24 @@ BEGIN
END SetEventsMask;
PROCEDURE GetKeyCode*(): INTEGER;
RETURN LSR(LSL(K.sysfunc1(2), 16), 24)
END GetKeyCode;
PROCEDURE GetKey* (): INTEGER;
RETURN K.sysfunc1(2)
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;

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.
@ -19,86 +19,90 @@
MODULE Vector;
IMPORT SYSTEM, K := KOSAPI;
IMPORT sys := SYSTEM, K := KOSAPI;
CONST
ptr_size = 4;
TYPE
DESC_VECTOR = RECORD
DESC_VECTOR = RECORD
data : INTEGER;
count* : INTEGER;
size : INTEGER
END;
data : INTEGER;
count* : INTEGER;
size : INTEGER
VECTOR* = POINTER TO DESC_VECTOR;
END;
ANYREC* = RECORD END;
VECTOR* = POINTER TO DESC_VECTOR;
ANYPTR* = POINTER TO ANYREC;
ANYREC* = RECORD END;
ANYPTR* = POINTER TO ANYREC;
DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
PROCEDURE push* (vector: VECTOR; value: ANYPTR);
BEGIN
IF vector.count = vector.size THEN
vector.data := K.realloc(vector.data, (vector.size + 1024) * 4);
vector.size := vector.size + 1024
END;
sys.PUT(vector.data + vector.count * 4, value);
INC(vector.count)
IF vector.count = vector.size THEN
vector.data := K.realloc(vector.data, (vector.size + 1024) * ptr_size);
vector.size := vector.size + 1024
END;
SYSTEM.PUT(vector.data + vector.count * ptr_size, value);
INC(vector.count)
END push;
PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR;
VAR res: ANYPTR;
VAR
res: ANYPTR;
BEGIN
ASSERT( (0 <= idx) & (idx < vector.count) );
sys.GET(vector.data + idx * 4, res)
RETURN res
ASSERT( (0 <= idx) & (idx < vector.count) );
SYSTEM.GET(vector.data + idx * ptr_size, res)
RETURN res
END get;
PROCEDURE put* (vector: VECTOR; idx: INTEGER; value: ANYPTR);
BEGIN
ASSERT( (0 <= idx) & (idx < vector.count) );
sys.PUT(vector.data + idx * 4, value)
ASSERT( (0 <= idx) & (idx < vector.count) );
SYSTEM.PUT(vector.data + idx * ptr_size, value)
END put;
PROCEDURE create* (size: INTEGER): VECTOR;
VAR vector: VECTOR;
VAR
vector: VECTOR;
BEGIN
NEW(vector);
vector.data := K.malloc(4 * size);
vector.size := size;
vector.count := 0
RETURN vector
NEW(vector);
vector.data := K.malloc(ptr_size * size);
vector.size := size;
vector.count := 0
RETURN vector
END create;
PROCEDURE def_destructor (VAR any: ANYPTR);
BEGIN
DISPOSE(any)
DISPOSE(any)
END def_destructor;
PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR);
VAR i: INTEGER;
any: ANYPTR;
VAR
i: INTEGER;
any: ANYPTR;
BEGIN
IF destructor = NIL THEN
destructor := def_destructor
END;
FOR i := 0 TO vector.count - 1 DO
any := get(vector, i);
destructor(any)
END;
vector.data := K.free(vector.data);
DISPOSE(vector)
IF destructor = NIL THEN
destructor := def_destructor
END;
FOR i := 0 TO vector.count - 1 DO
any := get(vector, i);
destructor(any)
END;
vector.data := K.free(vector.data);
DISPOSE(vector)
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.
@ -23,36 +23,34 @@ IMPORT S := Strings;
TYPE
TRect* = RECORD
Left*, Top*, Width*, Height* : INTEGER
END;
tRect* = RECORD
left*, top*, width*, height* : INTEGER
END;
TWindow* = RECORD (TRect)
Caption* : S.STRING;
Created* : BOOLEAN;
dWidth*, dHeight* : INTEGER
END;
tWindow* = RECORD (tRect)
caption* : S.STRING;
created* : BOOLEAN;
dWidth*, dHeight* : INTEGER
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
Window.Left := Left;
Window.Top := Top;
Window.Width := Width;
Window.Height := Height;
Window.Created := FALSE;
Window.dWidth := 0;
Window.dHeight := 0;
COPY(Caption, Window.Caption)
END InitWindow;
Rect.left := left;
Rect.top := top;
Rect.width := width;
Rect.height := height
END initRect;
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
Rect.Left := Left;
Rect.Top := Top;
Rect.Width := Width;
Rect.Height := Height
END InitRect;
initRect(window, left, top, width, height);
window.created := FALSE;
window.dWidth := 0;
window.dHeight := 0;
COPY(caption, window.caption)
END init;
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.
@ -19,7 +19,7 @@
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
@ -135,7 +135,7 @@ VAR
tire1, tire2, nbsp, ellipsis, apo,
quot1, quot2, quot3, quot4, quot5, quot6, quot7,
number, bullet, euro,
dash1, dash2: S.UTF8;
dash1, dash2: E.tUtf8;
num: INTEGER;
Tags: V.VECTOR;
@ -678,13 +678,13 @@ BEGIN
DEC(chars.last);
S.SetCS(FALSE);
IF S.CharsEqStr(chars, "windows-1250") THEN
RF.Conv(Encode.W1250)
RF.Conv(E.cp1250)
ELSIF S.CharsEqStr(chars, "windows-1251") THEN
RF.Conv(Encode.W1251)
RF.Conv(E.cp1251)
ELSIF S.CharsEqStr(chars, "windows-1252") THEN
RF.Conv(Encode.W1252)
RF.Conv(E.cp1252)
ELSIF S.CharsEqStr(chars, "cp866" ) THEN
RF.Conv(Encode.CP866)
RF.Conv(E.cp866)
ELSIF S.CharsEqStr(chars, "utf-8" ) THEN
RF.SeekBeg
ELSE
@ -729,23 +729,23 @@ END Open;
PROCEDURE Init;
BEGIN
S.utf8(8212, tire1);
S.utf8(8211, tire2);
S.utf8( 160, nbsp);
S.utf8(8230, ellipsis);
S.utf8(8217, apo);
S.utf8(8220, quot1);
S.utf8(8221, quot2);
S.utf8(8222, quot3);
S.utf8(8216, quot4);
S.utf8(8218, quot5);
S.utf8(8249, quot6);
S.utf8(8250, quot7);
S.utf8(8470, number);
S.utf8(8208, dash1);
S.utf8(8209, dash2);
S.utf8(8226, bullet);
S.utf8(8364, euro);
E.utf8(8212, tire1);
E.utf8(8211, tire2);
E.utf8( 160, nbsp);
E.utf8(8230, ellipsis);
E.utf8(8217, apo);
E.utf8(8220, quot1);
E.utf8(8221, quot2);
E.utf8(8222, quot3);
E.utf8(8216, quot4);
E.utf8(8218, quot5);
E.utf8(8249, quot6);
E.utf8(8250, quot7);
E.utf8(8470, number);
E.utf8(8208, dash1);
E.utf8(8209, dash2);
E.utf8(8226, bullet);
E.utf8(8364, euro);
Tags := V.create(1024)
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.
@ -48,7 +48,7 @@ TYPE
scrollbar* = POINTER TO RECORD
x_w: INTEGER;
x_w*: INTEGER;
y_h*: INTEGER;
btn_height: 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.