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

FB2 Reader: upload source, small changes

Browse Source 
git-svn-id: svn://kolibrios.org@9896 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2023-01-22 14:20:23 +00:00
parent 61fbb36ac3
commit 4c20c082c1
40 changed files with 10066 additions and 2 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.

2
programs/develop/cedit/BUILD.SH
View File

@ -1,3 +1,3 @@
#SHS #SHS
/kolibrios/develop/oberon07/compiler.kex ./src/cedit.ob07 kosexe -out /tmp0/1/cedit -stk 1 -nochk a /kolibrios/develop/oberon07/compiler.kex ./src/cedit.ob07 kosexe -out /tmp0/1/cedit.kex -stk 1 -nochk a
exit exit

2
programs/develop/cedit/RUN.SH
View File

@ -1,3 +1,3 @@
#SHS #SHS
/tmp0/1/cedit /tmp0/1/cedit.kex
exit exit

3
programs/other/fb2reader/BUILD.SH Normal file
View File

@ -0,0 +1,3 @@
#SHS
/kolibrios/develop/oberon07/compiler.kex ./src/fb2read.ob07 kosexe -out /tmp0/1/fb2read.kex -stk 1 -nochk a -upper
exit

16
programs/other/fb2reader/FB2READ.INI Normal file
View File

@ -0,0 +1,16 @@
[Paths]
history=/sys/settings/fb2_hist.dat
browser=/sys/network/webview
default=/sys
font=/sys/fonts/tahoma.kf
picture=
[Files]
files=fb2|asm|txt|ini
[Flags]
picture=off
[Colors]
back=240,240,199
text=0,0,0
italic=80,80,80
link=0,0,255
visited=128,0,128

3
programs/other/fb2reader/RUN.SH Normal file
View File

@ -0,0 +1,3 @@
#SHS
/tmp0/1/fb2read.kex
exit

290
programs/other/fb2reader/SRC/API.ob07 Normal file
View File

@ -0,0 +1,290 @@
(*
BSD 2-Clause License
Copyright (c) 2018, 2020-2022, Anton Krotov
All rights reserved.
*)
MODULE API;
IMPORT SYSTEM, K := KOSAPI;
CONST
eol* = 0DX + 0AX;
BIT_DEPTH* = 32;
MAX_SIZE = 16 * 400H;
HEAP_SIZE = 1 * 100000H;
_new = 1;
_dispose = 2;
SizeOfHeader = 36;
TYPE
CRITICAL_SECTION = ARRAY 2 OF INTEGER;
VAR
heap, endheap: INTEGER;
pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
CriticalSection: CRITICAL_SECTION;
multi: BOOLEAN;
base*: INTEGER;
PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER);
BEGIN
SYSTEM.CODE(
0FCH, (* cld *)
031H, 0C0H, (* xor eax, eax *)
057H, (* push edi *)
08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *)
0F3H, 0ABH, (* rep stosd *)
05FH (* pop edi *)
)
END zeromem;
PROCEDURE mem_commit* (adr, size: INTEGER);
VAR
tmp: INTEGER;
BEGIN
FOR tmp := adr TO adr + size - 1 BY 4096 DO
SYSTEM.PUT(tmp, 0)
END
END mem_commit;
PROCEDURE switch_task;
BEGIN
K.sysfunc2(68, 1)
END switch_task;
PROCEDURE futex_create (ptr: INTEGER): INTEGER;
RETURN K.sysfunc3(77, 0, ptr)
END futex_create;
PROCEDURE futex_wait (futex, value, timeout: INTEGER);
BEGIN
K.sysfunc5(77, 2, futex, value, timeout)
END futex_wait;
PROCEDURE futex_wake (futex, number: INTEGER);
BEGIN
K.sysfunc4(77, 3, futex, number)
END futex_wake;
PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
switch_task;
futex_wait(CriticalSection[0], 1, 10000);
CriticalSection[1] := 1
END EnterCriticalSection;
PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
CriticalSection[1] := 0;
futex_wake(CriticalSection[0], 1)
END LeaveCriticalSection;
PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1]));
CriticalSection[1] := 0
END InitializeCriticalSection;
PROCEDURE __NEW (size: INTEGER): INTEGER;
VAR
res, idx, temp: INTEGER;
BEGIN
IF size <= MAX_SIZE THEN
idx := ASR(size, 5);
res := pockets[idx];
IF res # 0 THEN
SYSTEM.GET(res, pockets[idx]);
SYSTEM.PUT(res, size);
INC(res, 4)
ELSE
temp := 0;
IF heap + size >= endheap THEN
IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
temp := K.sysfunc3(68, 12, HEAP_SIZE)
ELSE
temp := 0
END;
IF temp # 0 THEN
mem_commit(temp, HEAP_SIZE);
heap := temp;
endheap := heap + HEAP_SIZE
ELSE
temp := -1
END
END;
IF (heap # 0) & (temp # -1) THEN
SYSTEM.PUT(heap, size);
res := heap + 4;
heap := heap + size
ELSE
res := 0
END
END
ELSE
IF K.sysfunc2(18, 16) > ASR(size, 10) THEN
res := K.sysfunc3(68, 12, size);
IF res # 0 THEN
mem_commit(res, size);
SYSTEM.PUT(res, size);
INC(res, 4)
END
ELSE
res := 0
END
END;
IF (res # 0) & (size <= MAX_SIZE) THEN
zeromem(ASR(size, 2) - 1, res)
END
RETURN res
END __NEW;
PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER;
VAR
size, idx: INTEGER;
BEGIN
DEC(ptr, 4);
SYSTEM.GET(ptr, size);
IF size <= MAX_SIZE THEN
idx := ASR(size, 5);
SYSTEM.PUT(ptr, pockets[idx]);
pockets[idx] := ptr
ELSE
size := K.sysfunc3(68, 13, ptr)
END
RETURN 0
END __DISPOSE;
PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IF multi THEN
EnterCriticalSection(CriticalSection)
END;
IF func = _new THEN
res := __NEW(arg)
ELSIF func = _dispose THEN
res := __DISPOSE(arg)
END;
IF multi THEN
LeaveCriticalSection(CriticalSection)
END
RETURN res
END NEW_DISPOSE;
PROCEDURE _NEW* (size: INTEGER): INTEGER;
RETURN NEW_DISPOSE(_new, size)
END _NEW;
PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
RETURN NEW_DISPOSE(_dispose, ptr)
END _DISPOSE;
PROCEDURE exit* (p1: INTEGER);
BEGIN
K.sysfunc1(-1)
END exit;
PROCEDURE exit_thread* (p1: INTEGER);
BEGIN
K.sysfunc1(-1)
END exit_thread;
PROCEDURE OutStr (pchar: INTEGER);
VAR
c: CHAR;
BEGIN
IF pchar # 0 THEN
REPEAT
SYSTEM.GET(pchar, c);
IF c # 0X THEN
K.OutChar(c)
END;
INC(pchar)
UNTIL c = 0X
END
END OutStr;
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN
IF lpCaption # 0 THEN
K.OutLn;
OutStr(lpCaption);
K.OutChar(":");
K.OutLn
END;
OutStr(lpText);
IF lpCaption # 0 THEN
K.OutLn
END
END DebugMsg;
PROCEDURE init* (import_, code: INTEGER);
BEGIN
multi := FALSE;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init(import_)
END init;
PROCEDURE SetMultiThr* (value: BOOLEAN);
BEGIN
multi := value
END SetMultiThr;
PROCEDURE GetTickCount* (): INTEGER;
RETURN K.sysfunc2(26, 9) * 10
END GetTickCount;
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
RETURN 0
END dllentry;
PROCEDURE sofinit*;
END sofinit;
END API.

87
programs/other/fb2reader/SRC/ColorDlg.ob07 Normal file
View File

@ -0,0 +1,87 @@
(*
Copyright 2016, 2022 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 ColorDlg;
IMPORT sys := SYSTEM, KOSAPI;
TYPE
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;
procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR
END;
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);
BEGIN
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;
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
END Create;
PROCEDURE Destroy*(VAR cd: Dialog);
BEGIN
IF cd # NIL THEN
DISPOSE(cd)
END
END Destroy;
END ColorDlg.

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

@ -0,0 +1,84 @@
(*
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.

364
programs/other/fb2reader/SRC/Cursor.ob07 Normal file
View File

@ -0,0 +1,364 @@
(*
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 Cursor;
IMPORT sys := SYSTEM;
PROCEDURE [stdcall] cur;
BEGIN
sys.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,
040H, 000H, 000H, 000H, 001H, 000H, 018H, 000H, 000H, 000H,
000H, 000H, 080H, 00CH, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 033H, 033H, 033H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 055H, 055H, 055H, 0BBH, 0BBH, 0BBH, 0BBH, 0BBH, 0BBH,
0BBH, 0BBH, 0BBH, 0AAH, 0AAH, 0AAH, 033H, 033H, 033H, 0AAH,
0AAH, 0AAH, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 033H, 033H, 033H, 0BBH, 0BBH, 0BBH,
0EEH, 0EEH, 0EEH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0EEH,
0EEH, 0EEH, 0AAH, 0AAH, 0AAH, 0EEH, 0EEH, 0EEH, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 033H, 033H, 033H,
0BBH, 0BBH, 0BBH, 0EEH, 0EEH, 0EEH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0EEH, 0EEH,
0EEH, 0FFH, 0FFH, 0FFH, 0AAH, 0AAH, 0AAH, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
033H, 033H, 033H, 0BBH, 0BBH, 0BBH, 0EEH, 0EEH, 0EEH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0CCH, 0CCH, 0CCH, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 055H, 055H, 055H, 0EEH,
0EEH, 0EEH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 088H,
088H, 088H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 055H, 055H, 055H, 0EEH, 0EEH, 0EEH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 088H, 088H, 088H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 033H, 033H, 033H, 0DDH, 0DDH,
0DDH, 0FFH, 0FFH, 0FFH, 0DDH, 0DDH, 0DDH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0EEH, 0EEH,
0EEH, 0BBH, 0BBH, 0BBH, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 033H, 033H,
033H, 0DDH, 0DDH, 0DDH, 0FFH, 0FFH, 0FFH, 0E5H, 0E5H, 0E5H,
000H, 000H, 000H, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0CCH, 0CCH, 0CCH,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 033H, 033H, 033H, 0DDH, 0DDH, 0DDH,
0FFH, 0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 000H, 000H, 000H, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0CCH, 0CCH, 0CCH, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
055H, 055H, 055H, 0FFH, 0FFH, 0FFH, 0BBH, 0BBH, 0BBH, 000H,
000H, 000H, 033H, 033H, 033H, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0CCH,
0CCH, 0CCH, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 055H,
055H, 055H, 022H, 022H, 022H, 000H, 000H, 000H, 033H, 033H,
033H, 0FFH, 0FFH, 0FFH, 0EEH, 0EEH, 0EEH, 088H, 088H, 088H,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 088H, 088H, 088H, 0E5H,
0E5H, 0E5H, 044H, 044H, 044H, 0E5H, 0E5H, 0E5H, 033H, 033H,
033H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 033H, 033H, 033H, 0FFH, 0FFH, 0FFH,
0E5H, 0E5H, 0E5H, 044H, 044H, 044H, 0F4H, 0F4H, 0F4H, 0E5H,
0E5H, 0E5H, 044H, 044H, 044H, 0E5H, 0E5H, 0E5H, 000H, 000H,
000H, 033H, 033H, 033H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
033H, 033H, 033H, 0FFH, 0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 000H,
000H, 000H, 0AAH, 0AAH, 0AAH, 022H, 022H, 022H, 000H, 000H,
000H, 033H, 033H, 033H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 033H, 033H, 033H, 0FFH,
0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 000H, 000H, 000H, 033H, 033H,
033H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 033H, 033H, 033H, 0FFH, 0FFH, 0FFH, 0E5H, 0E5H,
0E5H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 033H, 033H,
033H, 0FFH, 0FFH, 0FFH, 0E5H, 0E5H, 0E5H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 044H, 044H, 044H, 0EEH, 0EEH, 0EEH,
0E5H, 0E5H, 0E5H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 044H, 044H, 044H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H, 000H,
000H, 000H, 000H, 000H, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH,
0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0F8H, 027H, 0FFH, 0FFH,
0F8H, 007H, 0FFH, 0FFH, 0F0H, 007H, 0FFH, 0FFH, 0E0H, 003H,
0FFH, 0FFH, 0C0H, 003H, 0FFH, 0FFH, 0C0H, 001H, 0FFH, 0FFH,
0C0H, 001H, 0FFH, 0FFH, 080H, 001H, 0FFH, 0FFH, 000H, 001H,
0FFH, 0FFH, 000H, 001H, 0FFH, 0FFH, 000H, 001H, 0FFH, 0FFH,
090H, 001H, 0FFH, 0FFH, 0F0H, 003H, 0FFH, 0FFH, 0F0H, 00FH,
0FFH, 0FFH, 0F0H, 07FH, 0FFH, 0FFH, 0F0H, 0FFH, 0FFH, 0FFH,
0F0H, 0FFH, 0FFH, 0FFH, 0F0H, 0FFH, 0FFH, 0FFH, 0F9H, 0FFH,
0FFH, 0FFH)
END cur;
PROCEDURE GetCursor* (): INTEGER;
RETURN sys.ADR(cur) + 3
END GetCursor;
END Cursor.

1756
programs/other/fb2reader/SRC/DOM.ob07 Normal file
View File

File diff suppressed because it is too large Load Diff

366
programs/other/fb2reader/SRC/FB2READ.ob07 Normal file
View File

@ -0,0 +1,366 @@
(*
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 FB2READ;
IMPORT
DOM, SU := SysUtils, S := Strings, W := Window, Settings, OpenDlg,
G := Graph, SelEnc, Ini, File, box_lib, Font, SearchForm, Toolbar;
CONST
CLOSE = 1;
BACK = 16;
FORWARD = 17;
CONTENTS = 18;
DESCR = 19;
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;
TOOLBAR_LEFT = 5;
TOOLBAR_TOP = 6;
BUTTON_HEIGHT = 24;
CANVAS_LEFT = 1;
CANVAS_TOP = 2 * TOOLBAR_TOP + Toolbar.BtnSize;
WINDOW_BEVEL = 4;
SCROLLBAR_WIDTH = 20;
STATUSBAR_HEIGHT = 18;
VAR
Window : W.TWindow;
toolbar : Toolbar.tToolbar;
SkinHeight : INTEGER;
Open : OpenDlg.Dialog;
FileName : S.STRING;
sb : box_lib.scrollbar;
PROCEDURE ToolbarEnable;
BEGIN
Toolbar.enable(toolbar, BACK, DOM.BackEnabled());
Toolbar.enable(toolbar, FORWARD, DOM.FrwEnabled());
Toolbar.enable(toolbar, CONTENTS, DOM.ContentsEnabled());
Toolbar.enable(toolbar, DESCR, DOM.DescrEnabled());
END ToolbarEnable;
PROCEDURE ToolBar;
BEGIN
sb := box_lib.kolibri_scrollbar(sb, (G.Buffer.Width + CANVAS_LEFT) * 65536 + SCROLLBAR_WIDTH + 1,
CANVAS_TOP * 65536 + G.Buffer.Height, SCROLLBAR_WIDTH, sb.max_area, sb.cur_area, sb.position, SU.lightColor, SU.btnColor, 0, 0);
box_lib.scrollbar_v_draw(sb);
ToolbarEnable;
Toolbar.draw(toolbar);
END ToolBar;
PROCEDURE Resize;
VAR Width, Height: INTEGER;
BEGIN
SU.GetWindowPos(Window.Left, Window.Top);
SU.GetWindowSize(Width, Height);
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;
SU.SetWindowSize(Width, Height);
DOM.Resize(G.Buffer.Width + Window.dWidth, G.Buffer.Height + Window.dHeight + (SkinHeight - SU.SkinHeight()));
SkinHeight := SU.SkinHeight()
END
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);
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)
ELSIF DOM.found() THEN
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;
PROCEDURE DrawWindow;
BEGIN
SU.GetSystemColors;
SU.WindowRedrawStatus(1);
IF Window.Created THEN
Resize
ELSE
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);
IF DOM.loaded THEN
ToolBar;
DOM.Draw;
DrawStatus
END;
SU.WindowRedrawStatus(2)
END DrawWindow;
PROCEDURE ConvMousePos(VAR X, Y: INTEGER);
BEGIN
X := X - Window.Left - WINDOW_BEVEL - 1;
Y := Y - Window.Top - SkinHeight
END ConvMousePos;
PROCEDURE DrawToolbar;
BEGIN
ToolbarEnable;
Toolbar.drawIcons(toolbar)
END DrawToolbar;
PROCEDURE ButtonClick;
BEGIN
CASE SU.GetButtonCode() OF
|0 :
|CLOSE : SearchForm.close(FALSE);
Settings.Close;
DOM.Close
|BACK : DOM.Back
|FORWARD : DOM.Forward
|CONTENTS : DOM.Contents
|DESCR : DOM.Descr
|SEARCH : DOM.OpenSearch
|SETTINGS : Settings.Open
END;
DOM.Draw;
DrawStatus
END ButtonClick;
PROCEDURE KeyDown;
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
END KeyDown;
PROCEDURE CanvasIsClicked(X, Y: INTEGER): BOOLEAN;
RETURN
(CANVAS_LEFT <= X) & (X < CANVAS_LEFT + G.Buffer.Width) &
(CANVAS_TOP <= Y) & (Y < CANVAS_TOP + G.Buffer.Height)
END CanvasIsClicked;
PROCEDURE MouseEvent;
VAR
mouse_status : SET;
X, Y : INTEGER;
scroll : INTEGER;
BEGIN
SU.MousePos(X, Y);
mouse_status := SU.MouseStatus();
scroll := SU.MouseVScroll();
IF SU.L_BUTTON IN mouse_status THEN
ConvMousePos(X, Y);
IF CanvasIsClicked(X, Y) THEN
X := X - CANVAS_LEFT;
Y := Y - CANVAS_TOP;
DOM.Click(X, Y, TRUE)
END
ELSIF scroll # 0 THEN
DOM.Scroll(scroll);
DOM.Draw
ELSE
ConvMousePos(X, Y);
IF CanvasIsClicked(X, Y) THEN
X := X - CANVAS_LEFT;
Y := Y - CANVAS_TOP;
DOM.Click(X, Y, FALSE)
END
END
END MouseEvent;
PROCEDURE Empty;
END Empty;
PROCEDURE OpenFile;
BEGIN
Open := OpenDlg.Create(Empty, 0, Ini.Default, Ini.Files);
OpenDlg.Show(Open, 500, 400);
WHILE Open.status = 2 DO
SU.Pause(30)
END;
IF Open.status = 0 THEN
SU.Halt
END;
COPY(Open.FilePath, FileName);
OpenDlg.Destroy(Open)
END OpenFile;
PROCEDURE IsFB2(FileName: S.STRING): BOOLEAN;
VAR temp: S.STRING;
BEGIN
temp := FileName;
S.Reverse(temp);
temp[4] := 0X;
S.UCase(temp)
RETURN temp = "2BF."
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;
BEGIN
SkinHeight := SU.SkinHeight();
sb := box_lib.kolibri_new_scrollbar(10 * 65536 + 200, 10 * 65536 + 30, 25, 15, 10, 0, 0, 0, 0, 0);
DOM.SetScrollBar(sb);
defpath := TRUE;
SU.GetParam(FileName);
IF FileName = "" THEN
OpenFile
END;
IF FileName[0] = "!" THEN
FileName[0] := "/";
defpath := FALSE
END;
IF defpath THEN
FilePath := FileName;
S.GetPath(FilePath);
Ini.SetDefaultPath(FilePath);
DOM.SetColors;
DOM.Set_b_pict(Ini.b_pict);
Ini.Save(DOM.Settings.Colors, DOM.Settings.b_pict)
END;
IF ~IsFB2(FileName) THEN
SelEnc.Show(FileName)
END;
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);
Settings.Default;
DOM.GetWinSize(FileName, Window.Width, Window.Height);
Win2 := Window;
resize := FALSE;
IF Win2.Width > X2 - X1 THEN
Win2.Width := X2 - X1;
resize := TRUE
END;
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);
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);
Toolbar.create(toolbar, TOOLBAR_LEFT, TOOLBAR_TOP);
Toolbar.add(toolbar, BACK, 30, "");
Toolbar.add(toolbar, FORWARD, 31, "");
Toolbar.delimiter(toolbar);
Toolbar.add(toolbar, CONTENTS, 3, "");
Toolbar.delimiter(toolbar);
Toolbar.add(toolbar, SEARCH, 49, "");
Toolbar.delimiter(toolbar);
Toolbar.add(toolbar, DESCR, 66, "");
Toolbar.delimiter(toolbar);
Toolbar.add(toolbar, SETTINGS, 60, "");
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)
END;
DrawWindow;
scr_pos := sb.position;
WHILE TRUE DO
CASE SU.WaitForEvent() OF
|1 : DrawWindow
|2 : KeyDown
|3 : ButtonClick
|6 : box_lib.scrollbar_v_mouse(sb);
IF sb.position # scr_pos THEN
DOM.ScrollBar;
DOM.Draw;
scr_pos := sb.position;
END;
MouseEvent
END
END
END main;
BEGIN
main("FB2 Reader v0.97")
END FB2READ.

255
programs/other/fb2reader/SRC/File.ob07 Normal file
View File

@ -0,0 +1,255 @@
(*
Copyright 2016, 2019 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 File;
IMPORT sys := SYSTEM, KOSAPI;
CONST
SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
TYPE
FNAME* = ARRAY 520 OF CHAR;
FS* = POINTER TO rFS;
rFS* = RECORD
subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER;
name*: FNAME
END;
FD* = POINTER TO rFD;
rFD* = RECORD
attr*: INTEGER;
ntyp*: CHAR;
reserved: ARRAY 3 OF CHAR;
time_create*, date_create*,
time_access*, date_access*,
time_modif*, date_modif*,
size*, hsize*: INTEGER;
name*: FNAME
END;
PROCEDURE [stdcall] f_68_27(file_name: INTEGER; VAR size: INTEGER): INTEGER;
BEGIN
sys.CODE(053H); (* push ebx *)
sys.CODE(06AH, 044H); (* push 68 *)
sys.CODE(058H); (* pop eax *)
sys.CODE(06AH, 01BH); (* push 27 *)
sys.CODE(05BH); (* pop ebx *)
sys.CODE(08BH, 04DH, 008H); (* mov ecx, [ebp + 08h] *)
sys.CODE(0CDH, 040H); (* int 40h *)
sys.CODE(08BH, 04DH, 00CH); (* mov ecx, [ebp + 0Ch] *)
sys.CODE(089H, 011H); (* mov [ecx], edx *)
sys.CODE(05BH); (* pop ebx *)
sys.CODE(0C9H); (* leave *)
sys.CODE(0C2H, 008H, 000H); (* ret 08h *)
RETURN 0
END f_68_27;
PROCEDURE Load*(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
RETURN f_68_27(sys.ADR(FName[0]), size)
END Load;
PROCEDURE GetFileInfo*(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
VAR res2: INTEGER; fs: rFS;
BEGIN
fs.subfunc := 5;
fs.pos := 0;
fs.hpos := 0;
fs.bytes := 0;
fs.buffer := sys.ADR(Info);
COPY(FName, fs.name)
RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
END GetFileInfo;
PROCEDURE Exists*(FName: ARRAY OF CHAR): BOOLEAN;
VAR fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists;
PROCEDURE Close*(VAR F: FS);
BEGIN
IF F # NIL THEN
DISPOSE(F)
END
END Close;
PROCEDURE Open*(FName: ARRAY OF CHAR): FS;
VAR F: FS;
BEGIN
IF Exists(FName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 0;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name)
END
ELSE
F := NIL
END
RETURN F
END Open;
PROCEDURE Delete*(FName: ARRAY OF CHAR): BOOLEAN;
VAR F: FS; res, res2: INTEGER;
BEGIN
IF Exists(FName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 8;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
ELSE
res := -1
END
RETURN res = 0
END Delete;
PROCEDURE Seek*(F: FS; Offset, Origin: INTEGER): INTEGER;
VAR res: INTEGER; fd: rFD;
BEGIN
IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN
CASE Origin OF
|SEEK_BEG: F.pos := Offset
|SEEK_CUR: INC(F.pos, Offset)
|SEEK_END: F.pos := fd.size + Offset
ELSE
END;
res := F.pos
ELSE
res := -1
END
RETURN res
END Seek;
PROCEDURE Read*(F: FS; Buffer, Count: INTEGER): INTEGER;
VAR res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 0;
F.bytes := Count;
F.buffer := Buffer;
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
IF res2 > 0 THEN
INC(F.pos, res2)
END
ELSE
res2 := 0
END
RETURN res2
END Read;
PROCEDURE Write*(F: FS; Buffer, Count: INTEGER): INTEGER;
VAR res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 3;
F.bytes := Count;
F.buffer := Buffer;
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
IF res2 > 0 THEN
INC(F.pos, res2)
END
ELSE
res2 := 0
END
RETURN res2
END Write;
PROCEDURE Create*(FName: ARRAY OF CHAR): FS;
VAR F: FS; res2: INTEGER;
BEGIN
NEW(F);
IF F # NIL THEN
F.subfunc := 2;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name);
IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN
DISPOSE(F)
END
END
RETURN F
END Create;
PROCEDURE DirExists*(FName: ARRAY OF CHAR): BOOLEAN;
VAR fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
END DirExists;
PROCEDURE CreateDir*(DirName: ARRAY OF CHAR): BOOLEAN;
VAR F: FS; res, res2: INTEGER;
BEGIN
NEW(F);
IF F # NIL THEN
F.subfunc := 9;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(DirName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
RETURN res = 0
END CreateDir;
PROCEDURE DeleteDir*(DirName: ARRAY OF CHAR): BOOLEAN;
VAR F: FS; res, res2: INTEGER;
BEGIN
IF DirExists(DirName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 8;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(DirName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
ELSE
res := -1
END
RETURN res = 0
END DeleteDir;
END File.

176
programs/other/fb2reader/SRC/Font.ob07 Normal file
View File

@ -0,0 +1,176 @@
(*
Copyright 2016, 2018, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Font;
IMPORT W := Window, S := Strings, G := Graph, sys := SYSTEM, K := KOSAPI, Conv, Ini, KF := kfonts;
VAR
kf_font, kf_loaded, kf_enabled: BOOLEAN;
cp1251buf: ARRAY 102400 OF CHAR;
KFont*: KF.TFont;
Font*: RECORD
color* : INTEGER;
size : INTEGER;
bold : BOOLEAN;
italic : BOOLEAN;
strike : BOOLEAN
END;
ItalicColor, NormalColor: INTEGER;
PROCEDURE KFText(X, Y: INTEGER; first, quantity: INTEGER; canvas: G.PBuffer);
BEGIN
KF.TextOut(KFont, canvas.adr - 8, X, Y, first, quantity, Font.color, ORD(Font.bold) + ORD(Font.italic) * 2 + ORD(Font.strike) * 8)
END KFText;
PROCEDURE sysfont*(sf: BOOLEAN);
BEGIN
kf_font := ~sf & kf_enabled;
END sysfont;
PROCEDURE params*(): INTEGER;
RETURN Font.size + 0 + LSL(3, 16) + LSL(ORD(Font.bold) + ORD(Font.italic) * 2 + 128, 24)
END params;
PROCEDURE SetFontColor*(color: INTEGER);
BEGIN
Font.color := color
END SetFontColor;
PROCEDURE Bold*(bold: BOOLEAN);
BEGIN
Font.bold := bold
END Bold;
PROCEDURE Italic*(italic, notLink: BOOLEAN);
BEGIN
Font.italic := italic;
IF italic THEN
IF notLink THEN
SetFontColor(ItalicColor)
END
ELSE
IF notLink THEN
SetFontColor(NormalColor)
END
END
END Italic;
PROCEDURE Strike*(strike: BOOLEAN);
BEGIN
Font.strike := strike
END Strike;
PROCEDURE FontW(): INTEGER;
RETURN ASR(Font.size, 1)
END FontW;
PROCEDURE FontH*(): INTEGER;
VAR res: INTEGER;
BEGIN
IF kf_font THEN
res := KF.TextHeight(KFont)
ELSE
res := Font.size
END
RETURN res
END FontH;
PROCEDURE TextWidth*(text: S.CHARS; length: INTEGER): INTEGER;
VAR res: INTEGER;
BEGIN
IF kf_font THEN
Conv.convert(text.first, sys.ADR(cp1251buf[0]), length);
res := KF.TextWidth(KFont, sys.ADR(cp1251buf[0]), length, ORD(Font.bold) + ORD(Font.italic) * 2)
ELSE
res := length * FontW()
END
RETURN res
END TextWidth;
PROCEDURE MonoWidth*(): INTEGER;
RETURN FontW()
END MonoWidth;
PROCEDURE StrikeText*(Rect: W.TRect; X, Y: INTEGER; width: INTEGER);
VAR y: INTEGER;
BEGIN
IF Font.strike THEN
y := Y + FontH() DIV 2;
// X := X + ORD(Font.italic & kf_font) * ((KF.TextHeight(KFont) DIV 2) DIV 3);
G.SetColor(Font.color);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top);
IF Font.size >= 28 THEN
INC(y);
G.HLine(X + Rect.Left, X + Rect.Left + width, y + Rect.Top);
END
END
END StrikeText;
PROCEDURE Text*(Rect: W.TRect; X, Y: INTEGER; adr: INTEGER; length: INTEGER);
BEGIN
IF kf_font THEN
Conv.convert(adr, sys.ADR(cp1251buf[0]), length);
KFText(X + Rect.Left, Y + Rect.Top, sys.ADR(cp1251buf[0]), length, G.Buffer)
ELSE
G.SetColor(Font.color);
G.TextOut(X + Rect.Left, Y + Rect.Top, adr, length, Font.size, params())
END
END Text;
PROCEDURE Init*(italic, normal, fs: INTEGER);
BEGIN
ItalicColor := italic;
NormalColor := normal;
IF KF.SetSize(KFont, fs) THEN
Font.size := KF.TextHeight(KFont);
kf_font := TRUE;
kf_enabled := TRUE
ELSE
Font.size := fs;
kf_font := FALSE;
kf_enabled := FALSE
END
END Init;
BEGIN
KFont := KF.LoadFont(Ini.Font);
kf_loaded := KFont # NIL;
kf_font := kf_loaded;
kf_enabled := kf_loaded
END Font.

310
programs/other/fb2reader/SRC/Graph.ob07 Normal file
View File

@ -0,0 +1,310 @@
(*
Copyright 2016-2020, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Graph;
IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils, LibImg;
TYPE
TBuffer = RECORD Width*, Height*, adr*, Color: INTEGER END;
PBuffer* = POINTER TO TBuffer;
VAR
Buffer*, Buffer2, Buffer3*: PBuffer;
PROCEDURE [stdcall-, "rasterworks.obj", ""] drawText (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; END;
PROCEDURE Destroy*(VAR Buffer: PBuffer);
BEGIN
IF Buffer # NIL THEN
IF Buffer.adr # 0 THEN
DEC(Buffer.adr, 8);
Buffer.adr := K.free(Buffer.adr)
END;
DISPOSE(Buffer)
END
END Destroy;
PROCEDURE Create*(Width, Height: INTEGER): PBuffer;
VAR res: PBuffer;
BEGIN
NEW(res);
res.adr := K.malloc(Width * Height * 4 + 8);
sys.PUT(res.adr, Width);
sys.PUT(res.adr + 4, Height);
res.Width := Width;
res.Height := Height;
INC(res.adr, 8);
RETURN res
END Create;
PROCEDURE getRGB* (color: INTEGER; VAR r, g, b: BYTE);
BEGIN
b := color MOD 256;
g := color DIV 256 MOD 256;
r := color DIV 65536 MOD 256
END getRGB;
PROCEDURE Fill*(Buffer: PBuffer; 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
END Fill;
PROCEDURE HLine*(X1, X2, Y: INTEGER);
VAR
p1, p2, i, color: INTEGER;
BEGIN
IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1);
color := Buffer.Color;
p1 := Buffer.adr + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO
sys.PUT(i, color)
END
END
END HLine;
PROCEDURE HLineNotXOR (X1, X2, Y, color: INTEGER);
VAR
p1, p2, i: INTEGER;
pix: SET;
BEGIN
IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1);
p1 := Buffer.adr + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO
sys.GET(i, pix);
pix := (-pix) / BITS(color) - {24..31};
sys.PUT(i, pix)
END
END
END HLineNotXOR;
PROCEDURE VLine*(X, Y1, Y2: INTEGER);
VAR p1, p2, line_size, color: INTEGER;
BEGIN
ASSERT(Y1 <= Y2);
SU.MinMax(Y1, 0, Buffer.Height - 1);
SU.MinMax(Y2, 0, Buffer.Height - 1);
color := Buffer.Color;
line_size := Buffer.Width * 4;
p1 := Buffer.adr + line_size * Y1 + 4 * X;
p2 := p1 + (Y2 - Y1) * line_size;
WHILE p1 <= p2 DO
sys.PUT(p1, color);
p1 := p1 + line_size
END
END VLine;
PROCEDURE Box(X1, Y1, X2, Y2: INTEGER);
VAR y: INTEGER;
BEGIN
FOR y := Y1 TO Y2 DO
HLine(X1, X2, y)
END
END Box;
PROCEDURE BoxNotXOR* (X1, Y1, X2, Y2, color: INTEGER);
VAR y: INTEGER;
BEGIN
FOR y := Y1 TO Y2 DO
HLineNotXOR(X1, X2, y, color)
END
END BoxNotXOR;
PROCEDURE SetColor*(color: INTEGER);
BEGIN
Buffer.Color := color
END SetColor;
PROCEDURE GetColor*(): INTEGER;
RETURN Buffer.Color
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)
END TextOut;
PROCEDURE Resize2*(Width, Height: INTEGER);
BEGIN
Buffer2.Width := Width;
Buffer2.Height := Height;
END Resize2;
PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER);
VAR
y: INTEGER;
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)
END;
INC(Y)
END
END Image;
PROCEDURE Image2(Buffer: PBuffer; X, Y, sizeX, sizeY, ptr: INTEGER);
VAR x, y, pix, left: INTEGER;
BEGIN
left := X;
FOR y := 0 TO sizeY - 1 DO
X := left;
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)
END;
INC(X)
END;
INC(Y)
END
END Image2;
PROCEDURE BackImage*(sizeX, sizeY, ptr: INTEGER);
VAR x, y: INTEGER;
BEGIN
IF ptr # 0 THEN
y := 0;
WHILE y < Buffer3.Height DO
x := 0;
WHILE x < Buffer3.Width DO
Image2(Buffer3, x, y, sizeX, sizeY, ptr);
INC(x, sizeX)
END;
INC(y, sizeY)
END
END
END BackImage;
PROCEDURE Copy*(src, dst: PBuffer; 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)
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)
END Draw;
PROCEDURE Rect*(X1, Y1, X2, Y2: INTEGER);
BEGIN
VLine(X1, Y1, Y2);
VLine(X2, Y1, Y2);
HLine(X1, X2, Y1);
HLine(X1, X2, Y2)
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;
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));
SetColor(000000FFH);
Box(W4 + 10, H2, W4 + 10 + FLOOR( FLT(W2 - 20) * value ), H2 + 15);
END Progress;
PROCEDURE Resize3(Buffer: PBuffer; Width, Height: INTEGER);
BEGIN
IF Buffer.adr # 0 THEN
DEC(Buffer.adr, 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.Width := Width;
Buffer.Height := Height
END Resize3;
PROCEDURE Resize*(Width, Height: INTEGER);
BEGIN
Resize3(Buffer, Width, Height);
Resize3(Buffer3, Width, Height);
END Resize;
PROCEDURE Init;
VAR Width, Height: INTEGER;
BEGIN
NEW(Buffer);
NEW(Buffer2);
NEW(Buffer3);
SU.GetScreenSize(Width, Height);
Resize(Width, Height)
END Init;
BEGIN
Init
END Graph.

106
programs/other/fb2reader/SRC/Icons.ob07 Normal file
View File

@ -0,0 +1,106 @@
(*
Copyright 2021, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Icons;
IMPORT
LibImg, K := SysUtils, Graph, File, KOSAPI, SYSTEM;
CONST
fileName = "/sys/Icons16.png";
SIZE* = 18;
VAR
source: INTEGER;
(*
PROCEDURE copy (src, dst: INTEGER);
VAR
src_width, src_height,
dst_width, dst_height,
src_data, dst_data: INTEGER;
BEGIN
LibImg.GetInf(src, src_width, src_height, src_data);
LibImg.GetInf(dst, dst_width, dst_height, dst_data);
ASSERT(src_width = dst_width);
ASSERT(src_height = dst_height);
SYSTEM.MOVE(src_data, dst_data, src_width*src_height*4)
END copy;
*)
PROCEDURE load (): INTEGER;
VAR
height: INTEGER;
BEGIN
RETURN LibImg.LoadFromFile(fileName, SIZE, height)
END load;
PROCEDURE draw* (icons, n, x, y: INTEGER);
VAR
width, height, data: INTEGER;
BEGIN
LibImg.GetInf(icons, width, height, data);
KOSAPI.sysfunc7(65, data + SIZE*SIZE*4*n, SIZE*65536 + SIZE, x*65536 + y, 32, 0, 0)
END draw;
PROCEDURE iconsBackColor (icons: INTEGER; BackColor: INTEGER);
VAR
width, height, data, x, y, pix: INTEGER;
b, g, r, gr: BYTE;
BEGIN
LibImg.GetInf(icons, width, height, data);
FOR y := 0 TO height - 1 DO
FOR x := 0 TO width - 1 DO
SYSTEM.GET32(data, pix);
Graph.getRGB(pix, r, g, b);
gr := (r + g + b) DIV 3;
IF BackColor = -1 THEN
pix := gr + 256*gr + 65536*gr
ELSIF gr = 255 THEN
pix := BackColor
END;
SYSTEM.PUT32(data, pix);
INC(data, 4)
END
END
END iconsBackColor;
PROCEDURE get* (VAR icons, grayIcons: INTEGER; BackColor: INTEGER);
BEGIN
IF source = 0 THEN
source := load();
icons := load();
grayIcons := load();
iconsBackColor(grayIcons, -1);
iconsBackColor(grayIcons, BackColor);
iconsBackColor(icons, BackColor)
(*ELSE
copy(source, icons);
copy(source, grayIcons)*)
END;
END get;
BEGIN
source := 0
END Icons.

149
programs/other/fb2reader/SRC/Ini.ob07 Normal file
View File

@ -0,0 +1,149 @@
(*
Copyright 2016, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Ini;
IMPORT KOSAPI, sys := SYSTEM, S := Strings, File;
CONST
IniFileName = "/sys/settings/fb2read.ini";
VAR
History*, Browser*, Default*, Font*, Files*, Picture* : S.STRING;
b_pict*: BOOLEAN;
buffer: ARRAY 5000 OF CHAR;
PROCEDURE [stdcall, "libini.obj", "ini_enum_keys"] enum_keys (f_name, sec_name: S.STRING; callback: INTEGER); END;
PROCEDURE [stdcall, "libini.obj", "ini_get_color"] get_color (f_name, sec_name, key_name: S.STRING; def_val: INTEGER): INTEGER; END;
PROCEDURE Save* (Colors: ARRAY OF INTEGER; b_pict: BOOLEAN);
VAR F: File.FS; pos: INTEGER;
PROCEDURE WriteStr(str: S.STRING; VAR pos: INTEGER);
BEGIN
sys.MOVE(sys.ADR(str[0]), pos, LENGTH(str));
pos := pos + LENGTH(str)
END WriteStr;
PROCEDURE WriteLn (VAR pos: INTEGER);
BEGIN
WriteStr(0DX, pos);
WriteStr(0AX, pos)
END WriteLn;
PROCEDURE GetRGB(color: INTEGER; VAR r, g, b: INTEGER);
BEGIN
b := ORD(BITS(color) * {0..7});
g := ORD(BITS(LSR(color, 8)) * {0..7});
r := ORD(BITS(LSR(color, 16)) * {0..7})
END GetRGB;
PROCEDURE WriteColor(color: INTEGER; VAR pos: INTEGER);
VAR r, g, b: INTEGER; s: S.STRING;
BEGIN
GetRGB(color, r, g, b);
S.IntToString(r, s); WriteStr(s, pos); WriteStr(",", pos);
S.IntToString(g, s); WriteStr(s, pos); WriteStr(",", pos);
S.IntToString(b, s); WriteStr(s, pos);
END WriteColor;
BEGIN
pos := sys.ADR(buffer[0]);
F := File.Create(IniFileName);
WriteStr("[Paths]", pos); WriteLn(pos);
WriteStr("history=", pos); WriteStr(History, pos); WriteLn(pos);
WriteStr("browser=", pos); WriteStr(Browser, pos); WriteLn(pos);
WriteStr("default=", pos); WriteStr(Default, pos); WriteLn(pos);
WriteStr("font=", pos); WriteStr(Font, pos); WriteLn(pos);
WriteStr("picture=", pos); WriteStr(Picture, pos); WriteLn(pos);
WriteStr("[Files]", pos); WriteLn(pos);
WriteStr("files=", pos); WriteStr(Files, pos); WriteLn(pos);
WriteStr("[Flags]", pos); WriteLn(pos);
WriteStr("picture=", pos);
IF b_pict THEN
WriteStr("on", pos)
ELSE
WriteStr("off", pos)
END;
WriteLn(pos);
WriteStr("[Colors]", pos); WriteLn(pos);
WriteStr("back=", pos); WriteColor(Colors[0], pos); WriteLn(pos);
WriteStr("text=", pos); WriteColor(Colors[1], pos); WriteLn(pos);
WriteStr("italic=", pos); WriteColor(Colors[2], pos); WriteLn(pos);
WriteStr("link=", pos); WriteColor(Colors[3], pos); WriteLn(pos);
WriteStr("visited=", pos); WriteColor(Colors[4], pos); WriteLn(pos);
pos := File.Write(F, sys.ADR(buffer[0]), pos - sys.ADR(buffer[0]));
File.Close(F)
END Save;
PROCEDURE [stdcall] callback(f_name, sec_name, key_name, key_value: S.STRING): INTEGER;
BEGIN
IF sec_name = "Paths" THEN
IF key_name = "history" THEN
History := key_value
ELSIF key_name = "browser" THEN
Browser := key_value
ELSIF key_name = "default" THEN
Default := key_value
ELSIF key_name = "font" THEN
Font := key_value
ELSIF key_name = "picture" THEN
Picture := key_value
END
ELSIF sec_name = "Files" THEN
IF key_name = "files" THEN
Files := key_value
END
ELSIF sec_name = "Flags" THEN
IF key_name = "picture" THEN
b_pict := key_value = "on"
END
END
RETURN 1
END callback;
PROCEDURE GetColor*(key: S.STRING; def: INTEGER): INTEGER;
RETURN get_color(IniFileName, "Colors", key, def)
END GetColor;
PROCEDURE SetDefaultPath*(Path: S.STRING);
BEGIN
Default := Path;
END SetDefaultPath;
PROCEDURE SetPicturePath*(Path: S.STRING);
BEGIN
Picture := Path;
END SetPicturePath;
BEGIN
enum_keys(IniFileName, "Paths", sys.ADR(callback));
enum_keys(IniFileName, "Files", sys.ADR(callback));
enum_keys(IniFileName, "Flags", sys.ADR(callback));
END Ini.

436
programs/other/fb2reader/SRC/KOSAPI.ob07 Normal file
View File

@ -0,0 +1,436 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2019, 2022 Anton Krotov
All rights reserved.
*)
MODULE KOSAPI;
IMPORT SYSTEM;
TYPE
STRING = ARRAY 1024 OF CHAR;
VAR
DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
0CDH, 040H, (* int 64 *)
0C9H, (* leave *)
0C2H, 004H, 000H (* ret 4 *)
)
RETURN 0
END sysfunc1;
PROCEDURE [stdcall-] sysfunc2* (arg1, arg2: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
0CDH, 040H, (* int 64 *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 8 *)
)
RETURN 0
END sysfunc2;
PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
0CDH, 040H, (* int 64 *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END sysfunc3;
PROCEDURE [stdcall-] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
0CDH, 040H, (* int 64 *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 010H, 000H (* ret 16 *)
)
RETURN 0
END sysfunc4;
PROCEDURE [stdcall-] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
056H, (* push esi *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *)
0CDH, 040H, (* int 64 *)
05EH, (* pop esi *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 014H, 000H (* ret 20 *)
)
RETURN 0
END sysfunc5;
PROCEDURE [stdcall-] sysfunc6* (arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
056H, (* push esi *)
057H, (* push edi *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *)
08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *)
0CDH, 040H, (* int 64 *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 018H, 000H (* ret 24 *)
)
RETURN 0
END sysfunc6;
PROCEDURE [stdcall-] sysfunc7* (arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
056H, (* push esi *)
057H, (* push edi *)
055H, (* push ebp *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *)
08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *)
08BH, 06DH, 020H, (* mov ebp, dword [ebp + 32] *)
0CDH, 040H, (* int 64 *)
05DH, (* pop ebp *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 01CH, 000H (* ret 28 *)
)
RETURN 0
END sysfunc7;
PROCEDURE [stdcall-] sysfunc22* (arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
0CDH, 040H, (* int 64 *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
089H, 019H, (* mov dword [ecx], ebx *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END sysfunc22;
PROCEDURE mem_commit (adr, size: INTEGER);
VAR
tmp: INTEGER;
BEGIN
FOR tmp := adr TO adr + size - 1 BY 4096 DO
SYSTEM.PUT(tmp, 0)
END
END mem_commit;
PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER;
VAR
ptr: INTEGER;
BEGIN
SYSTEM.CODE(060H); (* pusha *)
IF sysfunc2(18, 16) > ASR(size, 10) THEN
ptr := sysfunc3(68, 12, size);
IF ptr # 0 THEN
mem_commit(ptr, size)
END
ELSE
ptr := 0
END;
SYSTEM.CODE(061H) (* popa *)
RETURN ptr
END malloc;
PROCEDURE [stdcall] free* (ptr: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(060H); (* pusha *)
IF ptr # 0 THEN
ptr := sysfunc3(68, 13, ptr)
END;
SYSTEM.CODE(061H) (* popa *)
RETURN 0
END free;
PROCEDURE [stdcall] realloc* (ptr, size: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(060H); (* pusha *)
ptr := sysfunc4(68, 20, size, ptr);
SYSTEM.CODE(061H) (* popa *)
RETURN ptr
END realloc;
PROCEDURE AppAdr (): INTEGER;
VAR
buf: ARRAY 1024 OF CHAR;
a: INTEGER;
BEGIN
a := sysfunc3(9, SYSTEM.ADR(buf), -1);
SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
RETURN a
END AppAdr;
PROCEDURE GetCommandLine* (): INTEGER;
VAR
param: INTEGER;
BEGIN
SYSTEM.GET(28 + AppAdr(), param)
RETURN param
END GetCommandLine;
PROCEDURE GetName* (): INTEGER;
VAR
name: INTEGER;
BEGIN
SYSTEM.GET(32 + AppAdr(), name)
RETURN name
END GetName;
PROCEDURE [stdcall] dll_init2 (arg1, arg2, arg3, arg4, arg5: INTEGER);
BEGIN
SYSTEM.CODE(
060H, (* pusha *)
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *)
0FFH, 0D6H, (* call esi *)
061H, (* popa *)
0C9H, (* leave *)
0C2H, 014H, 000H (* ret 20 *)
)
END dll_init2;
PROCEDURE GetProcAdr* (name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
VAR
cur, procname, adr: INTEGER;
PROCEDURE streq (str1, str2: INTEGER): BOOLEAN;
VAR
c1, c2: CHAR;
BEGIN
REPEAT
SYSTEM.GET(str1, c1);
SYSTEM.GET(str2, c2);
INC(str1);
INC(str2)
UNTIL (c1 # c2) OR (c1 = 0X)
RETURN c1 = c2
END streq;
BEGIN
adr := 0;
IF (lib # 0) & (name # "") THEN
cur := lib;
REPEAT
SYSTEM.GET(cur, procname);
INC(cur, 8)
UNTIL (procname = 0) OR streq(procname, SYSTEM.ADR(name[0]));
IF procname # 0 THEN
SYSTEM.GET(cur - 4, adr)
END
END
RETURN adr
END GetProcAdr;
PROCEDURE init (dll: INTEGER);
VAR
lib_init: INTEGER;
BEGIN
lib_init := GetProcAdr("lib_init", dll);
IF lib_init # 0 THEN
DLL_INIT(lib_init)
END;
lib_init := GetProcAdr("START", dll);
IF lib_init # 0 THEN
DLL_INIT(lib_init)
END
END init;
PROCEDURE OutChar* (c: CHAR);
BEGIN
sysfunc3(63, 1, ORD(c))
END OutChar;
PROCEDURE OutLn*;
BEGIN
OutChar(0DX);
OutChar(0AX)
END OutLn;
PROCEDURE OutString (s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < LEN(s)) & (s[i] # 0X) DO
OutChar(s[i]);
INC(i)
END
END OutString;
PROCEDURE imp_error (lib, proc: STRING);
BEGIN
OutString("import error: ");
IF proc = "" THEN
OutString("can't load '")
ELSE
OutString("not found '"); OutString(proc); OutString("' in '")
END;
OutString(lib);
OutString("'" + 0DX + 0AX)
END imp_error;
PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING);
VAR
c: CHAR;
BEGIN
REPEAT
SYSTEM.GET(adr, c); INC(adr);
str[i] := c; INC(i)
UNTIL c = 0X
END GetStr;
PROCEDURE [stdcall-] dll_Load* (import_table: INTEGER): INTEGER;
CONST
path = "/sys/lib/";
VAR
imp, lib, exp, proc, pathLen: INTEGER;
procname, libname: STRING;
BEGIN
SYSTEM.CODE(060H); (* pusha *)
libname := path;
pathLen := LENGTH(libname);
SYSTEM.GET(import_table, imp);
WHILE imp # 0 DO
SYSTEM.GET(import_table + 4, lib);
GetStr(lib, pathLen, libname);
exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
IF exp = 0 THEN
imp_error(libname, "")
ELSE
REPEAT
SYSTEM.GET(imp, proc);
IF proc # 0 THEN
GetStr(proc, 0, procname);
proc := GetProcAdr(procname, exp);
IF proc # 0 THEN
SYSTEM.PUT(imp, proc)
ELSE
proc := 1;
imp_error(libname, procname)
END;
INC(imp, 4)
END
UNTIL proc = 0;
init(exp)
END;
INC(import_table, 8);
SYSTEM.GET(import_table, imp);
END;
SYSTEM.CODE(061H) (* popa *)
RETURN 0
END dll_Load;
PROCEDURE [stdcall] dll_Init (entry: INTEGER);
BEGIN
SYSTEM.CODE(060H); (* pusha *)
IF entry # 0 THEN
dll_init2(SYSTEM.ADR(malloc), SYSTEM.ADR(free), SYSTEM.ADR(realloc), SYSTEM.ADR(dll_Load), entry)
END;
SYSTEM.CODE(061H); (* popa *)
END dll_Init;
PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER;
VAR
Lib: INTEGER;
BEGIN
DLL_INIT := dll_Init;
Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0]));
IF Lib # 0 THEN
init(Lib)
END
RETURN Lib
END LoadLib;
PROCEDURE _init* (import_table: INTEGER);
BEGIN
DLL_INIT := dll_Init;
dll_Load(import_table)
END _init;
END KOSAPI.

135
programs/other/fb2reader/SRC/LISTS.ob07 Normal file
View File

@ -0,0 +1,135 @@
(*
Copyright 2018, 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 LISTS;
TYPE
LIST* = POINTER TO rLIST;
ITEM* = POINTER TO rITEM;
rITEM* = RECORD
prev*, next*: ITEM;
destroy*: PROCEDURE (VAR item: ITEM)
END;
rLIST* = RECORD
first*, last*: ITEM
END;
PROCEDURE push* (list: LIST; item: ITEM);
BEGIN
ASSERT(list # NIL);
ASSERT(item # NIL);
IF list.first = NIL THEN
list.first := item;
list.last := item;
item.prev := NIL;
item.next := NIL
ELSE
ASSERT(list.last # NIL);
item.prev := list.last;
list.last.next := item;
item.next := NIL;
list.last := item
END
END push;
PROCEDURE get* (list: LIST; n: INTEGER): ITEM;
VAR
cur: ITEM;
BEGIN
cur := list.first;
WHILE (cur # NIL) & (n > 0) DO
cur := cur.next;
DEC(n)
END
RETURN cur
END get;
PROCEDURE idx* (list: LIST; item: ITEM): INTEGER;
VAR
cur: ITEM;
n: INTEGER;
BEGIN
ASSERT(item # NIL);
n := 0;
cur := list.first;
WHILE (cur # NIL) & (cur # item) DO
cur := cur.next;
INC(n)
END;
IF cur = NIL THEN
n := -1
END
RETURN n
END idx;
PROCEDURE create* (list: LIST): LIST;
BEGIN
IF list = NIL THEN
NEW(list)
END;
list.first := NIL;
list.last := NIL
RETURN list
END create;
PROCEDURE destroy* (VAR list: LIST);
VAR
item, next: ITEM;
BEGIN
IF list # NIL THEN
item := list.first;
WHILE item # NIL DO
next := item.next;
IF item.destroy # NIL THEN
item.destroy(item)
ELSE
DISPOSE(item)
END;
item := next
END;
DISPOSE(list)
END
END destroy;
END LISTS.

81
programs/other/fb2reader/SRC/Libimg.ob07 Normal file
View File

@ -0,0 +1,81 @@
(*
Copyright 2016, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE LibImg;
IMPORT sys := 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_convert (src, dst, dst_type, flags, param: INTEGER): INTEGER; END;
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)
END GetInf;
PROCEDURE GetImg* (ptr, size, Width: INTEGER; VAR sizeY: INTEGER): INTEGER;
VAR
image_data, dst, x, y, type: INTEGER;
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);
IF type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data);
image_data := dst
END;
IF (x > Width) & (image_data # 0) THEN
dst := img_scale(image_data, 0, 0, x, y, 0, 3, 1, Width, (y * Width) DIV x);
img_destroy(image_data);
image_data := dst
END;
IF image_data # 0 THEN
sys.GET(image_data + 8, sizeY)
END
END
RETURN image_data
END GetImg;
PROCEDURE LoadFromFile* (fileName: S.STRING; width: INTEGER; VAR height: INTEGER): INTEGER;
VAR
size, res, ptr: INTEGER;
BEGIN
res := 0;
ptr := File.Load(fileName, size);
IF ptr # 0 THEN
res := GetImg(ptr, size, width, height);
ptr := KOSAPI.free(ptr)
END
RETURN res
END LoadFromFile;
END LibImg.

134
programs/other/fb2reader/SRC/OpenDlg.ob07 Normal file
View File

@ -0,0 +1,134 @@
(*
Copyright 2016, 2022 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 OpenDlg;
IMPORT sys := SYSTEM, KOSAPI, S := Strings;
TYPE
DRAW_WINDOW = PROCEDURE;
TDialog = RECORD
type,
procinfo,
com_area_name,
com_area,
opendir_path,
dir_default_path,
start_path: INTEGER;
draw_window: DRAW_WINDOW;
status*,
openfile_path,
filename_area: INTEGER;
filter_area:
POINTER TO RECORD
size: INTEGER;
filter: ARRAY 4096 OF CHAR
END;
X, Y: INTEGER;
procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR;
s_opendir_path,
s_dir_default_path,
FilePath*,
FileName*: ARRAY 4096 OF CHAR
END;
Dialog* = POINTER TO TDialog;
PROCEDURE [stdcall, "Proc_lib.obj", ""] OpenDialog_start (od: Dialog); END;
PROCEDURE [stdcall, "Proc_lib.obj", ""] OpenDialog_init (od: Dialog); END;
PROCEDURE Show*(od: Dialog; Width, Height: INTEGER);
BEGIN
IF od # NIL THEN
od.X := Width;
od.Y := Height;
OpenDialog_start(od)
END
END Show;
PROCEDURE Create*(draw_window: DRAW_WINDOW; type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
VAR res: Dialog; n, i: INTEGER;
PROCEDURE replace(VAR str: ARRAY OF CHAR; c1, c2: CHAR);
VAR i: INTEGER;
BEGIN
i := LENGTH(str) - 1;
WHILE i >= 0 DO
IF str[i] = c1 THEN
str[i] := c2
END;
DEC(i)
END
END replace;
BEGIN
NEW(res);
IF res # NIL THEN
NEW(res.filter_area);
IF res.filter_area # NIL THEN
res.s_com_area_name := "FFFFFFFF_open_dialog";
res.com_area := 0;
res.type := type;
res.draw_window := draw_window;
COPY(def_path, res.s_dir_default_path);
COPY(filter, res.filter_area.filter);
n := LENGTH(res.filter_area.filter);
FOR i := 0 TO 3 DO
res.filter_area.filter[n + i] := "|"
END;
res.filter_area.filter[n + 4] := 0X;
res.X := 0;
res.Y := 0;
res.s_opendir_path := res.s_dir_default_path;
res.FilePath := "";
res.FileName := "";
res.status := 0;
res.filter_area.size := LENGTH(res.filter_area.filter);
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/File managers/opendial");
res.opendir_path := sys.ADR(res.s_opendir_path[0]);
res.dir_default_path := sys.ADR(res.s_dir_default_path[0]);
res.openfile_path := sys.ADR(res.FilePath[0]);
res.filename_area := sys.ADR(res.FileName[0]);
replace(res.filter_area.filter, "|", 0X);
OpenDialog_init(res)
ELSE
DISPOSE(res)
END
END
RETURN res
END Create;
PROCEDURE Destroy*(VAR od: Dialog);
BEGIN
IF od # NIL THEN
DISPOSE(od.filter_area);
DISPOSE(od)
END
END Destroy;
END OpenDlg.

543
programs/other/fb2reader/SRC/RTL.ob07 Normal file
View File

@ -0,0 +1,543 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE RTL;
IMPORT SYSTEM, API;
CONST
minint = ROR(1, 1);
WORD = API.BIT_DEPTH DIV 8;
VAR
name: INTEGER;
types: INTEGER;
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
0FCH, (* cld *)
057H, (* push edi *)
056H, (* push esi *)
08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
089H, 0C1H, (* mov ecx, eax *)
0C1H, 0E9H, 002H, (* shr ecx, 2 *)
0F3H, 0A5H, (* rep movsd *)
089H, 0C1H, (* mov ecx, eax *)
083H, 0E1H, 003H, (* and ecx, 3 *)
0F3H, 0A4H, (* rep movsb *)
05EH, (* pop esi *)
05FH (* pop edi *)
(* L: *)
)
END _move;
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, dst, src);
res := TRUE
END
RETURN res
END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *)
049H, (* dec ecx *)
053H, (* push ebx *)
08BH, 018H, (* mov ebx, dword [eax] *)
(* L: *)
08BH, 050H, 004H, (* mov edx, dword [eax + 4] *)
089H, 010H, (* mov dword [eax], edx *)
083H, 0C0H, 004H, (* add eax, 4 *)
049H, (* dec ecx *)
075H, 0F5H, (* jnz L *)
089H, 018H, (* mov dword [eax], ebx *)
05BH, (* pop ebx *)
05DH, (* pop ebp *)
0C2H, 008H, 000H (* ret 8 *)
)
END _rot;
PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
BEGIN
SYSTEM.CODE(
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *)
039H, 0C8H, (* cmp eax, ecx *)
07FH, 033H, (* jg L1 *)
083H, 0F8H, 01FH, (* cmp eax, 31 *)
07FH, 02EH, (* jg L1 *)
085H, 0C9H, (* test ecx, ecx *)
07CH, 02AH, (* jl L1 *)
083H, 0F9H, 01FH, (* cmp ecx, 31 *)
07EH, 005H, (* jle L3 *)
0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *)
(* L3: *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L2 *)
031H, 0C0H, (* xor eax, eax *)
(* L2: *)
089H, 0CAH, (* mov edx, ecx *)
029H, 0C2H, (* sub edx, eax *)
0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *)
087H, 0CAH, (* xchg edx, ecx *)
0D3H, 0F8H, (* sar eax, cl *)
087H, 0CAH, (* xchg edx, ecx *)
083H, 0E9H, 01FH, (* sub ecx, 31 *)
0F7H, 0D9H, (* neg ecx *)
0D3H, 0E8H, (* shr eax, cl *)
05DH, (* pop ebp *)
0C2H, 008H, 000H, (* ret 8 *)
(* L1: *)
031H, 0C0H, (* xor eax, eax *)
05DH, (* pop ebp *)
0C2H, 008H, 000H (* ret 8 *)
)
END _set;
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
BEGIN
SYSTEM.CODE(
031H, 0C0H, (* xor eax, eax *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *)
083H, 0F9H, 01FH, (* cmp ecx, 31 *)
077H, 003H, (* ja L *)
00FH, 0ABH, 0C8H (* bts eax, ecx *)
(* L: *)
)
END _set1;
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
074H, 018H, (* je L2 *)
07FH, 002H, (* jg L1 *)
0F7H, 0D2H, (* not edx *)
(* L1: *)
089H, 0C3H, (* mov ebx, eax *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
0F7H, 0F9H, (* idiv ecx *)
085H, 0D2H, (* test edx, edx *)
074H, 009H, (* je L2 *)
031H, 0CBH, (* xor ebx, ecx *)
085H, 0DBH, (* test ebx, ebx *)
07DH, 003H, (* jge L2 *)
048H, (* dec eax *)
001H, 0CAH, (* add edx, ecx *)
(* L2: *)
05BH (* pop ebx *)
)
END _divmod;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, WORD)
END
END _new;
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
PROCEDURE [stdcall] _length* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
(* L1: *)
040H, (* inc eax *)
080H, 038H, 000H, (* cmp byte [eax], 0 *)
074H, 003H, (* jz L2 *)
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
END _length;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
048H, (* dec eax *)
(* L1: *)
040H, (* inc eax *)
040H, (* inc eax *)
066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
074H, 004H, (* jz L2 *)
0E2H, 0F6H, (* loop L1 *)
040H, (* inc eax *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H (* shr eax, 1 *)
)
END _lengthw;
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 017H, (* jle L3 *)
08AH, 00EH, (* mov cl, byte[esi] *)
08AH, 017H, (* mov dl, byte[edi] *)
046H, (* inc esi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E7H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmp;
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 01BH, (* jle L3 *)
066H, 08BH, 00EH, (* mov cx, word[esi] *)
066H, 08BH, 017H, (* mov dx, word[edi] *)
046H, (* inc esi *)
046H, (* inc esi *)
047H, (* inc edi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E3H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: CHAR;
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
END;
CASE op OF
|0: bRes := res = 0
|1: bRes := res # 0
|2: bRes := res < 0
|3: bRes := res <= 0
|4: bRes := res > 0
|5: bRes := res >= 0
END
RETURN bRes
END _strcmp;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: WCHAR;
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
END;
CASE op OF
|0: bRes := res = 0
|1: bRes := res # 0
|2: bRes := res < 0
|3: bRes := res <= 0
|4: bRes := res > 0
|5: bRes := res >= 0
END
RETURN bRes
END _strcmpw;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
c: CHAR;
i: INTEGER;
BEGIN
i := 0;
REPEAT
SYSTEM.GET(pchar, c);
s[i] := c;
INC(pchar);
INC(i)
UNTIL c = 0X
END PCharToStr;
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
VAR
i, a: INTEGER;
BEGIN
i := 0;
a := x;
REPEAT
INC(i);
a := a DIV 10
UNTIL a = 0;
str[i] := 0X;
REPEAT
DEC(i);
str[i] := CHR(x MOD 10 + ORD("0"));
x := x DIV 10
UNTIL x = 0
END IntToStr;
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
ASSERT(n1 + n2 < LEN(s1));
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
s1[n1 + n2] := 0X
END append;
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
BEGIN
CASE err OF
| 1: s := "assertion failure"
| 2: s := "NIL dereference"
| 3: s := "bad divisor"
| 4: s := "NIL procedure call"
| 5: s := "type guard error"
| 6: s := "index out of range"
| 7: s := "invalid CASE"
| 8: s := "array assignment error"
| 9: s := "CHR out of range"
|10: s := "WCHR out of range"
|11: s := "BYTE out of range"
END;
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
API.exit_thread(0)
END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
RETURN p MOD 2
END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
END
RETURN p MOD 2
END _guard;
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
END _dllentry;
PROCEDURE [stdcall] _sofinit*;
BEGIN
API.sofinit
END _sofinit;
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code);
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * WORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
name := modname
END _init;
END RTL.

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

@ -0,0 +1,42 @@
(*
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.

159
programs/other/fb2reader/SRC/ReadFile.ob07 Normal file
View File

@ -0,0 +1,159 @@
(*
Copyright 2016, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE ReadFile;
IMPORT sys := SYSTEM, K := KOSAPI, S := Strings, File, SU := SysUtils, Encode;
VAR
Mem, Pos, Size, FSize*: INTEGER;
Error*: BOOLEAN;
PROCEDURE Adr*(): INTEGER;
RETURN Mem + Pos
END Adr;
PROCEDURE Next*(VAR ch: CHAR);
BEGIN
INC(Pos);
sys.GET(Mem + Pos, ch)
END Next;
PROCEDURE Progress*(): REAL;
VAR res: REAL;
BEGIN
res := FLT(Pos) / FLT(Size);
IF res < 0.0 THEN
res := 0.0
END;
IF res > 1.0 THEN
res := 1.0
END
RETURN res
END Progress;
PROCEDURE Load*(FileName: S.STRING);
VAR F: File.FS; pos, FileSize: INTEGER;
BEGIN
Error := TRUE;
Mem := 0;
F := File.Open(FileName);
SU.ErrorIf(F = NIL, 1);
FileSize := File.Seek(F, 0, File.SEEK_END);
Size := FileSize;
SU.ErrorIf(FileSize <= 0, 1);
pos := File.Seek(F, 0, File.SEEK_BEG);
SU.ErrorIf(pos # 0, 1);
Mem := K.malloc(FileSize + 1024);
SU.MemError(Mem = 0);
pos := File.Read(F, Mem, FileSize);
SU.ErrorIf(pos # FileSize, 1);
sys.PUT(Mem + FileSize, 0X);
File.Close(F);
Pos := -1;
Error := FALSE;
FSize := FileSize
END Load;
PROCEDURE Free*;
BEGIN
IF Mem # 0 THEN
Mem := K.free(Mem)
END
END Free;
PROCEDURE Conv*(cp: Encode.CP);
VAR m, nov, mem2, k: INTEGER; c: CHAR;
BEGIN
m := Mem;
k := 0;
REPEAT
sys.GET(m, c); INC(m);
k := k + cp[ORD(c)].len
UNTIL c = 0X;
nov := K.malloc(k + 1024);
SU.MemError(nov = 0);
Size := k;
mem2 := nov;
m := Mem;
REPEAT
sys.GET(m, c); INC(m);
sys.MOVE(sys.ADR(cp[ORD(c)].utf8), nov, cp[ORD(c)].len);
nov := nov + cp[ORD(c)].len
UNTIL c = 0X;
Pos := -1;
Mem := K.free(Mem);
Mem := mem2;
END Conv;
PROCEDURE SeekBeg*;
BEGIN
Pos := -1
END SeekBeg;
PROCEDURE Int*(): INTEGER;
VAR i: INTEGER;
BEGIN
sys.GET(Mem + Pos, i)
RETURN i
END Int;
PROCEDURE FileSize*(name: S.STRING): INTEGER;
VAR F: File.FS; res: INTEGER;
BEGIN
F := File.Open(name);
res := File.Seek(F, 0, 2);
File.Close(F)
RETURN res
END FileSize;
PROCEDURE ChkSum* (name: S.STRING): INTEGER;
VAR
ptr, size, res: INTEGER;
b: BYTE;
BEGIN
res := 0;
ptr := File.Load(name, size);
IF ptr # 0 THEN
WHILE size > 0 DO
sys.GET(ptr, b);
INC(res, b);
INC(ptr);
DEC(size)
END;
ptr := K.free(ptr)
END
RETURN res
END ChkSum;
END ReadFile.

645
programs/other/fb2reader/SRC/Search.ob07 Normal file
View File

@ -0,0 +1,645 @@
(*
Copyright 2020, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Search;
IMPORT
XML, G := Graph, Window, Font, S := Strings, LISTS, SYSTEM,
SU := SysUtils, K := KOSAPI, SearchForm;
TYPE
STRING* = SearchForm.STRING;
PFind = PROCEDURE (d: INTEGER);
TRect = POINTER TO RECORD (LISTS.ITEM)
x1, y1, x2, y2: INTEGER
END;
TPos = POINTER TO RECORD (LISTS.ITEM)
n, first, last: INTEGER;
RectList: LISTS.LIST
END;
TextIdx = POINTER TO RECORD
cnt, offs: ARRAY 256 OF INTEGER;
table: INTEGER;
data, size: INTEGER
END;
Text = POINTER TO RECORD (LISTS.ITEM)
case: BOOLEAN;
idx0, idx1: TextIdx;
str0, str1: STRING;
PosList: LISTS.LIST;
curPos: TPos;
found: INTEGER;
body: XML.TAG
END;
VAR
TextList: LISTS.LIST;
Body: XML.TAG;
Find: PFind;
PROCEDURE SelText (Col: Window.TRect; min, max, Ycur, LineH: INTEGER; right: BOOLEAN; rect: TRect; cur: BOOLEAN);
VAR
y, y0, color: INTEGER;
BEGIN
y := rect.y1 - Ycur;
y0 := y - y MOD LineH;
IF (min <= y0) & (y0 <= max) THEN
IF cur THEN
color := 0FF0000H
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)
END
END SelText;
PROCEDURE draw* (body: XML.TAG; ColLeft, ColRight: Window.TRect; Ycur, LineH: INTEGER; TwoCol: BOOLEAN);
VAR
rect: TRect;
pos, cur: TPos;
BEGIN
Body := body;
IF body.text # NIL THEN
pos := body.text(Text).PosList.first(TPos);
cur := body.text(Text).curPos
ELSE
pos := NIL;
cur := NIL
END;
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);
IF TwoCol THEN
SelText(ColRight, ColLeft.Height, ColLeft.Height + ColRight.Height - LineH, Ycur, LineH, TRUE, rect, pos = cur)
END;
rect := rect.next(TRect)
END;
pos := pos.next(TPos)
END
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;
BEGIN
cur := body;
WHILE (cur # NIL) DO
IF cur IS XML.TAG THEN
textlen(cur(XML.TAG).child.first, length)
ELSIF cur IS XML.WORD THEN
INC(length, cur(XML.WORD).value.last - cur(XML.WORD).value.first + 1)
ELSIF cur IS XML.SPACE THEN
INC(length)
END;
cur := cur.next
END
END textlen;
PROCEDURE puttext (body: XML.ELEMENT; VAR buf: INTEGER);
VAR
cur: XML.ELEMENT;
len: INTEGER;
BEGIN
cur := body;
WHILE (cur # NIL) DO
IF cur IS XML.TAG THEN
puttext(cur(XML.TAG).child.first, buf)
ELSIF cur IS XML.WORD THEN
len := cur(XML.WORD).value.last - cur(XML.WORD).value.first + 1;
SYSTEM.MOVE(cur(XML.WORD).value.first, buf, len);
INC(buf, len)
ELSIF cur IS XML.SPACE THEN
SYSTEM.PUT(buf, 20X);
INC(buf)
END;
cur := cur.next
END
END puttext;
PROCEDURE cap (code: INTEGER): INTEGER;
BEGIN
CASE code OF
|61H..7AH, 430H..44FH:
DEC(code, 32)
|451H..45FH:
DEC(code, 80)
|491H:
code := 490H
ELSE
END
RETURN code
END cap;
PROCEDURE UpCase (s1, s2, length: INTEGER);
VAR
code, n: INTEGER;
u: S.UTF8;
BEGIN
WHILE length > 0 DO
getc_utf8(s1, length, code);
S.utf8(cap(code), u);
n := LENGTH(u);
SYSTEM.MOVE(SYSTEM.ADR(u[0]), s2, n);
INC(s2, n)
END
END UpCase;
PROCEDURE create (body: XML.ELEMENT);
VAR
length, buf, buf1, temp: INTEGER;
text: Text;
xml: XML.ELEMENT;
PROCEDURE index (idx: TextIdx; buf, length: INTEGER);
VAR
i: INTEGER;
c: CHAR;
offs, temp: INTEGER;
BEGIN
idx.data := buf;
idx.size := length;
FOR i := 0 TO 255 DO
idx.offs[i] := 0;
idx.cnt[i] := 0
END;
i := length;
WHILE i > 0 DO
SYSTEM.GET(buf, c);
INC(idx.offs[ORD(c)]);
DEC(i);
INC(buf)
END;
offs := 0;
FOR i := 0 TO 255 DO
temp := offs;
INC(offs, idx.offs[i]);
idx.offs[i] := temp * 4
END;
idx.table := K.malloc(offs * 4);
SU.MemError(idx.table = 0);
i := length;
buf := idx.data;
WHILE i > 0 DO
SYSTEM.GET(buf, c);
SYSTEM.PUT(idx.table + idx.offs[ORD(c)] + idx.cnt[ORD(c)] * 4, length - i);
INC(idx.cnt[ORD(c)]);
DEC(i);
INC(buf)
END
END index;
BEGIN
NEW(text);
text.body := body(XML.TAG);
text.PosList := LISTS.create(NIL);
xml := body;
body := body(XML.TAG).child.first;
textlen(body, length);
buf := K.malloc(length);
SU.MemError(buf = 0);
temp := buf;
puttext(body, temp);
NEW(text.idx0);
index(text.idx0, buf, length);
buf1 := K.malloc(length);
SU.MemError(buf1 = 0);
UpCase(buf, buf1, length);
NEW(text.idx1);
index(text.idx1, buf1, text.idx0.size);
text.case := FALSE;
text.str0 := "";
text.str1 := "";
xml(XML.TAG).text := text;
LISTS.push(TextList, text)
END create;
PROCEDURE select (body: XML.ELEMENT; VAR pos: TPos; VAR curpos, strong, italic, code: INTEGER);
VAR
cur : XML.ELEMENT;
word : XML.WORD;
space : XML.SPACE;
tag_value, len, wbeg, wend, selbeg, selend,
a, b, z, x, w: INTEGER;
PROCEDURE New (RectList: LISTS.LIST; x1, y1, x2, y2: INTEGER);
VAR rect: TRect;
BEGIN
NEW(rect);
rect.x1 := x1; rect.y1 := y1;
rect.x2 := x2; rect.y2 := y2;
LISTS.push(RectList, rect)
END New;
BEGIN
cur := body;
WHILE (cur # NIL) & (pos # NIL) DO
selbeg := pos.first;
selend := pos.last;
IF cur IS XML.TAG THEN
tag_value := cur(XML.TAG).value;
CASE tag_value OF
|XML.tag_title, XML.tag_strong, XML.tag_th:
INC(strong);
Font.Bold(TRUE)
|XML.tag_epigraph, XML.tag_cite, XML.tag_emphasis:
INC(italic);
Font.Italic(TRUE, FALSE)
|XML.tag_code:
Font.sysfont(TRUE);
INC(code)
ELSE
END;
select(cur(XML.TAG).child.first, pos, curpos, strong, italic, code);
CASE tag_value OF
|XML.tag_title, XML.tag_strong, XML.tag_th, XML.tag_text_author, XML.tag_date:
DEC(strong);
Font.Bold(strong > 0)
|XML.tag_epigraph, XML.tag_cite, XML.tag_emphasis:
DEC(italic);
Font.Italic(italic > 0, FALSE)
|XML.tag_code:
DEC(code);
Font.sysfont(code > 0)
ELSE
END;
IF pos # NIL THEN
selbeg := pos.first;
selend := pos.last
END
ELSIF cur IS XML.WORD THEN
word := cur(XML.WORD);
len := word.value.last - word.value.first + 1;
wbeg := curpos;
wend := curpos + len - 1;
INC(curpos, len);
a := MAX(wbeg, selbeg);
b := MIN(wend, selend);
IF b >= a THEN
x := word.width;
IF (a = wbeg) & (b = wend) THEN
New(pos.RectList, word.X, word.Y, word.X + word.width, word.Y + Font.FontH());
ELSIF (a = selbeg) & (b = wend) THEN
z := selbeg - wbeg;
INC(word.value.first, z);
word.width := Font.TextWidth(word.value, S.Utf8Length(word.value));
INC(word.X, x - word.width);
New(pos.RectList, word.X, word.Y, word.X + word.width, word.Y + Font.FontH());
DEC(word.value.first, z);
DEC(word.X, x - word.width)
ELSIF (a = wbeg) & (b = selend) THEN
z := wend - selend;
DEC(word.value.last, z);
word.width := Font.TextWidth(word.value, S.Utf8Length(word.value));
New(pos.RectList, word.X, word.Y, word.X + word.width, word.Y + Font.FontH());
INC(word.value.last, z)
ELSIF (a = selbeg) & (b = selend) THEN
z := selbeg - wbeg;
w := wend - selend;
INC(word.value.first, z);
INC(word.X, x - Font.TextWidth(word.value, S.Utf8Length(word.value)));
DEC(word.value.last, w);
word.width := Font.TextWidth(word.value, S.Utf8Length(word.value));
New(pos.RectList, word.X, word.Y, word.X + word.width, word.Y + Font.FontH());
INC(word.value.last, w);
DEC(word.X, x - Font.TextWidth(word.value, S.Utf8Length(word.value)));
DEC(word.value.first, z)
END;
word.width := x
END
ELSIF cur IS XML.SPACE THEN
IF (selbeg <= curpos) & (curpos <= selend) THEN
space := cur(XML.SPACE);
New(pos.RectList, space.X, space.Y, space.X + space.width, space.Y + Font.FontH())
END;
len := 1;
INC(curpos)
END;
IF curpos > selend THEN
IF pos # NIL THEN
pos := pos.next(TPos);
END;
IF cur IS XML.TEXT THEN
DEC(curpos, len)
ELSE (* tag *)
cur := cur.next
END
ELSE
cur := cur.next
END
END
END select;
PROCEDURE streq (s1, s2, n: INTEGER): BOOLEAN;
VAR
c1, c2: CHAR;
BEGIN
REPEAT
SYSTEM.GET(s1, c1); INC(s1);
SYSTEM.GET(s2, c2); INC(s2);
DEC(n)
UNTIL (n = 0) OR (c1 # c2)
RETURN c1 = c2
END streq;
PROCEDURE destroy (VAR item: LISTS.ITEM);
BEGIN
LISTS.destroy(item(TPos).RectList);
DISPOSE(item)
END destroy;
PROCEDURE find (body: XML.TAG; str: STRING);
VAR
c: CHAR;
offs, i, pos, strong, italic, code: INTEGER;
posItem: TPos;
text: Text;
pstr, slen: INTEGER;
idx: TextIdx;
BEGIN
text := body.text(Text);
text.found := 0;
LISTS.destroy(text.PosList);
text.PosList := LISTS.create(NIL);
text.str0 := str;
UpCase(SYSTEM.ADR(str[0]), SYSTEM.ADR(text.str1[0]), LENGTH(str));
IF text.case THEN
idx := text.idx0;
pstr := SYSTEM.ADR(text.str0[0])
ELSE
idx := text.idx1;
pstr := SYSTEM.ADR(text.str1[0])
END;
slen := LENGTH(str);
SYSTEM.GET(pstr, c);
offs := idx.offs[ORD(c)];
i := idx.cnt[ORD(c)];
WHILE i > 0 DO
SYSTEM.GET(idx.table + offs, pos);
INC(offs, 4);
IF (pos + slen <= idx.size) & streq(pstr, idx.data + pos, slen) THEN
NEW(posItem);
posItem.n := text.found;
posItem.first := pos;
posItem.last := pos + slen - 1;
posItem.RectList := LISTS.create(NIL);
posItem.destroy := destroy;
LISTS.push(text.PosList, posItem);
INC(text.found)
END;
DEC(i)
END;
posItem := text.PosList.first(TPos);
pos := 0; strong := 0; italic := 0; code := 0;
select(body.child.first, posItem, pos, strong, italic, code);
text.curPos := NIL
END find;
PROCEDURE ffirst (body: XML.TAG);
VAR
text: Text;
BEGIN
text := body.text(Text);
IF text.str0 # "" THEN
find(body, text.str0);
text.curPos := text.PosList.first(TPos)
END
END ffirst;
PROCEDURE found* (body: XML.TAG): BOOLEAN;
RETURN (body # NIL) & (body.text # NIL) & (body.text(Text).found # 0)
END found;
PROCEDURE fnext* (body: XML.TAG; VAR y: INTEGER; d: INTEGER);
VAR
text: Text;
rect: TRect;
cur: LISTS.ITEM;
BEGIN
text := body.text(Text);
IF (text # NIL) & (text.found # 0) THEN
cur := text.curPos;
CASE d OF
|1:
IF cur.next # NIL THEN
cur := cur.next
ELSE
cur := text.PosList.first
END
|-1:
IF cur.prev # NIL THEN
cur := cur.prev
ELSE
cur := text.PosList.last
END
|0:
cur := text.PosList.first
END;
text.curPos := cur(TPos);
rect := text.curPos.RectList.first(TRect);
IF rect # NIL THEN
y := rect.y1
END
ELSE
y := -1
END
END fnext;
PROCEDURE open* (_find: PFind);
BEGIN
Find := _find;
SearchForm.open
END open;
PROCEDURE close*;
VAR
text: Text;
body: XML.TAG;
BEGIN
body := Body;
text := body.text(Text);
IF text # NIL THEN
LISTS.destroy(text.PosList);
text.PosList := LISTS.create(NIL);
text.found := 0;
text.curPos := NIL
END
END close;
PROCEDURE resize*;
VAR
n: INTEGER;
text: Text;
item: LISTS.ITEM;
BEGIN
text := TextList.first(Text);
WHILE text # NIL DO
IF text.found # 0 THEN
n := text.curPos.n;
find(text.body, text.str0);
item := LISTS.get(text.PosList, n);
text.curPos := item(TPos)
END;
text := text.next(Text)
END
END resize;
PROCEDURE callback (case: BOOLEAN; str: STRING): BOOLEAN;
VAR
body: XML.TAG;
BEGIN
body := Body;
IF body.text = NIL THEN
create(body)
END;
body.text(Text).case := case;
body.text(Text).str0 := str;
ffirst(body);
Find(0)
RETURN body.text(Text).found # 0
END callback;
BEGIN
TextList := LISTS.create(NIL);
SearchForm.init(callback)
END Search.

199
programs/other/fb2reader/SRC/SearchForm.ob07 Normal file
View File

@ -0,0 +1,199 @@
(*
Copyright 2020-2021 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 SearchForm;
IMPORT
SYSTEM, SU := SysUtils, W := Window, box_lib, K := KOSAPI, Encode, S := Strings;
CONST
BTN_CLOSE = 1;
BTN_FIND = 19;
BTN_CANCEL = 20;
BtnH = 25;
BtnW = 80;
WINDOW_BEVEL = 4;
MAXCHARS = 2000;
TYPE
STRING* = ARRAY MAXCHARS OF CHAR;
PROC = PROCEDURE (case: BOOLEAN; str: STRING): BOOLEAN;
VAR
PID, Slot: INTEGER;
Stack: ARRAY 1000000 OF CHAR;
Window: W.TWindow;
str: STRING;
callback: PROC;
case: box_lib.checkbox;
text: box_lib.edit_box;
PROCEDURE DrawText (x, y: INTEGER; text: ARRAY OF CHAR);
VAR
L: INTEGER;
BEGIN
L := LENGTH(text);
SU.Box(x, y, L*SU.FontW, SU.FontH, SU.winColor, SU.winColor);
SU.OutText(x, y, text, L, SU.textColor)
END DrawText;
PROCEDURE buttons;
BEGIN
SU.CreateButton(BTN_FIND, 5, 80, BtnW, BtnH, SU.btnColor, "find");
SU.CreateButton(BTN_CANCEL, 5 - BtnW + text.width, 80, BtnW, BtnH, SU.btnColor, "cancel");
box_lib.check_box_draw2(case); DrawText(25, 50, "match case");
box_lib.edit_box_draw(text)
END buttons;
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);
buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
PROCEDURE close* (ok: BOOLEAN);
VAR
pid, i, j, k, n: INTEGER;
found: BOOLEAN;
str0: STRING;
u: S.UTF8;
BEGIN
found := TRUE;
box_lib.edit_box_get_value(text, str);
IF ok THEN
IF str # "" THEN
j := 0;
i := 0;
WHILE str[i] # 0X DO
u := Encode.CP866[ORD(str[i])].utf8;
n := Encode.CP866[ORD(str[i])].len;
FOR k := 0 TO n - 1 DO
str0[j] := u[k];
INC(j)
END;
INC(i)
END;
found := callback(box_lib.check_box_get_value(case), str0)
ELSE
found := FALSE
END
END;
IF found THEN
pid := PID;
PID := 0;
IF pid # 0 THEN
SU.TerminateThreadId(pid)
END
ELSE
IF str # "" THEN
DrawText(5 + BtnW + 10, 80 + 4, "not found")
END
END
END close;
PROCEDURE ButtonClick;
BEGIN
CASE SU.GetButtonCode() OF
|0 :
|BTN_CLOSE, BTN_CANCEL : close(FALSE)
|BTN_FIND : close(TRUE)
END;
buttons
END ButtonClick;
PROCEDURE show;
VAR
scrWidth, scrHeight, key: INTEGER;
BEGIN
SU.SetEventsMask({0, 1, 2, 5, 30, 31});
W.InitWindow(Window, 0, 0, 320, 140, "Search");
SU.GetScreenSize(scrWidth, scrHeight);
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
close(TRUE)
ELSIF key DIV 65536 = 1 THEN
close(FALSE)
ELSE
box_lib.edit_box_key_safe(text, key)
END
|3: ButtonClick
|6:
box_lib.check_box_mouse2(case);
box_lib.edit_box_mouse(text)
ELSE
END
END
END show;
PROCEDURE open*;
BEGIN
IF PID = 0 THEN
PID := SU.NewThread(show, Stack);
Slot := SU.GetThreadSlot(PID)
ELSE
SU.FocusWindow(Slot)
END
END open;
PROCEDURE init* (proc: PROC);
BEGIN
callback := proc;
PID := 0;
case := box_lib.kolibri_new_check_box(5, 50, 16, 16, SYSTEM.SADR(""), 14 * 8 + 5);
text := box_lib.kolibri_new_edit_box(5, 10, 300, MAXCHARS DIV 3);
text.flags := 4002H;
END init;
END SearchForm.

163
programs/other/fb2reader/SRC/SelEnc.ob07 Normal file
View File

@ -0,0 +1,163 @@
(*
Copyright 2016, 2018, 2020-2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE SelEnc;
IMPORT
SU := SysUtils, W := Window, OpenDlg, S := Strings, TXT := Txt2FB2, SYSTEM, K := KOSAPI, Settings, File;
CONST
BtnH = 30;
BtnW = 150;
BtnX = 5;
BtnY = 10;
BtnInter = 10;
tempfile* = "/tmp0/1/~temp.fb2";
VAR
Window : W.TWindow;
ENCODING* : INTEGER;
FileName : S.STRING;
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" )
END Buttons;
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);
Buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
PROCEDURE auto (fname: S.STRING): INTEGER;
VAR
enc, data, size, ptr: INTEGER;
PROCEDURE SearchPair (ptr, size: INTEGER; chr1, chr2: BYTE): BOOLEAN;
VAR
c, c0: BYTE;
res: BOOLEAN;
BEGIN
c := 0;
res := FALSE;
WHILE (size > 0) & ~res DO
c0 := c;
SYSTEM.GET(ptr, c);
IF (c = chr2) & (c0 = chr1) THEN
res := TRUE
END;
INC(ptr);
DEC(size)
END
RETURN res
END SearchPair;
BEGIN
data := File.Load(fname, size);
SU.ErrorIf(data = 0, 1);
ptr := data;
IF SearchPair(ptr, size, 208, 190) THEN
enc := TXT.UTF8
ELSE
IF SearchPair(ptr, size, 239, 240) OR SearchPair(ptr, size, 241, 242) THEN
enc := TXT.CP1251
ELSE
enc := TXT.CP866
END
END;
data := K.free(data)
RETURN enc
END auto;
PROCEDURE ButtonClick;
VAR
btn_code: INTEGER;
program, file: S.STRING;
BEGIN
btn_code := SU.GetButtonCode();
IF btn_code = TXT.AUTO THEN
ENCODING := auto(FileName)
ELSE
ENCODING := btn_code
END;
TXT.convert(FileName, tempfile, ENCODING);
S.PtrToString(K.GetName(), program);
file := tempfile;
file[0] := "!";
SU.Run(program, SYSTEM.ADR(file));
SU.Halt
END ButtonClick;
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;
DrawWindow;
WHILE TRUE DO
CASE SU.WaitForEvent() OF
|1 : DrawWindow
|3 : ButtonClick
END
END
END Show;
BEGIN
ENCODING := 0
END SelEnc.

420
programs/other/fb2reader/SRC/Settings.ob07 Normal file
View File

@ -0,0 +1,420 @@
(*
Copyright 2016, 2018, 2020-2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Settings;
IMPORT SU := SysUtils, W := Window, C := ColorDlg, DOM, S := Strings,
Font, KF := kfonts, OD := OpenDlg, LibImg, G := Graph, Ini, box_lib, sys := SYSTEM;
CONST
DAY = 19;
NIGHT = 20;
APPLY = 21;
CANCEL = 22;
BACK_PICTURE = 23;
C100 = 100;
CHANGE_BACK_COLOR = DOM.BACK_COLOR + C100;
CHANGE_TEXT_COLOR = DOM.TEXT_COLOR + C100;
CHANGE_ITALIC_COLOR = DOM.ITALIC_COLOR + C100;
CHANGE_LINK_COLOR = DOM.LINK_COLOR + C100;
CHANGE_VISITED_COLOR = DOM.VISITED_COLOR + C100;
MAX_LRpc = 25;
MAX_Top = 120;
MAX_PARAGRAPH = 120;
MAX_EPIGRAPH = 120;
MAX_CInt = 25;
MAX_InterLin = 50;
MAX_FONT_SIZE = 40;
MIN_FONT_SIZE = 10;
BtnH* = 25;
BoxW = 50;
TextLeft = 20;
BtnW* = 80;
VAR
Window : W.TWindow;
PID : INTEGER;
Slot : INTEGER;
Color : C.Dialog;
Data : DOM.TSettings;
String : S.STRING;
sb : ARRAY 7 OF box_lib.scrollbar;
check1 : box_lib.checkbox;
check2 : box_lib.checkbox;
OpenPict : OD.Dialog;
picture : INTEGER;
picture_path : S.STRING;
PROCEDURE Close*;
VAR pid: INTEGER;
BEGIN
IF PID # 0 THEN
pid := PID;
PID := 0;
IF (picture # 0) & (picture # Data.Picture) THEN
LibImg.img_destroy(picture)
END;
C.Destroy(Color);
OD.Destroy(OpenPict);
SU.TerminateThreadId(pid)
END
END Close;
PROCEDURE ClearWindow;
BEGIN
SU.Box(0, 0, Window.Width - 10, Window.Height - SU.SkinHeight() - 5, SU.winColor, SU.winColor)
END ClearWindow;
PROCEDURE OutText (x, y: INTEGER; text: ARRAY OF CHAR);
BEGIN
SU.OutText(x, y, text, LENGTH(text), SU.textColor)
END OutText;
PROCEDURE PlusMinus(x, y, max, min: INTEGER; _sb: box_lib.scrollbar);
VAR range, Y: INTEGER;
sysfont: ARRAY 20 OF CHAR;
BEGIN
sysfont := "System font only";
S.IntToString(_sb.position + min, String);
IF _sb = sb[0] THEN
Y := y - (BtnH + 10) * 2 + 26;
SU.Box(TextLeft + 230, Y, SU.FontW * LENGTH(sysfont), SU.FontH, SU.winColor, SU.winColor);
IF ~KF.Enabled(Font.KFont, _sb.position + min) THEN
OutText(TextLeft + 230, Y, sysfont)
END
END;
SU.Box(x + 25, y + 6, SU.FontW * 4, SU.FontH, SU.winColor, SU.winColor);
OutText(x + 25 + (35 - SU.FontW * LENGTH(String)) DIV 2, y + 6, String);
x := x + 60 - 25;
range := max - min;
_sb := box_lib.kolibri_scrollbar(_sb, (x + 30) * 65536 + 196, y * 65536 + 22 + 2, 22, range + range DIV 10, range DIV 10,
_sb.position, SU.lightColor, SU.btnColor, 0, 2)
END PlusMinus;
PROCEDURE Buttons;
VAR
X, Y, TextY : INTEGER;
WinW, WinH, SkinH : INTEGER;
i : INTEGER;
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);
WinW := Window.Width;
WinH := Window.Height;
SkinH := SU.SkinHeight();
X := 125;
Y := 10;
IF picture = 0 THEN
OutText(TextLeft + 20, Y + 6, "back picture (none)")
ELSE
OutText(TextLeft + 20, Y + 6, "back picture")
END;
SU.CreateButton(BACK_PICTURE, X + 75, Y, 30, BtnH, SU.btnColor, "...");
Y := 10 + (BtnH + 10);
OutText(TextLeft + 20, Y + 6, "two columns");
Y := Y + (BtnH + 10) * 2 - 20;
TextY := Y;
FOR i := 0 TO 4 DO
SU.Box(X, Y, BoxW, BtnH, Data.Colors[i], 0);
SU.CreateButton(i + C100, X + BoxW + 5, Y, 30, BtnH, SU.btnColor, "...");
Y := Y + BtnH + 10;
END;
X := 20; Y := TextY + 6;
OutText(TextLeft, Y, "back"); OutText(TextLeft + 230, Y, "font size"); PlusMinus(TextLeft + 330, Y - 6, MAX_FONT_SIZE, MIN_FONT_SIZE, sb[0]); Y := Y + BtnH + 10;
OutText(TextLeft, Y, "text"); OutText(TextLeft + 230, Y, "left & right %"); PlusMinus(TextLeft + 330, Y - 6, MAX_LRpc, 0, sb[1]); Y := Y + BtnH + 10;
OutText(TextLeft, Y, "italic"); OutText(TextLeft + 230, Y, "col. spacing %"); PlusMinus(TextLeft + 330, Y - 6, MAX_CInt, 0, sb[2]); Y := Y + BtnH + 10;
OutText(TextLeft, Y, "link"); OutText(TextLeft + 230, Y, "top & bottom"); PlusMinus(TextLeft + 330, Y - 6, MAX_Top, 0, sb[3]); Y := Y + BtnH + 10;
OutText(TextLeft, Y, "visited"); OutText(TextLeft + 230, Y, "paragraph"); PlusMinus(TextLeft + 330, Y - 6, MAX_PARAGRAPH, 0, sb[4]); Y := Y + BtnH + 10;
OutText(TextLeft + 230, Y, "epigraph"); PlusMinus(TextLeft + 330, Y - 6, MAX_EPIGRAPH, 0, sb[5]); Y := Y + BtnH + 10;
OutText(TextLeft + 230, Y, "line spacing"); PlusMinus(TextLeft + 330, Y - 6, MAX_InterLin, 0, sb[6]);
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(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");
FOR i := 0 TO LEN(sb) - 1 DO
box_lib.scrollbar_h_draw(sb[i])
END;
box_lib.check_box_draw2(check1);
box_lib.check_box_draw2(check2);
END Buttons;
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);
Buttons;
SU.WindowRedrawStatus(2)
END DrawWindow;
PROCEDURE SelColor(Color: C.Dialog; Default: INTEGER): INTEGER;
VAR Result: INTEGER;
BEGIN
Result := Default;
IF Color # NIL THEN
C.Show(Color);
WHILE Color.status = 2 DO
SU.Pause(20)
END;
IF Color.status = 1 THEN
Result := Color.color
END
END
RETURN Result
END SelColor;
PROCEDURE ChangeColor(idx: INTEGER);
BEGIN
Data.Colors[idx] := SelColor(Color, Data.Colors[idx])
END ChangeColor;
PROCEDURE Day;
BEGIN
Data.Colors[DOM.BACK_COLOR] := 0F0F0C7H;
Data.Colors[DOM.TEXT_COLOR] := 0000000H;
Data.Colors[DOM.ITALIC_COLOR] := 0505050H;
Data.Colors[DOM.LINK_COLOR] := 00000FFH;
Data.Colors[DOM.VISITED_COLOR] := 0800080H;
Data.Colors[DOM.CLICKED_COLOR] := 0FF0000H;
END Day;
PROCEDURE Night;
BEGIN
Data.Colors[DOM.BACK_COLOR] := 0000000H;
Data.Colors[DOM.TEXT_COLOR] := 0AFAFAFH;
Data.Colors[DOM.ITALIC_COLOR] := 07F7F7FH;
Data.Colors[DOM.LINK_COLOR] := 000A0D0H;
Data.Colors[DOM.VISITED_COLOR] := 0C000C0H;
Data.Colors[DOM.CLICKED_COLOR] := 0FF0000H;
END Night;
PROCEDURE Apply;
BEGIN
Data.FontSize := sb[0].position + MIN_FONT_SIZE;
Data.PADDING.LRpc := sb[1].position;
Data.PADDING.CInt := sb[2].position;
Data.PADDING.Top := sb[3].position;
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)
END;
Data.Picture := picture;
Ini.SetPicturePath(picture_path)
END;
picture := 0;
DOM.SetSettings(Data);
Close
END Apply;
PROCEDURE LoadPicture(file_path: S.STRING);
VAR ysize, img: INTEGER;
BEGIN
img := LibImg.LoadFromFile(file_path, 10240000, ysize);
IF img # 0 THEN
IF (picture # 0) & (picture # Data.Picture) THEN
LibImg.img_destroy(picture)
END;
picture := img;
picture_path := file_path
END
END LoadPicture;
PROCEDURE OpenPicture;
BEGIN
IF OpenPict # NIL THEN
OD.Show(OpenPict, 500, 400);
WHILE OpenPict.status = 2 DO
SU.Pause(30)
END;
IF OpenPict.status = 1 THEN
COPY(OpenPict.FilePath, picture_path);
LoadPicture(picture_path)
END
END
END OpenPicture;
PROCEDURE ButtonClick;
BEGIN
CASE SU.GetButtonCode() OF
|0 :
|1 : Close
|BACK_PICTURE : OpenPicture
|DAY : Day
|NIGHT : Night
|APPLY : Apply
|CANCEL : Close
|CHANGE_BACK_COLOR : ChangeColor(DOM.BACK_COLOR)
|CHANGE_TEXT_COLOR : ChangeColor(DOM.TEXT_COLOR)
|CHANGE_ITALIC_COLOR : ChangeColor(DOM.ITALIC_COLOR)
|CHANGE_LINK_COLOR : ChangeColor(DOM.LINK_COLOR)
|CHANGE_VISITED_COLOR : ChangeColor(DOM.VISITED_COLOR)
END;
ClearWindow;
Buttons
END ButtonClick;
PROCEDURE Default*;
BEGIN
Day;
Data.FontSize := 16;
Data.TwoCol := FALSE;
Data.PADDING.Top := 15;
Data.PADDING.LRpc := 3;
Data.PADDING.CInt := 6;
Data.PARAGRAPH := 30;
Data.EPIGRAPH := 100;
Data.InterLin := 0;
Data.Picture := picture;
DOM.SetSettings(Data)
END Default;
PROCEDURE Show;
VAR i, scrWidth, scrHeight: INTEGER;
BEGIN
SU.SetEventsMask({0, 2, 5, 30, 31});
W.InitWindow(Window, 0, 0, 640, 420, "Settings");
SU.GetScreenSize(scrWidth, scrHeight);
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;
DrawWindow;
WHILE TRUE DO
CASE SU.WaitForEvent() OF
|1 : DrawWindow
|3 : ButtonClick
|6 : FOR i := 0 TO LEN(sb) - 1 DO
box_lib.scrollbar_h_mouse(sb[i])
END;
box_lib.check_box_mouse2(check1);
box_lib.check_box_mouse2(check2);
PlusMinus(TextLeft + 330, sb[0].y_h DIV 65536, MAX_FONT_SIZE, MIN_FONT_SIZE, sb[0]);
PlusMinus(TextLeft + 330, sb[1].y_h DIV 65536, MAX_LRpc, 0, sb[1]);
PlusMinus(TextLeft + 330, sb[2].y_h DIV 65536, MAX_CInt, 0, sb[2]);
PlusMinus(TextLeft + 330, sb[3].y_h DIV 65536, MAX_Top, 0, sb[3]);
PlusMinus(TextLeft + 330, sb[4].y_h DIV 65536, MAX_PARAGRAPH, 0, sb[4]);
PlusMinus(TextLeft + 330, sb[5].y_h DIV 65536, MAX_EPIGRAPH, 0, sb[5]);
PlusMinus(TextLeft + 330, sb[6].y_h DIV 65536, MAX_InterLin, 0, sb[6]);
Data.TwoCol := box_lib.check_box_get_value(check1);
Data.b_pict := box_lib.check_box_get_value(check2);
END
END
END Show;
PROCEDURE Open*;
BEGIN
IF PID = 0 THEN
Data := DOM.Settings;
box_lib.check_box_set_value(check1, Data.TwoCol);
box_lib.check_box_set_value(check2, Data.b_pict);
PID := SU.NewThread(Show, DOM.Stack);
Slot := SU.GetThreadSlot(PID);
sb[0].position := Data.FontSize - MIN_FONT_SIZE;
sb[1].position := Data.PADDING.LRpc;
sb[2].position := Data.PADDING.CInt;
sb[3].position := Data.PADDING.Top;
sb[4].position := Data.PARAGRAPH;
sb[5].position := Data.EPIGRAPH;
sb[6].position := Data.InterLin;
ELSE
SU.FocusWindow(Slot)
END
END Open;
PROCEDURE main;
VAR i: INTEGER;
bpicture, twocol: ARRAY 20 OF CHAR;
BEGIN
PID := 0;
FOR i := 0 TO LEN(sb) - 1 DO
sb[i] := box_lib.kolibri_new_scrollbar(10 * 65536 + 200, 10 * 65536 + 22 + 2, 22, 15, 10, 0, 0, 0, 0, 2)
END;
bpicture := "back picture";
twocol := "two columns";
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;
IF Ini.Picture # "" THEN
LoadPicture(Ini.Picture)
END
END main;
BEGIN
main
END Settings.

414
programs/other/fb2reader/SRC/Strings.ob07 Normal file
View File

@ -0,0 +1,414 @@
(*
Copyright 2016, 2019, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Strings;
IMPORT sys := SYSTEM, KOSAPI;
TYPE
STRING* = ARRAY 1024 OF CHAR;
UTF8* = ARRAY 8 OF CHAR;
CHARS* = RECORD first*, last* : INTEGER END;
VAR
CS: BOOLEAN;
PROCEDURE [ccall, "base64.obj", ""] base64_decode (inp, outp: INTEGER; Len: INTEGER): INTEGER; END;
PROCEDURE [stdcall, "rasterworks.obj", ""] countUTF8Z (string, byteQuantity: INTEGER): INTEGER; END;
PROCEDURE DelLeft(VAR s: STRING; count: INTEGER);
VAR i, max: INTEGER;
BEGIN
max := LENGTH(s) - count - 1;
IF max >= 0 THEN
FOR i := 0 TO max DO
s[i] := s[i + count]
END
END
END DelLeft;
PROCEDURE Trim*(VAR s: STRING; ch: CHAR);
VAR i, n: INTEGER;
BEGIN
i := 0;
WHILE s[i] = ch DO
INC(i)
END;
DelLeft(s, i);
n := LENGTH(s) - 1;
IF n >= 0 THEN
i := n;
WHILE s[i] = ch DO
DEC(i)
END;
IF n # i THEN
s[i + 1] := 0X
END
END
END Trim;
PROCEDURE GetChar*(chars: CHARS; i: INTEGER): CHAR;
VAR c: CHAR;
BEGIN
ASSERT(chars.first + i <= chars.last);
sys.GET(chars.first + i, c)
RETURN c
END GetChar;
PROCEDURE Reverse*(VAR s: ARRAY OF CHAR);
VAR i, j: INTEGER; c: CHAR;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
c := s[i];
s[i] := s[j];
s[j] := c;
INC(i);
DEC(j)
END
END Reverse;
PROCEDURE IntToString*(x: INTEGER; VAR s: STRING);
VAR n, i: INTEGER;
BEGIN
i := 0;
REPEAT
n := x MOD 10;
x := x DIV 10;
s[i] := CHR(ORD("0") + n);
INC(i)
UNTIL x = 0;
s[i] := 0X;
Reverse(s)
END IntToString;
PROCEDURE isdigit(c: CHAR): BOOLEAN;
RETURN ("0" <= c) & (c <= "9")
END isdigit;
PROCEDURE CharsToInt*(s: CHARS; VAR err: BOOLEAN): INTEGER;
VAR n, i, res, len: INTEGER; c: CHAR;
BEGIN
res := 0;
len := s.last - s.first + 1;
err := len <= 0;
FOR i := 0 TO s.last - s.first DO
c := GetChar(s, i);
IF isdigit(c) THEN
n := ORD(c) - ORD("0");
res := res * 10 + n
ELSE
err := TRUE
END
END
RETURN res
END CharsToInt;
PROCEDURE Append*(VAR str1: STRING; str2: STRING);
VAR
len1, len2 : INTEGER;
i, j : INTEGER;
BEGIN
len1 := LENGTH(str1);
len2 := LENGTH(str2);
ASSERT(len1 + len2 < LEN(str1));
j := len1;
FOR i := 0 TO len2 - 1 DO
str1[j] := str2[i];
INC(j)
END;
str1[j] := 0X
END Append;
PROCEDURE GetPath*(VAR S: STRING);
VAR i, j: INTEGER;
BEGIN
j := 0;
i := LENGTH(S) - 1;
WHILE i >= 0 DO
IF S[i] = "/" THEN
j := i;
i := 0
END;
DEC(i)
END;
S[j] := 0X
END GetPath;
PROCEDURE PutChar*(chars: CHARS; i: INTEGER; c: CHAR);
BEGIN
ASSERT(chars.first + i <= chars.last);
sys.PUT(chars.first + i, c)
END PutChar;
PROCEDURE StrToChars*(str: ARRAY OF CHAR; VAR chars: CHARS);
BEGIN
ASSERT(str # "");
chars.first := sys.ADR(str[0]);
chars.last := sys.ADR(str[LENGTH(str) - 1])
END StrToChars;
PROCEDURE PtrToString*(ptr: INTEGER; VAR S: STRING);
VAR i: INTEGER; c: CHAR;
BEGIN
i := 0;
REPEAT
sys.GET(ptr, c);
S[i] := c;
INC(i);
INC(ptr)
UNTIL (c = 0X) OR (i = LEN(S));
S[i - 1] := 0X
END PtrToString;
PROCEDURE CharsEq*(chars1, chars2: CHARS): BOOLEAN;
VAR
pos, len2 : INTEGER;
c1, c2 : CHAR;
Result : BOOLEAN;
PROCEDURE CAP(VAR c: CHAR);
BEGIN
IF ~CS & ("a" <= c) & (c <= "z") THEN
c := CHR(ORD(c) - 32)
END
END CAP;
BEGIN
pos := chars1.last - chars1.first;
len2 := chars2.last - chars2.first;
IF pos = len2 THEN
REPEAT
c1 := GetChar(chars1, pos);
c2 := GetChar(chars2, pos);
CAP(c1);
CAP(c2);
DEC(pos)
UNTIL (c1 # c2) OR (pos = -1);
Result := c1 = c2
ELSE
Result := FALSE
END
RETURN Result
END CharsEq;
PROCEDURE CharsEqStr*(chars: CHARS; str: STRING): BOOLEAN;
VAR
chars2: CHARS;
BEGIN
StrToChars(str, chars2)
RETURN CharsEq(chars, chars2)
END CharsEqStr;
PROCEDURE SetCS*(value: BOOLEAN);
BEGIN
CS := value
END SetCS;
PROCEDURE Utf8Length*(chars: CHARS): INTEGER;
RETURN countUTF8Z(chars.first, chars.last - chars.first + 1)
END Utf8Length;
PROCEDURE Replace*(VAR chars: CHARS; str1, str2: ARRAY OF CHAR);
VAR
temp: CHARS;
s : CHARS;
len1: INTEGER;
len2: INTEGER;
diff: INTEGER;
PROCEDURE Put(first, last, len1, len2, diff: INTEGER; str2: ARRAY OF CHAR);
VAR i: INTEGER; c: CHAR;
BEGIN
sys.MOVE(sys.ADR(str2[0]), first, len2);
FOR i := first + len1 TO last DO
sys.GET(i, c);
sys.PUT(i - diff, c);
END
END Put;
BEGIN
len1 := LENGTH(str1);
len2 := LENGTH(str2);
diff := len1 - len2;
ASSERT(diff >= 0);
ASSERT(len1 > 0);
StrToChars(str1, s);
temp := chars;
temp.last := temp.first + len1 - 1;
WHILE temp.last <= chars.last DO
IF CharsEq(temp, s) THEN
Put(temp.first, chars.last, len1, len2, diff, str2);
chars.last := chars.last - diff;
temp.first := temp.first + len2;
temp.last := temp.first + len1 - 1
ELSE
INC(temp.first);
INC(temp.last)
END
END
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;
c : CHAR;
amp : BOOLEAN;
oct : BOOLEAN;
val : INTEGER;
exit : BOOLEAN;
str : STRING;
str2 : STRING;
uchar : UTF8;
res : BOOLEAN;
BEGIN
i := 0;
amp := FALSE;
oct := FALSE;
res := FALSE;
WHILE i <= chars.last - chars.first DO
c := GetChar(chars, i);
CASE c OF
|"&":
amp := TRUE;
oct := FALSE
|"#":
oct := amp;
amp := FALSE
|"0".."9":
IF oct THEN
val := 0;
str := "&#";
str2[1] := 0X;
exit := FALSE;
REPEAT
val := val * 10 + ORD(c) - ORD("0");
str2[0] := c;
Append(str, str2);
INC(i);
IF i <= chars.last - chars.first THEN
c := GetChar(chars, i)
ELSE
exit := TRUE
END
UNTIL ~isdigit(c) OR exit;
IF c = ";" THEN
str2[0] := c;
Append(str, str2);
utf8(val, uchar);
Replace(chars, str, uchar);
res := TRUE;
i := chars.last - chars.first
ELSE
IF ~exit THEN
DEC(i);
amp := FALSE;
oct := FALSE
END
END
ELSE
amp := FALSE
END
ELSE
amp := FALSE;
oct := FALSE
END;
INC(i)
END
RETURN res
END EntOct;
PROCEDURE UCase*(VAR s: STRING);
VAR i, n: INTEGER; c: CHAR;
BEGIN
n := LENGTH(s) - 1;
FOR i := 0 TO n DO
c := s[i];
IF ("a" <= c) & (c <= "z") OR (0A0X <= c) & (c <= 0AFX) THEN
c := CHR(ORD(c) - 32)
ELSIF (0E0X <= c) & (c <= 0EFX) THEN
c := CHR(ORD(c) - 50H)
ELSIF (c = 0F1X) OR (c = 0F3X) OR (c = 0F5X) OR (c = 0F7X) THEN
c := CHR(ORD(c) - 1)
END;
s[i] := c
END
END UCase;
PROCEDURE Base64* (VAR chars: CHARS);
BEGIN
chars.last := chars.first + base64_decode(chars.first, chars.first, chars.last - chars.first + 1) - 1
END Base64;
BEGIN
CS := TRUE
END Strings.

365
programs/other/fb2reader/SRC/SysUtils.ob07 Normal file
View File

@ -0,0 +1,365 @@
(*
Copyright 2016, 2019, 2021, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE SysUtils;
IMPORT K := KOSAPI, sys := SYSTEM, S := Strings;
CONST
L_BUTTON* = 0;
FontH* = 16;
FontW* = 8;
TYPE
ENTRY* = PROCEDURE;
VAR
(*darkColor*,*) lightColor*,
winColor*, textColor*, btnColor*, btnTextColor*,
borderColor*: INTEGER;
PROCEDURE GetParam*(VAR Param: S.STRING);
VAR
adr : INTEGER;
c : CHAR;
i, max : INTEGER;
BEGIN
adr := K.GetCommandLine();
i := 0;
max := LEN(Param) - 1;
REPEAT
sys.GET(adr, c);
INC(adr);
Param[i] := c;
INC(i)
UNTIL (c = 0X) OR (i = max);
Param[i] := 0X;
S.Trim(Param, 20X);
S.Trim(Param, 22X)
END GetParam;
PROCEDURE Halt*;
BEGIN
K.sysfunc1(-1)
END Halt;
PROCEDURE Run*(program: S.STRING; param: INTEGER);
TYPE
info_struct = RECORD
subfunc : INTEGER;
flags : INTEGER;
param : INTEGER;
rsrvd1 : INTEGER;
rsrvd2 : INTEGER;
fname : ARRAY 1024 OF CHAR
END;
VAR
info: info_struct;
BEGIN
info.subfunc := 7;
info.flags := 0;
info.param := param;
info.rsrvd1 := 0;
info.rsrvd2 := 0;
COPY(program, info.fname);
K.sysfunc2(70, sys.ADR(info))
END Run;
PROCEDURE ErrorIf*(condition: BOOLEAN; code: INTEGER);
VAR str, str2: S.STRING;
BEGIN
IF condition THEN
str := "'FB2 ERROR: ";
S.IntToString(code, str2);
S.Append(str, str2);
S.Append(str, "' -E");
Run("/sys/@notify", sys.ADR(str[0]));
Halt
END
END ErrorIf;
PROCEDURE MemError*(err: BOOLEAN);
BEGIN
ErrorIf(err, 13)
END MemError;
PROCEDURE MinMax*(VAR value: INTEGER; min, max: INTEGER);
BEGIN
value := MIN(MAX(value, min), max)
END MinMax;
PROCEDURE MousePos*(VAR X, Y: INTEGER);
VAR res: INTEGER;
BEGIN
res := K.sysfunc2(37, 0);
X := LSR(res, 16);
Y := ORD(BITS(res) * {0..15});
END MousePos;
PROCEDURE MouseVScroll*(): INTEGER;
RETURN ASR(LSL(K.sysfunc2(37, 7), 16), 16)
END MouseVScroll;
PROCEDURE MouseStatus*(): SET;
RETURN BITS(K.sysfunc2(37, 2))
END MouseStatus;
PROCEDURE WindowRedrawStatus*(status: INTEGER);
BEGIN
K.sysfunc2(12, status)
END WindowRedrawStatus;
PROCEDURE DefineAndDrawWindow*(Left, Top, Width, Height, Color, Style: INTEGER; Caption: ARRAY OF CHAR);
BEGIN
K.sysfunc6(0, LSL(Left, 16) + Width, LSL(Top, 16) + Height, Color + LSL(Style, 24), 0, sys.ADR(Caption[0]))
END DefineAndDrawWindow;
PROCEDURE WaitForEvent*(): INTEGER;
RETURN K.sysfunc1(10)
END WaitForEvent;
PROCEDURE CheckEvent*(): INTEGER;
RETURN K.sysfunc1(11)
END CheckEvent;
PROCEDURE SetEventsMask*(mask: SET);
BEGIN
K.sysfunc2(40, ORD(mask))
END SetEventsMask;
PROCEDURE GetKeyCode*(): INTEGER;
RETURN LSR(LSL(K.sysfunc1(2), 16), 24)
END GetKeyCode;
PROCEDURE GetButtonCode*(): INTEGER;
VAR res, button_code: INTEGER;
BEGIN
res := K.sysfunc1(17);
IF ORD(BITS(res) * {0..7}) = 0 THEN
button_code := LSR(res, 8)
ELSE
button_code := 0
END
RETURN button_code
END GetButtonCode;
PROCEDURE OutText*(X, Y: INTEGER; Text: ARRAY OF CHAR; length: INTEGER; color: INTEGER);
BEGIN
K.sysfunc6(4, LSL(X, 16) + Y, LSL(3 * 16, 24) + color, sys.ADR(Text[0]), length, 0)
END OutText;
PROCEDURE GetWindowPos*(VAR Left, Top: INTEGER);
VAR info: ARRAY 1024 OF CHAR;
BEGIN
K.sysfunc3(9, sys.ADR(info[0]), -1);
sys.GET(sys.ADR(info[34]), Left);
sys.GET(sys.ADR(info[38]), Top)
END GetWindowPos;
PROCEDURE GetWindowSize*(VAR Width, Height: INTEGER);
VAR info: ARRAY 1024 OF CHAR;
BEGIN
K.sysfunc3(9, sys.ADR(info[0]), -1);
sys.GET(sys.ADR(info[42]), Width);
sys.GET(sys.ADR(info[46]), Height)
END GetWindowSize;
PROCEDURE SetWindowSize*(Width, Height: INTEGER);
BEGIN
K.sysfunc5(67, -1, -1, Width, Height)
END SetWindowSize;
PROCEDURE GetScreenSize*(VAR Width, Height: INTEGER);
VAR res: INTEGER;
BEGIN
res := K.sysfunc1(14);
Width := LSR(res, 16) + 1;
Height := ORD(BITS(res) * {0..15}) + 1
END GetScreenSize;
PROCEDURE GetScreenArea*(VAR X1, Y1, X2, Y2: INTEGER);
VAR eax, ebx: INTEGER;
BEGIN
eax := K.sysfunc22(48, 5, ebx);
X1 := LSR(eax, 16);
Y1 := LSR(ebx, 16);
X2 := ORD(BITS(eax) * {0..15});
Y2 := ORD(BITS(ebx) * {0..15})
END GetScreenArea;
PROCEDURE SkinHeight*(): INTEGER;
RETURN K.sysfunc2(48, 4)
END SkinHeight;
PROCEDURE DrawRect*(Left, Top, Width, Height, Color: INTEGER);
BEGIN
K.sysfunc4(13, LSL(Left, 16) + Width, LSL(Top, 16) + Height, Color)
END DrawRect;
PROCEDURE NewThread*(eip: ENTRY; stack: ARRAY OF CHAR): INTEGER;
VAR entry: INTEGER;
BEGIN
sys.GET(sys.ADR(eip), entry)
RETURN K.sysfunc4(51, 1, entry, sys.ADR(stack[0]) + LEN(stack))
END NewThread;
PROCEDURE Pause*(time: INTEGER);
BEGIN
K.sysfunc2(5, time)
END Pause;
PROCEDURE GetThreadSlot*(PID: INTEGER): INTEGER;
RETURN K.sysfunc3(18, 21, PID)
END GetThreadSlot;
PROCEDURE TerminateThreadId*(PID: INTEGER);
BEGIN
K.sysfunc3(18, 18, PID)
END TerminateThreadId;
PROCEDURE IsTerminated*(PID: INTEGER): BOOLEAN;
RETURN GetThreadSlot(PID) = 0
END IsTerminated;
PROCEDURE FocusWindow*(Slot: INTEGER);
BEGIN
K.sysfunc3(18, 3, Slot)
END FocusWindow;
PROCEDURE CreateButton*(id, Left, Top, Width, Height, Color: INTEGER; Caption: ARRAY OF CHAR);
VAR
X, Y, len: INTEGER;
BEGIN
len := LENGTH(Caption);
K.sysfunc5(8, LSL(Left, 16) + Width, LSL(Top, 16) + Height, id, btnColor);
X := Left + (Width - FontW * len) DIV 2;
Y := Top + (Height - FontH) DIV 2 + 1;
OutText(X, Y, Caption, len, btnTextColor)
END CreateButton;
PROCEDURE DrawLine* (x1, y1, x2, y2: INTEGER; color: INTEGER);
BEGIN
K.sysfunc4(38, x1*65536 + x2, y1*65536 + y2, color)
END DrawLine;
PROCEDURE Box*(Left, Top, Width, Height, BrushColor, PenColor: INTEGER);
BEGIN
K.sysfunc4(13, LSL(Left, 16) + Width, LSL(Top, 16) + Height, BrushColor);
DrawLine(Left, Top, Left + Width, Top, PenColor);
DrawLine(Left + Width, Top, Left + Width, Top + Height, PenColor);
DrawLine(Left + Width, Top + Height, Left, Top + Height, PenColor);
DrawLine(Left, Top + Height, Left, Top, PenColor);
END Box;
PROCEDURE LoadCursor*(cursor: INTEGER): INTEGER;
RETURN K.sysfunc4(37, 4, cursor, 1)
END LoadCursor;
PROCEDURE SetCursor*(handle: INTEGER);
BEGIN
K.sysfunc3(37, 5, handle)
END SetCursor;
PROCEDURE DelCursor*(handle: INTEGER);
BEGIN
K.sysfunc3(37, 6, handle)
END DelCursor;
PROCEDURE DrawImage* (data, sizeX, sizeY, x, y: INTEGER);
BEGIN
K.sysfunc4(7, data, sizeX*65536 + sizeY, x*65536 + y)
END DrawImage;
PROCEDURE DrawText69* (x, y, color: INTEGER; text: ARRAY OF CHAR);
BEGIN
K.sysfunc6(4, x*65536 + y, color + LSL(080H, 24), sys.ADR(text[0]), 0, 0)
END DrawText69;
PROCEDURE PutPixel* (x, y, color: INTEGER);
BEGIN
K.sysfunc5(1, x, y, color, 0)
END PutPixel;
PROCEDURE GetSystemColors*;
VAR
buf: ARRAY 10 OF INTEGER;
BEGIN
ASSERT(LEN(buf) >= 10);
K.sysfunc4(48, 3, sys.ADR(buf[0]), 40);
(*darkColor := buf[2];*)
lightColor := buf[3];
winColor := buf[5];
textColor := buf[8];
btnColor := buf[6];
btnTextColor := buf[7];
borderColor := buf[9];
END GetSystemColors;
END SysUtils.

167
programs/other/fb2reader/SRC/Toolbar.ob07 Normal file
View File

@ -0,0 +1,167 @@
(*
Copyright 2021, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Toolbar;
IMPORT
Icons, K := SysUtils;
CONST
max = 14;
BtnSize* = 26;
BtnInter = 5;
DelimSize = 7;
IconPad = (BtnSize - Icons.SIZE) DIV 2;
TYPE
tButtonText = ARRAY 4 OF CHAR;
tButton = RECORD
btn, icon, x: INTEGER;
text: tButtonText;
enabled: BOOLEAN
END;
tToolbar* = RECORD
buttons: ARRAY max OF tButton;
x, y, cnt, width: INTEGER;
icons, grayIcons: INTEGER;
colors: RECORD back, text, disText, light, shadow, window: INTEGER END
END;
PROCEDURE drawIcons* (toolbar: tToolbar);
VAR
i, icons, color: INTEGER;
button: tButton;
BEGIN
i := 0;
WHILE i < toolbar.cnt DO
button := toolbar.buttons[i];
IF button.btn # 0 THEN
IF button.enabled THEN
icons := toolbar.icons;
color := toolbar.colors.text
ELSE
icons := toolbar.grayIcons;
color := toolbar.colors.disText
END;
IF button.icon # -1 THEN
Icons.draw(icons, button.icon, button.x + IconPad, toolbar.y + IconPad)
ELSE
K.DrawRect(button.x + 1, toolbar.y + 1, BtnSize - 1, BtnSize - 1, toolbar.colors.back);
K.DrawText69(button.x + (BtnSize - LENGTH(button.text)*6) DIV 2, toolbar.y + (BtnSize - 9) DIV 2 + 2, color, button.text)
END
END;
INC(i)
END
END drawIcons;
PROCEDURE setColors (VAR toolbar: tToolbar);
BEGIN
toolbar.colors.back := 0F2EFECH;
toolbar.colors.text := 00000FFH;
toolbar.colors.disText := 0808080H;
toolbar.colors.light := 0FEFEFEH;
toolbar.colors.shadow := 09F9C9AH;
toolbar.colors.window := K.winColor
END setColors;
PROCEDURE draw* (VAR toolbar: tToolbar);
VAR
i, x, y, btn: INTEGER;
button: tButton;
BEGIN
setColors(toolbar);
Icons.get(toolbar.icons, toolbar.grayIcons, toolbar.colors.back);
i := 0;
WHILE i < toolbar.cnt DO
button := toolbar.buttons[i];
btn := button.btn;
IF btn # 0 THEN
x := button.x;
y := toolbar.y;
K.DrawRect(x + 1, y + 1, BtnSize, BtnSize - 1, toolbar.colors.back);
K.DrawLine(x + 1, y + BtnSize, x + BtnSize - 1, y + BtnSize, toolbar.colors.shadow);
K.DrawLine(x + 1, y, x + BtnSize - 1, y, toolbar.colors.light);
K.DrawLine(x, y + 1, x, y + BtnSize - 1, toolbar.colors.light);
K.PutPixel(x + BtnSize, y + 1, toolbar.colors.light);
K.PutPixel(x, y + BtnSize - 1, toolbar.colors.shadow);
K.PutPixel(x + BtnSize, y + BtnSize - 1, toolbar.colors.shadow);
K.CreateButton(btn + ORD({30}), x, y, BtnSize, BtnSize, 0, "")
END;
INC(i)
END;
drawIcons(toolbar)
END draw;
PROCEDURE enable* (VAR toolbar: tToolbar; btn: INTEGER; value: BOOLEAN);
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < toolbar.cnt) & (toolbar.buttons[i].btn # btn) DO
INC(i)
END;
IF i < toolbar.cnt THEN
toolbar.buttons[i].enabled := value
END
END enable;
PROCEDURE add* (VAR toolbar: tToolbar; btn, icon: INTEGER; text: tButtonText);
VAR
button: tButton;
BEGIN
ASSERT(toolbar.cnt < max);
button.btn := btn;
button.icon := icon;
button.x := toolbar.width + toolbar.x;
button.text := text;
button.enabled := TRUE;
toolbar.buttons[toolbar.cnt] := button;
INC(toolbar.cnt);
IF btn # 0 THEN
INC(toolbar.width, BtnSize + BtnInter)
ELSE
INC(toolbar.width, DelimSize)
END
END add;
PROCEDURE delimiter* (VAR toolbar: tToolbar);
BEGIN
add(toolbar, 0, 0, "")
END delimiter;
PROCEDURE create* (VAR toolbar: tToolbar; x, y: INTEGER);
BEGIN
toolbar.x := x;
toolbar.y := y;
toolbar.cnt := 0;
toolbar.width := 0
END create;
END Toolbar.

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

@ -0,0 +1,129 @@
(*
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.

105
programs/other/fb2reader/SRC/Vector.ob07 Normal file
View File

@ -0,0 +1,105 @@
(*
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 Vector;
IMPORT sys := SYSTEM, K := KOSAPI;
TYPE
DESC_VECTOR = RECORD
data : INTEGER;
count* : INTEGER;
size : INTEGER
END;
VECTOR* = POINTER TO DESC_VECTOR;
ANYREC* = RECORD END;
ANYPTR* = POINTER TO ANYREC;
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)
END push;
PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR;
VAR res: ANYPTR;
BEGIN
ASSERT( (0 <= idx) & (idx < vector.count) );
sys.GET(vector.data + idx * 4, 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)
END put;
PROCEDURE create* (size: INTEGER): VECTOR;
VAR vector: VECTOR;
BEGIN
NEW(vector);
vector.data := K.malloc(4 * size);
vector.size := size;
vector.count := 0
RETURN vector
END create;
PROCEDURE def_destructor (VAR any: ANYPTR);
BEGIN
DISPOSE(any)
END def_destructor;
PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR);
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)
END destroy;
END Vector.

58
programs/other/fb2reader/SRC/Window.ob07 Normal file
View File

@ -0,0 +1,58 @@
(*
Copyright 2016, 2021 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 Window;
IMPORT S := Strings;
TYPE
TRect* = RECORD
Left*, Top*, Width*, Height* : 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);
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;
PROCEDURE InitRect*(VAR Rect: TRect; Left, Top, Width, Height: INTEGER);
BEGIN
Rect.Left := Left;
Rect.Top := Top;
Rect.Width := Width;
Rect.Height := Height
END InitRect;
END Window.

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

@ -0,0 +1,42 @@
(*
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.

755
programs/other/fb2reader/SRC/XML.ob07 Normal file
View File

@ -0,0 +1,755 @@
(*
Copyright 2016, 2020, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE XML;
IMPORT SU := SysUtils, RF := ReadFile, S := Strings, Encode, V := Vector, tables, LISTS;
CONST
tag_p* = 1;
tag_v* = 2;
tag_section* = 3;
tag_stanza* = 4;
tag_empty_line* = 5;
tag_subtitle* = 6;
tag_date* = 7;
tag_text_author* = 8;
tag_a* = 9;
tag_sub* = 10;
tag_sup* = 11;
tag_code* = 12;
tag_poem* = 13;
tag_title* = 14;
tag_FictionBook* = 15;
tag_body* = 16;
tag_strikethrough* = 17;
tag_strong* = 18;
tag_cite* = 19;
tag_epigraph* = 20;
tag_emphasis* = 21;
tag_image* = 22;
tag_binary* = 23;
tag_coverpage* = 24;
tag_description* = 25;
tag_xml* = 26;
tag_annotation* = 27;
tag_contents_item* = 28;
tag_table* = 29;
tag_tr* = 30;
tag_td* = 31;
tag_th* = 32;
tag_unknown* = -1;
TYPE
ELEMENT* = POINTER TO DESC_ELEMENT;
TEXT* = POINTER TO DESC_TEXT;
SPACE* = POINTER TO DESC_SPACE;
WORD* = POINTER TO DESC_WORD;
TAG* = POINTER TO DESC_TAG;
ATTR* = POINTER TO DESC_ATTR;
TAG_ID = POINTER TO DESC_TAG_ID;
LIST* = RECORD first*, last* : ELEMENT END;
DESC_ELEMENT* = RECORD (V.ANYREC)
parent*, next* : ELEMENT
END;
DESC_TEXT = RECORD (DESC_ELEMENT)
X*, Y* : INTEGER;
width* : INTEGER
END;
DESC_SPACE = RECORD (DESC_TEXT)
END;
DESC_WORD = RECORD (DESC_TEXT)
length* : INTEGER;
value* : S.CHARS
END;
DESC_TAG = RECORD (DESC_ELEMENT)
name* : S.CHARS;
value* : INTEGER;
child* : LIST;
attr* : LIST;
Ymin* : INTEGER;
Ymax* : INTEGER;
X* : INTEGER;
Width* : INTEGER;
Clicked* : BOOLEAN;
Visited* : BOOLEAN;
img* : INTEGER;
num* : INTEGER;
cell* : INTEGER;
table* : tables.Table;
text* : LISTS.ITEM
END;
DESC_ATTR = RECORD (DESC_ELEMENT)
name : S.CHARS;
value : S.CHARS
END;
DESC_TAG_ID = RECORD (DESC_ELEMENT)
tag : TAG;
id : S.CHARS
END;
VAR
ch: CHAR; binary: BOOLEAN;
Root, Current, Header, FB*: ELEMENT;
Tag_id: LIST;
tire1, tire2, nbsp, ellipsis, apo,
quot1, quot2, quot3, quot4, quot5, quot6, quot7,
number, bullet, euro,
dash1, dash2: S.UTF8;
num: INTEGER;
Tags: V.VECTOR;
PROCEDURE GetTagByNum*(n: INTEGER): TAG;
VAR ptr: V.ANYPTR;
BEGIN
ptr := V.get(Tags, n)
RETURN ptr(TAG)
END GetTagByNum;
PROCEDURE ListCount*(list: LIST): INTEGER;
VAR cur: ELEMENT; res: INTEGER;
BEGIN
res := 0;
cur := list.first;
WHILE cur # NIL DO
INC(res);
cur := cur.next
END
RETURN res
END ListCount;
PROCEDURE GetTagByID(id: S.CHARS): TAG;
VAR
cur : TAG_ID;
Result : TAG;
BEGIN
Result := NIL;
cur := Tag_id.first(TAG_ID);
WHILE cur # NIL DO
IF S.CharsEq(id, cur.id) THEN
Result := cur.tag;
cur := NIL
ELSE
cur := cur.next(TAG_ID)
END
END
RETURN Result
END GetTagByID;
PROCEDURE GetAttr*(tag: TAG; attr_name: S.STRING; VAR attr_value: S.CHARS): BOOLEAN;
VAR attr: ELEMENT;
found: BOOLEAN;
BEGIN
found := FALSE;
attr := tag.attr.first;
WHILE ~found & (attr # NIL) DO
IF S.CharsEqStr(attr(ATTR).name, attr_name) THEN
attr_value := attr(ATTR).value;
INC(attr_value.first);
DEC(attr_value.last);
found := TRUE
ELSE
attr := attr.next
END
END
RETURN found
END GetAttr;
PROCEDURE IsHref(attr_name: S.CHARS): BOOLEAN;
VAR chars: S.CHARS;
BEGIN
chars := attr_name;
chars.first := chars.last - 4
RETURN S.CharsEqStr(chars, ":href")
END IsHref;
PROCEDURE GetRef*(tag: TAG; VAR note: BOOLEAN; VAR URL: INTEGER): TAG;
VAR
attr : ATTR;
chars : S.CHARS;
Result : TAG;
BEGIN
Result := NIL;
note := FALSE;
URL := 0;
attr := tag.attr.first(ATTR);
WHILE attr # NIL DO
IF IsHref(attr.name) THEN
chars := attr.value;
INC(chars.first);
IF S.GetChar(chars, 0) = "#" THEN
DEC(chars.last);
INC(chars.first);
Result := GetTagByID(chars)
ELSE
S.PutChar(chars, chars.last - chars.first, 0X);
URL := chars.first
END
ELSIF S.CharsEqStr(attr.name, "type") THEN
chars := attr.value;
INC(chars.first);
DEC(chars.last);
note := S.CharsEqStr(chars, "note")
END;
attr := attr.next(ATTR)
END
RETURN Result
END GetRef;
PROCEDURE IsNote*(tag: TAG): BOOLEAN;
VAR
res : TAG;
note : BOOLEAN;
URL : INTEGER;
BEGIN
res := GetRef(tag, note, URL)
RETURN note
END IsNote;
PROCEDURE CreateTag*(): TAG;
VAR tag: TAG;
BEGIN
NEW(tag);
tag.Visited := FALSE;
SU.MemError(tag = NIL);
INC(num);
tag.num := num;
V.push(Tags, tag)
RETURN tag
END CreateTag;
PROCEDURE CreateWord*(): WORD;
VAR word: WORD;
BEGIN
NEW(word);
SU.MemError(word = NIL)
RETURN word
END CreateWord;
PROCEDURE CreateSpace(): SPACE;
VAR space: SPACE;
BEGIN
NEW(space);
SU.MemError(space = NIL)
RETURN space
END CreateSpace;
PROCEDURE CreateAttr(): ATTR;
VAR attr: ATTR;
BEGIN
NEW(attr);
SU.MemError(attr = NIL)
RETURN attr
END CreateAttr;
PROCEDURE AddItem*(VAR list: LIST; item: ELEMENT);
BEGIN
IF list.first = NIL THEN
list.first := item
ELSE
list.last.next := item
END;
list.last := item
END AddItem;
PROCEDURE DelLastItem*(VAR list: LIST);
VAR cur: ELEMENT;
BEGIN
IF list.first = list.last THEN
IF list.last # NIL THEN
DISPOSE(list.last)
END;
list.first := NIL
ELSE
cur := list.first;
WHILE cur.next # list.last DO
cur := cur.next
END;
DISPOSE(list.last);
cur.next := NIL;
list.last := cur
END
END DelLastItem;
PROCEDURE AddChild*(tag: TAG; child: ELEMENT);
BEGIN
AddItem(tag.child, child);
child.parent := tag
END AddChild;
PROCEDURE AddAttr(tag: TAG; attr: ATTR);
BEGIN
AddItem(tag.attr, attr);
attr.parent := tag
END AddAttr;
PROCEDURE Copy*(node: ELEMENT): ELEMENT;
VAR
space : SPACE;
word : WORD;
tag : TAG;
cur : ELEMENT;
num : INTEGER;
Result : ELEMENT;
BEGIN
IF node IS TAG THEN
tag := CreateTag();
num := tag.num;
tag^ := node(TAG)^;
tag.num := num;
tag.child.first := NIL;
tag.child.last := NIL;
cur := node(TAG).child.first;
WHILE cur # NIL DO
AddChild(tag, Copy(cur));
cur := cur.next
END;
Result := tag
ELSIF node IS WORD THEN
word := CreateWord();
word^ := node(WORD)^;
Result := word
ELSIF node IS SPACE THEN
space := CreateSpace();
space^ := node(SPACE)^;
Result := space
END;
Result.next := NIL
RETURN Result
END Copy;
PROCEDURE IsIdentChar(): BOOLEAN;
RETURN ("A" <= ch) & (ch <= "Z") OR
("a" <= ch) & (ch <= "z") OR
("0" <= ch) & (ch <= "9") OR
(ch = "?") OR (ch = "!") OR
(ch = ":") OR (ch = "_") OR
(ch = "-")
END IsIdentChar;
PROCEDURE Space(): BOOLEAN;
RETURN (ch # 0X) & (ch <= 20X)
END Space;
PROCEDURE Ident(VAR id: S.CHARS);
BEGIN
id.first := RF.Adr();
WHILE IsIdentChar() DO
RF.Next(ch)
END;
id.last := RF.Adr() - 1
END Ident;
PROCEDURE Skip;
BEGIN
WHILE Space() DO
RF.Next(ch)
END
END Skip;
PROCEDURE String(VAR str: S.CHARS);
VAR quot: CHAR;
BEGIN
SU.ErrorIf((ch # "'") & (ch # 22X), 1);
str.first := RF.Adr();
quot := ch;
REPEAT
RF.Next(ch)
UNTIL (ch = quot) OR (ch = 0X);
SU.ErrorIf(ch = 0X, 2);
str.last := RF.Adr();
RF.Next(ch)
END String;
PROCEDURE SetTagValue(tag: TAG);
VAR
value : INTEGER;
name : S.CHARS;
BEGIN
name := tag.name;
IF S.CharsEqStr(name, "p") THEN
value := tag_p
ELSIF S.CharsEqStr(name, "v") THEN
value := tag_v
ELSIF S.CharsEqStr(name, "section") THEN
value := tag_section
ELSIF S.CharsEqStr(name, "stanza") THEN
value := tag_stanza
ELSIF S.CharsEqStr(name, "empty-line") THEN
value := tag_empty_line
ELSIF S.CharsEqStr(name, "subtitle") THEN
value := tag_subtitle
ELSIF S.CharsEqStr(name, "date") THEN
value := tag_date
ELSIF S.CharsEqStr(name, "text-author") THEN
value := tag_text_author
ELSIF S.CharsEqStr(name, "a") THEN
value := tag_a
ELSIF S.CharsEqStr(name, "sub") THEN
value := tag_sub
ELSIF S.CharsEqStr(name, "sup") THEN
value := tag_sup
ELSIF S.CharsEqStr(name, "code") THEN
value := tag_code
ELSIF S.CharsEqStr(name, "poem") THEN
value := tag_poem
ELSIF S.CharsEqStr(name, "title") THEN
value := tag_title
ELSIF S.CharsEqStr(name, "FictionBook") THEN
value := tag_FictionBook;
FB := tag
ELSIF S.CharsEqStr(name, "body") THEN
value := tag_body
ELSIF S.CharsEqStr(name, "strikethrough") THEN
value := tag_strikethrough
ELSIF S.CharsEqStr(name, "strong") THEN
value := tag_strong
ELSIF S.CharsEqStr(name, "cite") THEN
value := tag_cite
ELSIF S.CharsEqStr(name, "epigraph") THEN
value := tag_epigraph
ELSIF S.CharsEqStr(name, "emphasis") THEN
value := tag_emphasis
ELSIF S.CharsEqStr(name, "image") THEN
value := tag_image
ELSIF S.CharsEqStr(name, "binary") THEN
binary := TRUE;
value := tag_binary
ELSIF S.CharsEqStr(name, "coverpage") THEN
value := tag_coverpage
ELSIF S.CharsEqStr(name, "description") THEN
value := tag_description
ELSIF S.CharsEqStr(name, "annotation") THEN
value := tag_annotation
ELSIF S.CharsEqStr(name, "table") THEN
value := tag_table
ELSIF S.CharsEqStr(name, "tr") THEN
value := tag_tr
ELSIF S.CharsEqStr(name, "td") THEN
value := tag_td
ELSIF S.CharsEqStr(name, "th") THEN
value := tag_th
ELSIF S.CharsEqStr(name, "?xml") THEN
value := tag_xml;
Header := tag
ELSE
value := tag_unknown
END;
tag.value := value
END SetTagValue;
PROCEDURE ReadTag;
VAR tag: TAG; name: S.CHARS; attr: ATTR; tag_id: TAG_ID;
BEGIN
RF.Next(ch);
Skip;
IF ch = "/" THEN
RF.Next(ch);
Skip;
SU.ErrorIf(~IsIdentChar(), 3);
Ident(name);
Skip;
SU.ErrorIf(ch # ">", 4);
RF.Next(ch);
tag := Current(TAG);
SU.ErrorIf(~S.CharsEq(tag.name, name), 5);
IF tag.value = tag_binary THEN
binary := FALSE;
IF tag.child.first IS WORD THEN
S.Base64(tag.child.first(WORD).value)
END
END;
Current := Current.parent
ELSE
tag := CreateTag();
AddChild(Current(TAG), tag);
Current := tag;
SU.ErrorIf(~IsIdentChar(), 6);
Ident(tag.name);
SetTagValue(tag);
WHILE Space() DO
Skip;
IF IsIdentChar() THEN
attr := CreateAttr();
Ident(attr.name);
Skip;
SU.ErrorIf(ch # "=", 7);
RF.Next(ch);
Skip;
String(attr.value);
AddAttr(Current(TAG), attr);
IF S.CharsEqStr(attr.name, "id") THEN
NEW(tag_id);
SU.MemError(tag_id = NIL);
tag_id.tag := Current(TAG);
tag_id.id := attr.value;
INC(tag_id.id.first);
DEC(tag_id.id.last);
AddItem(Tag_id, tag_id)
END
END
END;
IF ch = "/" THEN
RF.Next(ch);
IF Current(TAG).value = tag_binary THEN
binary := FALSE
END;
Current := Current.parent
ELSIF ch = "?" THEN
RF.Next(ch);
SU.ErrorIf(Current(TAG).value # tag_xml, 8);
Current := Current.parent
END;
SU.ErrorIf(ch # ">", 9);
RF.Next(ch)
END
END ReadTag;
PROCEDURE ReadSpace;
VAR space: SPACE;
BEGIN
space := CreateSpace();
AddChild(Current(TAG), space);
RF.Next(ch)
END ReadSpace;
PROCEDURE ReadWord;
VAR word: WORD; chars: S.CHARS; repl: BOOLEAN;
BEGIN
word := CreateWord();
word.value.first := RF.Adr();
repl := FALSE;
WHILE ((ch > 20X) OR binary) & (ch # 0X) & (ch # "<") DO
repl := repl OR (ch = "&") OR (ch = 0C2X) OR (ch >= 0E0X) & (ch < 0F0X);
RF.Next(ch)
END;
word.value.last := RF.Adr() - 1;
IF repl THEN
chars := word.value;
S.Replace(chars, "&amp;", "&");
S.Replace(chars, "&lt;", "<");
S.Replace(chars, "&gt;", ">");
S.Replace(chars, "&quot;", 22X);
S.Replace(chars, "&apos;", "'");
WHILE S.EntOct(chars) DO END;
S.Replace(chars, tire1, "--");
S.Replace(chars, tire2, "--");
S.Replace(chars, nbsp, " ");
S.Replace(chars, ellipsis, "...");
S.Replace(chars, quot1, 22X);
S.Replace(chars, quot2, 22X);
S.Replace(chars, quot3, 22X);
S.Replace(chars, quot4, "'");
S.Replace(chars, quot5, ",");
S.Replace(chars, quot6, "<");
S.Replace(chars, quot7, ">");
S.Replace(chars, number, "No.");
S.Replace(chars, apo, "'");
S.Replace(chars, dash1, "-");
S.Replace(chars, dash2, "-");
S.Replace(chars, bullet, "*");
S.Replace(chars, euro, "EUR");
word.value := chars
END;
AddChild(Current(TAG), word)
END ReadWord;
PROCEDURE Comment(): BOOLEAN;
CONST com = 2D2D213CH;
VAR res: BOOLEAN;
BEGIN
res := FALSE;
IF RF.Int() = com THEN
RF.Next(ch);
RF.Next(ch);
RF.Next(ch);
RF.Next(ch);
REPEAT
RF.Next(ch);
IF ch = "-" THEN
RF.Next(ch);
WHILE (ch = "-") & ~res DO
RF.Next(ch);
IF ch = ">" THEN
RF.Next(ch);
res := TRUE
END
END
END
UNTIL (ch = 0X) OR res
END
RETURN res
END Comment;
PROCEDURE Prolog;
VAR attr: ATTR; chars: S.CHARS;
BEGIN
RF.Next(ch);
IF ch = 0EFX THEN
RF.Next(ch);
SU.ErrorIf(ch # 0BBX, 16);
RF.Next(ch);
SU.ErrorIf(ch # 0BFX, 16);
RF.Next(ch)
END;
Skip;
IF ch = "<" THEN
ReadTag
END;
SU.ErrorIf(Header = NIL, 15);
attr := Header(TAG).attr.first(ATTR);
WHILE attr # NIL DO
IF S.CharsEqStr(attr.name, "encoding") THEN
chars := attr.value;
INC(chars.first);
DEC(chars.last);
S.SetCS(FALSE);
IF S.CharsEqStr(chars, "windows-1250") THEN
RF.Conv(Encode.W1250)
ELSIF S.CharsEqStr(chars, "windows-1251") THEN
RF.Conv(Encode.W1251)
ELSIF S.CharsEqStr(chars, "windows-1252") THEN
RF.Conv(Encode.W1252)
ELSIF S.CharsEqStr(chars, "cp866" ) THEN
RF.Conv(Encode.CP866)
ELSIF S.CharsEqStr(chars, "utf-8" ) THEN
RF.SeekBeg
ELSE
SU.ErrorIf(TRUE, 14)
END;
S.SetCS(TRUE)
END;
attr := attr.next(ATTR)
END
END Prolog;
PROCEDURE Parse;
BEGIN
Prolog;
binary := FALSE;
RF.Next(ch);
WHILE ch = "<" DO
IF ~Comment() THEN
ReadTag
END
ELSIF Space() & ~binary DO
ReadSpace
ELSIF (ch # 0X) DO
ReadWord
END
END Parse;
PROCEDURE Open*(FileName: S.STRING);
BEGIN
Root := CreateTag();
Current := Root;
Header := NIL;
FB := NIL;
num := 0;
RF.Load(FileName);
Parse;
SU.ErrorIf(Current # Root, 10)
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);
Tags := V.create(1024)
END Init;
BEGIN
Init
END XML.

236
programs/other/fb2reader/SRC/box_lib.ob07 Normal file
View File

@ -0,0 +1,236 @@
(*
Copyright 2016, 2017, 2020, 2022 Anton Krotov
This file is part of fb2read.
fb2read is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
fb2read is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE box_lib;
IMPORT sys := SYSTEM, KOSAPI;
CONST
CHECKBOX_IS_SET* = 1;
TYPE
checkbox* = POINTER TO RECORD
left_s: INTEGER;
top_s: INTEGER;
ch_text_margin*: INTEGER;
color: INTEGER;
border_color: INTEGER;
text_color: INTEGER;
text: INTEGER;
flags*: SET;
(* Users can use members above this *)
size_of_str: INTEGER
END;
scrollbar* = POINTER TO RECORD
x_w: INTEGER;
y_h*: INTEGER;
btn_height: INTEGER;
typ: INTEGER;
max_area*: INTEGER;
cur_area*: INTEGER;
position*: INTEGER;
back_color: INTEGER;
front_color: INTEGER;
line_color: INTEGER;
redraw: INTEGER;
delta: WCHAR;
delta2: WCHAR;
r_size_x: WCHAR;
r_start_x: WCHAR;
r_size_y: WCHAR;
r_start_y: WCHAR;
m_pos: INTEGER;
m_pos2: INTEGER;
m_keys: INTEGER;
run_size: INTEGER;
position2: INTEGER;
work_size: INTEGER;
all_redraw: INTEGER;
ar_offset: INTEGER
END;
edit_box* = POINTER TO RECORD
width*,
left,
top,
color,
shift_color,
focus_border_color,
blur_border_color,
text_color*,
max: INTEGER;
text*: INTEGER;
mouse_variable: INTEGER;
flags*,
size,
pos: INTEGER;
(* The following struct members are not used by the users of API *)
offset, cl_curs_x, cl_curs_y, shift, shift_old, height, char_width: INTEGER
END;
PROCEDURE [stdcall, "box_lib.obj", ""] check_box_draw2* (cb: checkbox); END;
PROCEDURE [stdcall, "box_lib.obj", ""] check_box_mouse2* (cb: checkbox); END;
PROCEDURE [stdcall, "box_lib.obj", ""] init_checkbox2 (cb: checkbox); END;
PROCEDURE [stdcall, "box_lib.obj", ""] scrollbar_h_draw* (sb: scrollbar); END;
PROCEDURE [stdcall, "box_lib.obj", ""] scrollbar_h_mouse* (sb: scrollbar); END;
PROCEDURE [stdcall, "box_lib.obj", ""] scrollbar_v_draw* (sb: scrollbar); END;
PROCEDURE [stdcall, "box_lib.obj", ""] scrollbar_v_mouse* (sb: scrollbar); END;
PROCEDURE [stdcall, "box_lib.obj", ""] edit_box_draw* (eb: edit_box); END;
PROCEDURE [stdcall, "box_lib.obj", ""] edit_box_key_safe* (eb: edit_box; key: INTEGER); END;
PROCEDURE [stdcall, "box_lib.obj", ""] edit_box_mouse* (eb: edit_box); END;
PROCEDURE [stdcall, "box_lib.obj", ""] edit_box_set_text* (eb: edit_box; text: INTEGER); END;
PROCEDURE edit_box_get_value* (text: edit_box; VAR str: ARRAY OF CHAR);
VAR
ptr, max, i: INTEGER;
BEGIN
ptr := text.text;
max := text.max;
ASSERT(max < LEN(str));
i := 0;
REPEAT
sys.GET(ptr, str[i]);
INC(i);
INC(ptr)
UNTIL (str[i - 1] = 0X) OR (i = max);
str[i] := 0X
END edit_box_get_value;
PROCEDURE memset(adr: INTEGER; c: CHAR; n: INTEGER);
BEGIN
WHILE n > 0 DO
sys.PUT(adr, c);
INC(adr);
DEC(n)
END
END memset;
PROCEDURE check_box_set_value* (cb: checkbox; value: BOOLEAN);
BEGIN
IF cb # NIL THEN
IF value THEN
INCL(cb.flags, CHECKBOX_IS_SET)
ELSE
EXCL(cb.flags, CHECKBOX_IS_SET)
END
END
END check_box_set_value;
PROCEDURE check_box_get_value* (cb: checkbox): BOOLEAN;
VAR res: BOOLEAN;
BEGIN
res := FALSE;
IF cb # NIL THEN
res := CHECKBOX_IS_SET IN cb.flags
END
RETURN res
END check_box_get_value;
PROCEDURE kolibri_new_check_box* (tlx, tly, sizex, sizey, label_text, text_margin: INTEGER): checkbox;
VAR new_checkbox: checkbox;
BEGIN
NEW(new_checkbox);
new_checkbox.left_s := tlx * 65536 + sizex;
new_checkbox.top_s := tly * 65536 + sizey;
new_checkbox.ch_text_margin := text_margin;
new_checkbox.color := 80808080H;
new_checkbox.border_color := 0000FF00H;
new_checkbox.text_color := 00000000H;
new_checkbox.text := label_text;
new_checkbox.flags := {3};
init_checkbox2(new_checkbox)
RETURN new_checkbox
END kolibri_new_check_box;
PROCEDURE kolibri_scrollbar*(sb: scrollbar; x_w, y_h, btn_height, max_area, cur_area, position, back_color, front_color, line_color, typ: INTEGER): scrollbar;
BEGIN
memset(sys.ADR(sb^), 0X, sys.SIZE(scrollbar));
sb.x_w := x_w;
sb.y_h := y_h;
sb.btn_height := btn_height;
sb.typ := typ;
sb.max_area := max_area;
sb.cur_area := cur_area;
sb.position := position;
sb.line_color := line_color;
sb.back_color := back_color;
sb.front_color := front_color;
sb.ar_offset := 1;
sb.all_redraw := 1
RETURN sb
END kolibri_scrollbar;
PROCEDURE kolibri_new_scrollbar*(x_w, y_h, btn_height, max_area, cur_area, position, back_color, front_color, line_color, typ: INTEGER): scrollbar;
VAR sb: scrollbar;
BEGIN
NEW(sb);
RETURN kolibri_scrollbar(sb, x_w, y_h, btn_height, max_area, cur_area, position, back_color, front_color, line_color, typ)
END kolibri_new_scrollbar;
PROCEDURE kolibri_new_edit_box* (tlx, tly, width, max_chars: INTEGER): edit_box;
VAR
new_textbox: edit_box;
BEGIN
NEW(new_textbox);
new_textbox.width := width;
new_textbox.left := tlx;
new_textbox.top := tly;
new_textbox.color := 0FFFFFFH;
new_textbox.shift_color := 06A9480H;
new_textbox.focus_border_color := 0;
new_textbox.blur_border_color := 06A9480H;
new_textbox.text_color := 30000000H;
new_textbox.max := max_chars;
new_textbox.text := KOSAPI.malloc(max_chars + 2);
new_textbox.mouse_variable := 0;
new_textbox.flags := 0
RETURN new_textbox
END kolibri_new_edit_box;
END box_lib.

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

@ -0,0 +1,149 @@
(*
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.

466
programs/other/fb2reader/SRC/kfonts.ob07 Normal file
View File

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

256
programs/other/fb2reader/SRC/tables.ob07 Normal file
View File

@ -0,0 +1,256 @@
(*
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 tables;
IMPORT V := Vector;
TYPE
Int = POINTER TO RECORD (V.ANYREC) value: INTEGER END;
Cell = POINTER TO RECORD (V.ANYREC) top, bottom, left, right, colspan, rowspan: INTEGER END;
Tab = POINTER TO RECORD (V.ANYREC) col, row: INTEGER END;
Table* = POINTER TO RECORD
tab : V.VECTOR;
h_lines : V.VECTOR;
v_lines : V.VECTOR;
cells* : V.VECTOR;
tab_x, tab_y, max_length: INTEGER
END;
PROCEDURE GetCell (t: Table; cell: INTEGER): Cell;
VAR any: V.ANYPTR;
BEGIN
any := V.get(t.cells, cell)
RETURN any(Cell)
END GetCell;
PROCEDURE GetInt (v: V.VECTOR; idx: INTEGER): INTEGER;
VAR any: V.ANYPTR;
BEGIN
any := V.get(v, idx)
RETURN any(Int).value
END GetInt;
PROCEDURE PutInt (v: V.VECTOR; idx, value: INTEGER);
VAR any: V.ANYPTR;
BEGIN
any := V.get(v, idx);
any(Int).value := value
END PutInt;
PROCEDURE PushInt (v: V.VECTOR; value: INTEGER);
VAR int: Int;
BEGIN
NEW(int);
int.value := value;
V.push(v, int)
END PushInt;
PROCEDURE get_tab_xy (t: Table; x, y: INTEGER): BOOLEAN;
VAR i: INTEGER;
tab: Tab; any: V.ANYPTR;
res: BOOLEAN;
BEGIN
res := FALSE;
i := 0;
WHILE (i < t.tab.count) & ~res DO
any := V.get(t.tab, i);
tab := any(Tab);
res := (tab.col = x) & (tab.row = y);
INC(i)
END
RETURN res
END get_tab_xy;
PROCEDURE set_tab_xy (t: Table; x, y: INTEGER);
VAR tab: Tab;
BEGIN
NEW(tab);
tab.col := x;
tab.row := y;
V.push(t.tab, tab)
END set_tab_xy;
PROCEDURE tr* (t: Table);
BEGIN
INC(t.tab_y);
WHILE t.h_lines.count < t.tab_y + 10 DO
PushInt(t.h_lines, 0)
END;
t.tab_x := 0;
WHILE get_tab_xy(t, t.tab_x, t.tab_y) DO
INC(t.tab_x);
WHILE t.v_lines.count < t.tab_x + 10 DO
PushInt(t.v_lines, 0)
END
END
END tr;
PROCEDURE td* (t: Table; colspan, rowspan: INTEGER);
VAR i, j: INTEGER; _cell: Cell;
BEGIN
FOR i := t.tab_x TO t.tab_x + colspan - 1 DO
FOR j := t.tab_y TO t.tab_y + rowspan - 1 DO
set_tab_xy(t, i, j);
IF i > t.max_length THEN
t.max_length := i
END
END
END;
NEW(_cell);
_cell.left := t.tab_x;
_cell.top := t.tab_y;
_cell.right := t.tab_x + colspan;
WHILE t.v_lines.count < _cell.right + 10 DO
PushInt(t.v_lines, 0)
END;
_cell.bottom := t.tab_y + rowspan;
WHILE t.h_lines.count < _cell.bottom + 10 DO
PushInt(t.h_lines, 0)
END;
_cell.colspan := colspan;
_cell.rowspan := rowspan;
V.push(t.cells, _cell);
WHILE get_tab_xy(t, t.tab_x, t.tab_y) DO
INC(t.tab_x);
WHILE t.v_lines.count < t.tab_x + 10 DO
PushInt(t.v_lines, 0)
END
END
END td;
PROCEDURE set_width* (t: Table; cell, width: INTEGER);
VAR left, right, old_width, d_width, i: INTEGER; _cell: Cell;
BEGIN
_cell := GetCell(t, cell);
right := GetInt(t.v_lines, _cell.right);
left := GetInt(t.v_lines, _cell.left);
old_width := right - left;
d_width := width - old_width;
PutInt(t.v_lines, _cell.right, left + width);
FOR i := _cell.right + 1 TO t.v_lines.count - 1 DO
PutInt(t.v_lines, i, GetInt(t.v_lines, i) + d_width)
END
END set_width;
PROCEDURE set_height* (t: Table; cell, height: INTEGER);
VAR top, bottom, old_height, d_height, i: INTEGER; _cell: Cell;
BEGIN
_cell := GetCell(t, cell);
top := GetInt(t.h_lines, _cell.top);
bottom := GetInt(t.h_lines, _cell.bottom);
old_height := bottom - top;
d_height := height - old_height;
PutInt(t.h_lines, _cell.bottom, top + height);
FOR i := _cell.bottom + 1 TO t.h_lines.count - 1 DO
PutInt(t.h_lines, i, GetInt(t.h_lines, i) + d_height)
END
END set_height;
PROCEDURE get_height* (t: Table; cell: INTEGER): INTEGER;
VAR _cell: Cell;
BEGIN
_cell := GetCell(t, cell)
RETURN GetInt(t.h_lines, _cell.bottom) - GetInt(t.h_lines, _cell.top)
END get_height;
PROCEDURE get_width* (t: Table; cell: INTEGER): INTEGER;
VAR _cell: Cell;
BEGIN
_cell := GetCell(t, cell)
RETURN GetInt(t.v_lines, _cell.right) - GetInt(t.v_lines, _cell.left)
END get_width;
PROCEDURE get_x* (t: Table; cell: INTEGER): INTEGER;
VAR _cell: Cell;
BEGIN
_cell := GetCell(t, cell)
RETURN GetInt(t.v_lines, _cell.left)
END get_x;
PROCEDURE get_y* (t: Table; cell: INTEGER): INTEGER;
VAR _cell: Cell;
BEGIN
_cell := GetCell(t, cell)
RETURN GetInt(t.h_lines, _cell.top)
END get_y;
PROCEDURE get_table_height* (t: Table): INTEGER;
RETURN GetInt(t.h_lines, t.tab_y + 1)
END get_table_height;
PROCEDURE table* (t: Table; tab_width: INTEGER; open: BOOLEAN);
VAR i, width: INTEGER; _cell: Cell;
BEGIN
IF open THEN
t.cells := V.create(1024);
t.v_lines := V.create(1024);
t.h_lines := V.create(1024);
t.tab := V.create(1024);
t.tab_x := 0;
t.tab_y := -1;
t.max_length := 0;
ELSE
width := tab_width DIV (t.max_length + 1);
FOR i := 0 TO t.cells.count - 1 DO
_cell := GetCell(t, i);
set_width(t, i, width * _cell.colspan)
END
END
END table;
PROCEDURE destroy* (t: Table);
BEGIN
IF t # NIL THEN
V.destroy(t.tab, NIL);
V.destroy(t.h_lines, NIL);
V.destroy(t.v_lines, NIL);
V.destroy(t.cells, NIL);
DISPOSE(t)
END
END destroy;
END tables.