/data/common/fb2read |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
/programs/develop/cedit/BUILD.SH |
---|
1,3 → 1,3 |
#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 |
/programs/develop/cedit/RUN.SH |
---|
1,3 → 1,3 |
#SHS |
/tmp0/1/cedit |
/tmp0/1/cedit.kex |
exit |
/programs/other/fb2reader/BUILD.SH |
---|
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 |
/programs/other/fb2reader/FB2READ.INI |
---|
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 |
/programs/other/fb2reader/RUN.SH |
---|
0,0 → 1,3 |
#SHS |
/tmp0/1/fb2read.kex |
exit |
/programs/other/fb2reader/SRC/API.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/ColorDlg.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Conv.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Cursor.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/DOM.ob07 |
---|
0,0 → 1,1756 |
(* |
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 DOM; |
IMPORT XML, SU := SysUtils, S := Strings, Font, Window, G := Graph, LibImg, |
RF := ReadFile, File, Write, Read, Ini, K := KOSAPI, sys := SYSTEM, |
V := Vector, Cursor, box_lib, tables, Search; |
CONST |
BACK_COLOR* = 0; |
TEXT_COLOR* = 1; |
ITALIC_COLOR* = 2; |
LINK_COLOR* = 3; |
VISITED_COLOR* = 4; |
CLICKED_COLOR* = 5; |
CellPadding = 5; |
TYPE |
TSettings* = RECORD |
Colors* : ARRAY 6 OF INTEGER; |
FontSize* : INTEGER; |
TwoCol* : BOOLEAN; |
b_pict* : BOOLEAN; |
PADDING* : RECORD Left, Right, Top*, Bottom, ColInter, LRpc*, CInt*: INTEGER END; |
PARAGRAPH*, |
EPIGRAPH*, |
LEVEL, |
SUB, |
SUP, |
InterLin*, |
Picture*, |
SpaceW: INTEGER |
END; |
StackItem = POINTER TO TStackItem; |
TStackItem = RECORD (XML.DESC_ELEMENT) |
body : XML.TAG; |
Ycur : INTEGER; |
d : REAL |
END; |
VAR |
Settings* : TSettings; |
Canvas_X, Canvas_Y: INTEGER; |
ColLeft : Window.TRect; |
ColRight : Window.TRect; |
Ymin, Ymax, Ycur : INTEGER; |
X, Y, W, LineH, W1, W2: INTEGER; |
epigraph : INTEGER; |
sup, sub : INTEGER; |
ref_depth : INTEGER; |
align : INTEGER; |
code : INTEGER; |
strong : INTEGER; |
italic : INTEGER; |
strike : INTEGER; |
refer : INTEGER; |
Text : ARRAY 100000 OF XML.TEXT; |
TextCount : INTEGER; |
Lines: INTEGER; |
description, contents, mainbody, body, ref, cover, clickRef, hoverRef: XML.TAG; |
MainBody: BOOLEAN; |
f_stk, b_stk, vis_ref: XML.LIST; |
FilePath, FileName: S.STRING; |
done, last, resized, loaded*, mouseDown: BOOLEAN; |
Stack*: ARRAY 1000000 OF CHAR; |
Ycont: INTEGER; |
history: File.FS; |
references: V.VECTOR; |
cursor: INTEGER; |
fsize2, chksum: INTEGER; |
sb: box_lib.scrollbar; |
urlstr* : S.STRING; |
DrawStatus, DrawToolbar: PROCEDURE; |
PROCEDURE PushRef(ref: XML.TAG); |
VAR item: StackItem; |
BEGIN |
NEW(item); |
item.body := ref; |
XML.AddItem(vis_ref, item); |
END PushRef; |
PROCEDURE Push(VAR stk: XML.LIST); |
VAR item: StackItem; |
BEGIN |
NEW(item); |
item.body := body; |
item.Ycur := Ycur; |
XML.AddItem(stk, item); |
IF body = contents THEN |
Ycont := Ycur |
END |
END Push; |
PROCEDURE Pop(VAR stk: XML.LIST); |
VAR item : StackItem; |
BEGIN |
item := stk.last(StackItem); |
IF item # NIL THEN |
body := item.body; |
Ymin := body.Ymin; |
Ymax := body.Ymax; |
Ycur := item.Ycur; |
XML.DelLastItem(stk) |
END |
END Pop; |
PROCEDURE Clear(VAR stk: XML.LIST); |
BEGIN |
REPEAT |
XML.DelLastItem(stk) |
UNTIL stk.last = NIL |
END Clear; |
PROCEDURE AddToLine(text: XML.TEXT); |
BEGIN |
Text[TextCount] := text; |
INC(TextCount) |
END AddToLine; |
PROCEDURE Epigraph(): INTEGER; |
RETURN ORD(epigraph > 0) * Settings.EPIGRAPH |
END Epigraph; |
PROCEDURE SpaceWidth(): INTEGER; |
VAR Result: INTEGER; |
BEGIN |
IF code > 0 THEN |
Result := Font.MonoWidth() |
ELSE |
Result := Settings.SpaceW |
END |
RETURN Result |
END SpaceWidth; |
PROCEDURE Trim; |
VAR n: INTEGER; |
BEGIN |
IF TextCount > 0 THEN |
n := TextCount - 1; |
WHILE (n >= 0) & (Text[n] IS XML.SPACE) DO |
Text[n].width := -1; |
DEC(n) |
END; |
TextCount := n + 1 |
END |
END Trim; |
PROCEDURE Align; |
VAR |
i, n, sp, d, quo, rem, x: INTEGER; |
text: XML.TEXT; |
BEGIN |
IF (TextCount > 0) & (code = 0) & (align # 3) THEN |
sp := 0; |
Trim; |
n := TextCount - 1; |
IF n >= 0 THEN |
d := W - Text[n].X - Text[n].width |
END; |
IF align = 1 THEN |
x := (d + Text[0].X) DIV 2 |
ELSIF align = 2 THEN |
x := d + Text[0].X |
ELSIF align = 0 THEN |
x := Text[0].X; |
FOR i := 0 TO n DO |
IF Text[i] IS XML.SPACE THEN |
INC(sp) |
END |
END; |
IF sp > 0 THEN |
quo := d DIV sp; |
rem := d MOD sp; |
FOR i := 0 TO n DO |
IF Text[i] IS XML.SPACE THEN |
text := Text[i]; |
text.width := text.width + quo + ORD(rem > 0); |
DEC(rem) |
END |
END |
END |
END; |
FOR i := 0 TO n DO |
text := Text[i]; |
text.X := x; |
INC(x, text.width) |
END |
END |
END Align; |
PROCEDURE NewLine; |
BEGIN |
IF align # 0 THEN |
Align |
END; |
X := Epigraph(); |
INC(Y, LineH); |
TextCount := 0 |
END NewLine; |
PROCEDURE Sup(open: BOOLEAN); |
BEGIN |
IF open THEN |
IF sup = 0 THEN |
DEC(Y, Settings.SUP) |
END; |
INC(sup) |
ELSE |
DEC(sup); |
IF sup = 0 THEN |
INC(Y, Settings.SUP) |
END |
END |
END Sup; |
PROCEDURE Sub(open: BOOLEAN); |
BEGIN |
IF open THEN |
IF sub = 0 THEN |
INC(Y, Settings.SUB) |
END; |
INC(sub) |
ELSE |
DEC(sub); |
IF sub = 0 THEN |
DEC(Y, Settings.SUB) |
END |
END |
END Sub; |
PROCEDURE Split(word: XML.WORD); |
VAR |
i, n, max, len: INTEGER; |
c: CHAR; |
rem: XML.WORD; |
BEGIN |
WHILE Font.TextWidth(word.value, max) <= W DO |
INC(max) |
END; |
DEC(max); |
IF max = 0 THEN |
max := 1 |
END; |
i := 0; |
n := 0; |
len := word.value.last - word.value.first + 1; |
WHILE (n <= max) & (i < len) DO |
c := S.GetChar(word.value, i); |
INC(n); |
IF (80X <= c) & (c <= 0BFX) THEN |
DEC(n) |
END; |
INC(i) |
END; |
IF n > max THEN |
DEC(i); |
rem := XML.CreateWord(); |
rem^ := word^; |
rem.value.first := word.value.first + i; |
word.next := rem; |
word.value.last := rem.value.first - 1; |
word.length := S.Utf8Length(word.value); |
word.width := Font.TextWidth(word.value, word.length) |
END |
END Split; |
PROCEDURE Depth(tag: XML.ELEMENT): INTEGER; |
VAR n: INTEGER; |
BEGIN |
n := 0; |
WHILE tag # NIL DO |
IF tag(XML.TAG).value = XML.tag_section THEN |
INC(n) |
END; |
tag := tag.parent |
END |
RETURN n |
END Depth; |
PROCEDURE shift(tag: XML.TAG; shx, shy: INTEGER); |
VAR cur: XML.ELEMENT; t: XML.TAG; |
BEGIN |
cur := tag.child.first; |
WHILE cur # NIL DO |
IF cur IS XML.TAG THEN |
t := cur(XML.TAG); |
INC(t.X, shx); |
INC(t.Ymin, shy); |
INC(t.Ymax, shy); |
shift(t, shx, shy) |
ELSIF cur IS XML.TEXT THEN |
INC(cur(XML.TEXT).X, shx); |
INC(cur(XML.TEXT).Y, shy) |
END; |
cur := cur.next |
END |
END shift; |
PROCEDURE getspan(td: XML.TAG; span: S.STRING): INTEGER; |
VAR res: INTEGER; |
attr_value: S.CHARS; |
err: BOOLEAN; |
BEGIN |
IF XML.GetAttr(td, span, attr_value) THEN |
res := S.CharsToInt(attr_value, err); |
IF err OR (res <= 0) THEN |
res := 1 |
END |
ELSE |
res := 1 |
END |
RETURN res |
END getspan; |
PROCEDURE td(t: tables.Table; tag: XML.TAG); |
BEGIN |
tag.cell := t.cells.count; |
tables.td(t, getspan(tag, "colspan"), getspan(tag, "rowspan")) |
END td; |
PROCEDURE tr(t: tables.Table; tag: XML.TAG); |
VAR |
cur : XML.ELEMENT; |
cell : XML.TAG; |
BEGIN |
tables.tr(t); |
cur := tag.child.first; |
WHILE cur # NIL DO |
IF cur IS XML.TAG THEN |
cell := cur(XML.TAG); |
IF (cell.value = XML.tag_td) OR (cell.value = XML.tag_th) THEN |
cell.table := t; |
td(t, cell) |
END |
END; |
cur := cur.next |
END |
END tr; |
PROCEDURE table(t: tables.Table; tag: XML.TAG; open: BOOLEAN); |
VAR |
cur : XML.ELEMENT; |
row : XML.TAG; |
BEGIN |
IF open THEN |
tables.table(t, W, TRUE); |
cur := tag.child.first; |
WHILE cur # NIL DO |
IF cur IS XML.TAG THEN |
row := cur(XML.TAG); |
IF row.value = XML.tag_tr THEN |
row.table := t; |
tr(t, row) |
END |
END; |
cur := cur.next |
END; |
tables.table(t, W, FALSE) |
END |
END table; |
PROCEDURE layout(body: XML.ELEMENT); |
VAR |
cur : XML.ELEMENT; |
tag : XML.TAG; |
word : XML.WORD; |
text : XML.TEXT; |
tag_value : INTEGER; |
_align : INTEGER; |
title : XML.ELEMENT; |
width : INTEGER; |
height1 : INTEGER; |
height2 : INTEGER; |
PROCEDURE Image (VAR tag: XML.TAG); |
VAR |
note : BOOLEAN; |
img : XML.TAG; |
URL : INTEGER; |
chars : S.CHARS; |
sizeY : INTEGER; |
FName : S.STRING; |
path : S.STRING; |
BEGIN |
IF tag.img # 0 THEN |
LibImg.img_destroy(tag.img) |
END; |
img := XML.GetRef(tag, note, URL); |
IF img # NIL THEN |
IF img.child.first IS XML.WORD THEN |
chars := img.child.first(XML.WORD).value; |
tag.img := LibImg.GetImg(chars.first, chars.last - chars.first + 1, W, sizeY); |
IF tag.img # 0 THEN |
INC(Y, (sizeY DIV LineH) * LineH); |
NewLine; |
tag.Ymax := Y - Y MOD LineH |
END |
END |
ELSIF URL # 0 THEN |
S.PtrToString(URL, FName); |
tag.img := LibImg.LoadFromFile(FName, W, sizeY); |
IF tag.img = 0 THEN |
path := FilePath; |
IF FName[0] # "/" THEN |
S.Append(path, "/") |
END; |
S.Append(path, FName); |
tag.img := LibImg.LoadFromFile(path, W, sizeY); |
END; |
IF tag.img # 0 THEN |
INC(Y, (sizeY DIV LineH) * LineH); |
NewLine; |
tag.Ymax := Y - Y MOD LineH |
END |
END |
END Image; |
BEGIN |
cur := body; |
WHILE cur # NIL DO |
IF cur IS XML.TAG THEN |
tag := cur(XML.TAG); |
tag_value := tag.value; |
CASE tag_value OF |
|XML.tag_p, XML.tag_v: |
Trim; |
IF TextCount > 0 THEN |
NewLine |
END; |
X := Settings.PARAGRAPH + Epigraph() |
|XML.tag_epigraph: |
NewLine; |
INC(epigraph) |
|XML.tag_contents_item: |
INC(ref_depth); |
Settings.EPIGRAPH := Settings.LEVEL * Depth(tag); |
_align := align; |
align := 3 |
|XML.tag_title: |
INC(strong); |
Font.Bold(TRUE); |
_align := align; |
align := 1; |
IF MainBody THEN |
tag.value := XML.tag_contents_item; |
title := XML.Copy(tag); |
XML.AddChild(contents, title); |
title.parent := tag.parent; |
tag.value := XML.tag_title |
END |
|XML.tag_subtitle: |
NewLine; |
_align := align; |
align := 1 |
|XML.tag_text_author, XML.tag_date: |
_align := align; |
align := 2 |
|XML.tag_section, XML.tag_body, XML.tag_empty_line, XML.tag_poem, XML.tag_stanza, XML.tag_annotation, XML.tag_cite: |
NewLine |
|XML.tag_a: |
INC(ref_depth); |
IF XML.IsNote(tag) THEN |
Sup(TRUE) |
END |
|XML.tag_sup: |
Sup(TRUE) |
|XML.tag_sub: |
Sub(TRUE) |
|XML.tag_code: |
Font.sysfont(TRUE); |
INC(code) |
|XML.tag_image: |
tag.X := 0; |
NewLine; |
NewLine |
|XML.tag_coverpage: |
cover := tag |
|XML.tag_table: |
NewLine; |
tables.destroy(tag.table); |
NEW(tag.table); |
table(tag.table, tag, TRUE) |
|XML.tag_td, XML.tag_th: |
IF tag_value = XML.tag_th THEN |
INC(strong); |
Font.Bold(TRUE); |
END; |
SU.ErrorIf(tag.parent(XML.TAG).value # XML.tag_tr, 21); |
NewLine; DEC(Y, LineH); |
tag.Width := tables.get_width(tag.table, tag.cell); |
tag.X := tables.get_x(tag.table, tag.cell); |
width := W; |
W := tag.Width - 2 * CellPadding; |
IF W <= 0 THEN |
W := 1 |
END |
|XML.tag_tr: |
SU.ErrorIf(tag.parent(XML.TAG).value # XML.tag_table, 20) |
|XML.tag_strong: |
INC(strong); |
Font.Bold(TRUE) |
ELSE |
END; |
tag.Ymin := Y - Y MOD LineH; |
layout(tag.child.first); |
tag.Ymax := Y - Y MOD LineH; |
CASE tag_value OF |
|XML.tag_epigraph: |
NewLine; |
DEC(epigraph) |
|XML.tag_subtitle: |
NewLine; |
NewLine; |
align := _align |
|XML.tag_title, XML.tag_text_author, XML.tag_date: |
DEC(strong); |
Font.Bold(strong > 0); |
NewLine; |
align := _align |
|XML.tag_contents_item: |
DEC(ref_depth); |
align := _align; |
|XML.tag_section, XML.tag_poem, XML.tag_v, XML.tag_p, XML.tag_annotation, XML.tag_cite: |
NewLine |
|XML.tag_a: |
DEC(ref_depth); |
IF XML.IsNote(tag) THEN |
Sup(FALSE) |
END |
|XML.tag_sup: |
Sup(FALSE) |
|XML.tag_sub: |
Sub(FALSE) |
|XML.tag_code: |
DEC(code); |
Font.sysfont(code > 0) |
|XML.tag_image: |
Image(tag) |
|XML.tag_table: |
Y := tag.Ymin + tables.get_table_height(tag.table); |
tag.Ymax := Y - Y MOD LineH; |
NewLine; |
|XML.tag_td, XML.tag_th: |
IF tag_value = XML.tag_th THEN |
DEC(strong); |
Font.Bold(strong > 0) |
END; |
W := width; |
NewLine; |
Y := tag.Ymin + Settings.SUP; //!!! |
height1 := tables.get_height(tag.table, tag.cell); |
height2 := tag.Ymax - tag.Ymin + LineH; |
IF height2 > height1 THEN |
tables.set_height(tag.table, tag.cell, height2) |
END; |
INC(tag.Ymin, tables.get_y(tag.table, tag.cell)); |
INC(tag.Ymax, tables.get_height(tag.table, tag.cell)); |
shift(tag, tag.X + CellPadding, tables.get_y(tag.table, tag.cell)); |
|XML.tag_strong: |
DEC(strong); |
Font.Bold(strong > 0) |
ELSE |
END |
ELSIF cur IS XML.WORD THEN |
word := cur(XML.WORD); |
word.length := S.Utf8Length(word.value); |
word.width := Font.TextWidth(word.value, word.length); |
IF W - X < word.width THEN |
Align; |
NewLine |
END; |
IF W < word.width THEN |
Split(word) |
END |
ELSIF cur IS XML.SPACE THEN |
IF W - X < SpaceWidth() THEN |
cur(XML.SPACE).width := 0 |
ELSE |
cur(XML.SPACE).width := SpaceWidth() |
END |
END; |
IF cur IS XML.TEXT THEN |
IF ref_depth > 0 THEN |
V.push(references, cur) |
END; |
text := cur(XML.TEXT); |
text.X := X; |
text.Y := Y; |
INC(X, text.width); |
AddToLine(text) |
END; |
cur := cur.next |
END |
END layout; |
PROCEDURE layout2(body: XML.ELEMENT); |
VAR |
color : INTEGER; |
cur : XML.ELEMENT; |
text : XML.TEXT; |
tag : XML.TAG; |
y, y0 : INTEGER; |
value : INTEGER; |
PROCEDURE DrawText(Col: Window.TRect; min, max, y0, y: INTEGER; right: BOOLEAN; VAR text: XML.TEXT); |
VAR word: XML.WORD; |
BEGIN |
IF (min <= y0) & (y0 <= max) THEN |
Font.sysfont(code > 0); |
IF text IS XML.WORD THEN |
word := text(XML.WORD); |
Font.Text(Col, word.X, y - Col.Height * ORD(right), word.value.first, word.length); |
END; |
Font.StrikeText(Col, text.X, y - Col.Height * ORD(right), text.width) |
END |
END DrawText; |
PROCEDURE Image(VAR tag: XML.TAG); |
VAR sizeX, sizeY, img, y: INTEGER; |
BEGIN |
IF tag.img # 0 THEN |
y := Ycur; |
LibImg.GetInf(tag.img, sizeX, sizeY, img); |
IF (y <= tag.Ymax) & (tag.Ymin <= y + ColLeft.Height) THEN |
G.Image(ColLeft.Left + tag.X, tag.Ymin - y + ColLeft.Top, sizeX, sizeY, img, ColLeft.Top, ColLeft.Top + ColLeft.Height - 1) |
END; |
IF Settings.TwoCol THEN |
y := Ycur + ColLeft.Height; |
IF (y <= tag.Ymax) & (tag.Ymin <= y + ColRight.Height) THEN |
G.Image(ColRight.Left + tag.X, tag.Ymin - y + ColLeft.Top, sizeX, sizeY, img, ColRight.Top, ColRight.Top + ColRight.Height - 1) |
END |
END |
END |
END Image; |
PROCEDURE td(VAR tag: XML.TAG); |
VAR x1, y1, x2, y2, cl: INTEGER; |
BEGIN |
x1 := tag.X + ColLeft.Left; |
y1 := tag.Ymin - Ycur + ColLeft.Top; |
x2 := x1 + tag.Width; |
y2 := y1 + tables.get_height(tag.table, tag.cell); |
cl := G.GetColor(); |
G.SetColor(Settings.Colors[TEXT_COLOR]); |
G.Rect(x1, y1, x2, y2); |
IF Settings.TwoCol THEN |
x1 := x1 - ColLeft.Left + ColRight.Left; |
x2 := x2 - ColLeft.Left + ColRight.Left; |
y1 := y1 - ColLeft.Height; |
y2 := y2 - ColLeft.Height; |
G.Rect(x1, y1, x2, y2) |
END; |
G.SetColor(cl) |
END td; |
BEGIN |
cur := body; |
WHILE cur # NIL DO |
IF cur IS XML.TAG THEN |
tag := cur(XML.TAG); |
IF (tag.value = XML.tag_td) OR (tag.value = XML.tag_th) THEN |
tag.Ymax := tag.Ymin + tables.get_height(tag.table, tag.cell) |
END; |
IF (tag.Ymin < Ycur + LineH * Lines * (ORD(Settings.TwoCol) + 1)) & (tag.Ymax >= Ycur) OR (tag.value = XML.tag_tr) THEN |
value := tag.value; |
CASE value OF |
|XML.tag_a: |
INC(refer); |
color := Font.Font.color; |
IF tag.Clicked THEN |
Font.SetFontColor(Settings.Colors[CLICKED_COLOR]) |
ELSE |
IF tag.Visited THEN |
Font.SetFontColor(Settings.Colors[VISITED_COLOR]) |
ELSE |
Font.SetFontColor(Settings.Colors[LINK_COLOR]) |
END |
END |
|XML.tag_contents_item: |
IF tag.Clicked THEN |
INC(refer); |
color := Font.Font.color; |
Font.SetFontColor(Settings.Colors[CLICKED_COLOR]) |
ELSIF tag.Visited THEN |
INC(refer); |
color := Font.Font.color; |
Font.SetFontColor(Settings.Colors[VISITED_COLOR]) |
END |
|XML.tag_title, XML.tag_strong, XML.tag_th: |
INC(strong); |
Font.Bold(TRUE) |
|XML.tag_strikethrough: |
INC(strike); |
Font.Strike(TRUE) |
|XML.tag_epigraph, XML.tag_cite, XML.tag_emphasis: |
INC(italic); |
Font.Italic(TRUE, refer = 0) |
|XML.tag_image: |
Image(tag) |
|XML.tag_code: |
INC(code) |
ELSE |
END; |
layout2(tag.child.first); |
CASE value OF |
|XML.tag_a: |
DEC(refer); |
Font.SetFontColor(color) |
|XML.tag_contents_item: |
IF tag.Clicked OR tag.Visited THEN |
DEC(refer); |
Font.SetFontColor(color) |
END |
|XML.tag_title, XML.tag_strong: |
DEC(strong); |
Font.Bold(strong > 0) |
|XML.tag_strikethrough: |
DEC(strike); |
Font.Strike(strike > 0) |
|XML.tag_epigraph, XML.tag_cite, XML.tag_emphasis: |
DEC(italic); |
Font.Italic(italic > 0, refer = 0) |
|XML.tag_td: |
td(tag) |
|XML.tag_th: |
DEC(strong); |
Font.Bold(strong > 0); |
td(tag) |
|XML.tag_code: |
DEC(code) |
ELSE |
END |
END |
ELSIF cur IS XML.TEXT THEN |
text := cur(XML.TEXT); |
y := text.Y - Ycur; |
y0 := y - y MOD LineH; |
DrawText(ColLeft, 0, ColLeft.Height - LineH, y0, y, FALSE, text); |
IF Settings.TwoCol THEN |
DrawText(ColRight, ColLeft.Height, ColLeft.Height + ColRight.Height - LineH, y0, y, TRUE, text) |
END |
END; |
cur := cur.next |
END |
END layout2; |
PROCEDURE DrawProgress(progress_color: INTEGER); |
VAR max_X, max_Y: INTEGER; |
BEGIN |
max_X := G.Buffer.Width - 1; |
max_Y := G.Buffer.Height - 1; |
G.SetColor(0); |
G.HLine(0, max_X, 0); |
G.HLine(0, max_X, max_Y); |
G.VLine(0, 0, max_Y); |
sb.max_area := (Ymax - Ymin) DIV LineH + 50; |
sb.cur_area := 50; |
sb.position := (Ycur - Ymin) DIV LineH; |
box_lib.scrollbar_v_draw(sb) |
END DrawProgress; |
PROCEDURE Draw*; |
VAR back, max_X, max_Y: INTEGER; |
BEGIN |
back := Settings.Colors[BACK_COLOR]; |
max_X := G.Buffer.Width - 1; |
max_Y := G.Buffer.Height - 1; |
G.Copy(G.Buffer3, G.Buffer, 0, G.Buffer.Height, 0); |
Font.SetFontColor(Settings.Colors[TEXT_COLOR]); |
IF ((body = description) OR (body = contents)) & Settings.TwoCol THEN |
Settings.TwoCol := FALSE; |
layout2(body.child.first); |
Settings.TwoCol := TRUE; |
Search.draw(body, ColLeft, ColRight, Ycur, LineH, FALSE) |
ELSE |
layout2(body.child.first); |
Search.draw(body, ColLeft, ColRight, Ycur, LineH, Settings.TwoCol) |
END; |
G.Copy(G.Buffer3, G.Buffer, 0, ColLeft.Top + 1, 0); |
G.Copy(G.Buffer3, G.Buffer, max_Y - ColLeft.Top, ColLeft.Top + 1, max_Y - ColLeft.Top); |
DrawProgress(0); |
G.Draw(Canvas_X, Canvas_Y); |
DrawToolbar; |
DrawStatus |
END Draw; |
PROCEDURE BackEnabled* (): BOOLEAN; |
RETURN b_stk.first # NIL |
END BackEnabled; |
PROCEDURE FrwEnabled* (): BOOLEAN; |
RETURN f_stk.first # NIL |
END FrwEnabled; |
PROCEDURE ContentsEnabled* (): BOOLEAN; |
RETURN (contents # NIL) (*& (body # contents)*) |
END ContentsEnabled; |
PROCEDURE DescrEnabled* (): BOOLEAN; |
RETURN (description # NIL) (*& (body # description)*) |
END DescrEnabled; |
PROCEDURE Back*; |
BEGIN |
IF b_stk.first # NIL THEN |
Push(f_stk); |
Pop(b_stk) |
END |
END Back; |
PROCEDURE Forward*; |
BEGIN |
IF f_stk.first # NIL THEN |
Push(b_stk); |
Pop(f_stk) |
END |
END Forward; |
PROCEDURE Contents*; |
BEGIN |
IF (contents # NIL) & (body # contents) THEN |
Push(b_stk); |
Clear(f_stk); |
body := contents; |
Ycur := Ycont; |
Ymin := 0; |
Ymax := body.Ymax |
END |
END Contents; |
PROCEDURE Descr*; |
BEGIN |
IF (description # NIL) & (body # description) THEN |
Push(b_stk); |
Clear(f_stk); |
body := description; |
Ycur := 0; |
Ymin := 0; |
Ymax := body.Ymax |
END |
END Descr; |
PROCEDURE Up*; |
BEGIN |
DEC(Ycur, LineH); |
SU.MinMax(Ycur, Ymin, Ymax) |
END Up; |
PROCEDURE Down*; |
BEGIN |
INC(Ycur, LineH); |
SU.MinMax(Ycur, Ymin, Ymax) |
END Down; |
PROCEDURE PageUp*; |
VAR i: INTEGER; |
BEGIN |
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO |
Up |
END |
END PageUp; |
PROCEDURE PageDown*; |
VAR i: INTEGER; |
BEGIN |
FOR i := 1 TO Lines * (ORD(Settings.TwoCol) + 1) DO |
Down |
END |
END PageDown; |
PROCEDURE Home*; |
BEGIN |
IF Ycur # Ymin THEN |
Push(b_stk); |
Clear(f_stk); |
Ycur := Ymin |
END |
END Home; |
PROCEDURE End*; |
BEGIN |
IF Ycur # Ymax THEN |
Push(b_stk); |
Clear(f_stk); |
Ycur := Ymax |
END |
END End; |
PROCEDURE ScrollBar*; |
BEGIN |
Ycur := sb.position * LineH + Ymin |
END ScrollBar; |
PROCEDURE GetBody(tag: XML.TAG): XML.TAG; |
BEGIN |
WHILE (tag # NIL) & (tag.value # XML.tag_body) DO |
tag := tag.parent(XML.TAG) |
END |
RETURN tag |
END GetBody; |
PROCEDURE layout3(Body: XML.ELEMENT; X, Y: INTEGER); |
VAR |
ptr : V.ANYPTR; |
text : XML.TEXT; |
sect : XML.TAG; |
y : INTEGER; |
i : INTEGER; |
BEGIN |
i := 0; |
WHILE i < references.count DO |
ptr := V.get(references, i); |
text := ptr(XML.TEXT); |
y := text.Y - Ycur; |
IF (y <= Y) & (Y <= y + Font.FontH()) & (text.X <= X) & (X <= text.X + text.width) THEN |
sect := text.parent(XML.TAG); |
IF Body = contents THEN |
WHILE (sect # NIL) & (sect.value # XML.tag_contents_item) DO |
sect := sect.parent(XML.TAG) |
END |
ELSE |
WHILE (sect # NIL) & (sect # Body) DO |
IF sect.value = XML.tag_contents_item THEN |
sect := NIL |
ELSE |
sect := sect.parent(XML.TAG) |
END |
END |
END; |
IF sect # NIL THEN |
sect := text.parent(XML.TAG); |
WHILE sect # NIL DO |
IF (sect.value = XML.tag_contents_item) & (Body = contents) OR (sect.value = XML.tag_a) THEN |
ref := sect; |
sect := NIL; |
i := references.count |
ELSE |
sect := sect.parent(XML.TAG) |
END |
END |
END |
END; |
INC(i) |
END |
END layout3; |
PROCEDURE MouseDown; |
BEGIN |
IF ~mouseDown THEN |
mouseDown := TRUE; |
clickRef := ref; |
ref.Clicked := TRUE; |
Draw |
END |
END MouseDown; |
PROCEDURE MouseUp; |
VAR |
note : BOOLEAN; |
URL : INTEGER; |
redraw: BOOLEAN; |
BEGIN |
redraw := FALSE; |
mouseDown := FALSE; |
IF (ref # NIL) & (clickRef = ref) & ref.Clicked THEN |
redraw := TRUE; |
ref.Clicked := FALSE; |
note := FALSE; |
URL := 0; |
IF ref.value = XML.tag_a THEN |
ref := XML.GetRef(ref, note, URL) |
ELSE |
ref := ref.parent(XML.TAG) |
END; |
IF ref # NIL THEN |
Push(b_stk); |
Clear(f_stk); |
Ycur := ref.Ymin; |
IF note THEN |
body := ref |
ELSE |
body := GetBody(ref) |
END; |
Ymax := body.Ymax; |
Ymin := body.Ymin; |
IF ~clickRef.Visited THEN |
clickRef.Visited := TRUE; |
PushRef(clickRef) |
END |
ELSIF URL # 0 THEN |
SU.Run(Ini.Browser, URL); |
IF ~clickRef.Visited THEN |
clickRef.Visited := TRUE; |
PushRef(clickRef) |
END |
END; |
END; |
IF clickRef # NIL THEN |
clickRef.Clicked := FALSE; |
clickRef := NIL; |
redraw := TRUE |
END; |
IF hoverRef # NIL THEN |
hoverRef.Clicked := FALSE; |
hoverRef := NIL; |
redraw := TRUE |
END; |
IF redraw THEN |
Draw |
END |
END MouseUp; |
PROCEDURE Click*(X, Y: INTEGER; clicked: BOOLEAN); |
VAR |
note : BOOLEAN; |
URL : INTEGER; |
urlchars: S.CHARS; |
urlstr1 : S.STRING; |
BEGIN |
DEC(Y, Settings.PADDING.Top); |
DEC(X, Settings.PADDING.Left); |
IF (0 <= Y) & (Y <= Lines * LineH) THEN |
ref := NIL; |
layout3(body, X, Y); |
IF (ref = NIL) & Settings.TwoCol THEN |
layout3(body, X - ColLeft.Width - Settings.PADDING.ColInter, Y + Lines * LineH); |
END; |
hoverRef := ref; |
IF clicked THEN |
MouseDown |
ELSE |
MouseUp |
END; |
IF ref # NIL THEN |
SU.SetCursor(cursor); |
note := FALSE; |
URL := 0; |
IF ref.value = XML.tag_a THEN |
ref := XML.GetRef(ref, note, URL) |
END; |
IF URL # 0 THEN |
S.PtrToString(URL, urlstr1); |
S.StrToChars(urlstr1, urlchars) |
END |
ELSE |
SU.SetCursor(0); |
urlstr1 := "" |
END; |
IF urlstr1 # urlstr THEN |
urlstr := urlstr1; |
DrawStatus |
END |
ELSE |
SU.SetCursor(0); |
urlstr := ""; |
ref := NIL; |
DrawStatus |
END |
END Click; |
PROCEDURE Scroll*(value: INTEGER); |
BEGIN |
value := 2 * value; |
WHILE value > 0 DO |
Down; |
DEC(value) |
ELSIF value < 0 DO |
Up; |
INC(value) |
END |
END Scroll; |
PROCEDURE main(fb: XML.ELEMENT; Contents: BOOLEAN); |
VAR |
cur: XML.ELEMENT; |
tag: XML.TAG; |
par, epi: INTEGER; |
PROCEDURE lout(body: XML.ELEMENT); |
BEGIN |
TextCount := 0; |
X := 0; |
Y := Settings.SUP; |
layout(body(XML.TAG).child.first); |
body(XML.TAG).Ymax := Y - Settings.SUP |
END lout; |
PROCEDURE lout_one_col(body: XML.ELEMENT); |
BEGIN |
IF body # NIL THEN |
IF Settings.TwoCol THEN |
W := W2; |
Settings.TwoCol := FALSE; |
lout(body); |
Settings.TwoCol := TRUE; |
W := W1 |
ELSE |
lout(body) |
END |
END |
END lout_one_col; |
BEGIN |
TextCount := 0; |
sup := 0; |
sub := 0; |
epigraph := 0; |
align := 0; |
code := 0; |
strong := 0; |
italic := 0; |
strike := 0; |
refer := 0; |
SU.ErrorIf(fb = NIL, 11); |
MainBody := FALSE; |
description := NIL; |
mainbody := NIL; |
cover := NIL; |
cur := fb; |
cur := cur(XML.TAG).child.first; |
WHILE (cur # NIL) & (mainbody = NIL) DO |
IF cur IS XML.TAG THEN |
tag := cur(XML.TAG); |
IF tag.value = XML.tag_description THEN |
description := tag |
ELSIF tag.value = XML.tag_body THEN |
mainbody := tag |
END |
END; |
cur := cur.next |
END; |
SU.ErrorIf(mainbody = NIL, 12); |
WHILE cur # NIL DO |
IF (cur IS XML.TAG) & (cur(XML.TAG).value = XML.tag_body) THEN |
lout(cur) |
END; |
cur := cur.next |
END; |
IF Contents THEN |
contents := XML.CreateTag(); |
MainBody := TRUE; |
END; |
lout(mainbody); |
IF Contents & (contents.child.first = NIL) THEN |
DISPOSE(contents) |
END; |
MainBody := FALSE; |
epigraph := 1; |
par := Settings.PARAGRAPH; |
epi := Settings.EPIGRAPH; |
Settings.PARAGRAPH := 0; |
Settings.EPIGRAPH := 0; |
lout_one_col(contents); |
Settings.EPIGRAPH := epi; |
Settings.PARAGRAPH := par; |
epigraph := 0; |
lout_one_col(description); |
body := mainbody; |
Ymax := body.Ymax; |
Ycur := 0; |
Ymin := 0; |
Ycont := 0 |
END main; |
PROCEDURE Find* (d: INTEGER); |
VAR |
y, min, max: INTEGER; |
BEGIN |
Search.fnext(body, y, d); |
IF y >= 0 THEN |
DEC(y, y MOD LineH); |
min := Ycur; |
IF Settings.TwoCol THEN |
max := min + ColLeft.Height + ColRight.Height - LineH |
ELSE |
max := min + ColLeft.Height - LineH |
END; |
IF (y < min) OR (y > max) THEN |
Ycur := MAX(y - ColLeft.Height DIV 2, 0) |
END; |
DEC(Ycur, Ycur MOD LineH) |
END |
END Find; |
PROCEDURE OpenSearch*; |
BEGIN |
Search.open(Find) |
END OpenSearch; |
PROCEDURE CloseSearch*; |
BEGIN |
Search.close |
END CloseSearch; |
PROCEDURE found* (): BOOLEAN; |
RETURN Search.found(body) |
END found; |
PROCEDURE FontSizeChange(fs: INTEGER); |
BEGIN |
Settings.SUP := fs DIV 4; |
Settings.SUB := fs DIV 4; |
Settings.SpaceW := fs DIV 2; |
Settings.LEVEL := Settings.PARAGRAPH; |
Settings.PADDING.Bottom := Settings.PADDING.Top; |
Settings.PADDING.Left := G.Buffer.Width * Settings.PADDING.LRpc DIV 100; |
IF Settings.PADDING.Left = 0 THEN |
Settings.PADDING.Left := 1 |
END; |
Settings.PADDING.Right := Settings.PADDING.Left; |
Settings.PADDING.ColInter := G.Buffer.Width * Settings.PADDING.CInt DIV 100; |
LineH := Font.FontH() + Settings.SUP + Settings.SUB + Settings.InterLin; |
Window.InitRect( |
ColLeft, Settings.PADDING.Left, Settings.PADDING.Top, |
G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right, |
G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom); |
IF Settings.TwoCol THEN |
ColLeft.Width := (ColLeft.Width - Settings.PADDING.ColInter) DIV 2; |
ColRight := ColLeft; |
ColRight.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter |
END; |
W := ColLeft.Width; |
Lines := ColLeft.Height DIV LineH; |
ColLeft.Height := Lines * LineH; |
ColRight.Height := ColLeft.Height; |
END FontSizeChange; |
PROCEDURE Resize*(Width, Height: INTEGER); |
VAR d: REAL; resize: BOOLEAN; sizeX, sizeY, data: INTEGER; |
PROCEDURE stk1(stk: XML.LIST); |
VAR cur: StackItem; |
BEGIN |
cur := stk.first(StackItem); |
WHILE cur # NIL DO |
cur.d := FLT(cur.Ycur - cur.body.Ymin) / FLT(cur.body.Ymax - cur.body.Ymin); |
cur := cur.next(StackItem) |
END |
END stk1; |
PROCEDURE stk2(stk: XML.LIST); |
VAR cur: StackItem; |
BEGIN |
cur := stk.first(StackItem); |
WHILE cur # NIL DO |
cur.Ycur := FLOOR(FLT(cur.body.Ymax - cur.body.Ymin) * cur.d) + cur.body.Ymin; |
cur.Ycur := cur.Ycur - cur.Ycur MOD LineH; |
SU.MinMax(cur.Ycur, cur.body.Ymin, cur.body.Ymax); |
cur := cur.next(StackItem) |
END |
END stk2; |
BEGIN |
resize := (Width # G.Buffer.Width) OR resized; |
G.Resize(Width, Height); |
G.SetColor(Settings.Colors[BACK_COLOR]); |
IF (Settings.Picture # 0) & Settings.b_pict THEN |
LibImg.GetInf(Settings.Picture, sizeX, sizeY, data); |
G.BackImage(sizeX, sizeY, data); |
ELSE |
G.Clear; |
G.Copy(G.Buffer, G.Buffer3, 0, G.Buffer.Height, 0) |
END; |
IF Font.FontH() # 0 THEN |
FontSizeChange(Font.FontH()); |
ELSE |
FontSizeChange(Settings.FontSize); |
END; |
ColLeft.Width := G.Buffer.Width - Settings.PADDING.Left - Settings.PADDING.Right; |
IF Settings.TwoCol THEN |
ColLeft.Width := (ColLeft.Width - Settings.PADDING.ColInter) DIV 2; |
ColRight.Width := ColLeft.Width; |
ColRight.Left := ColLeft.Left + ColLeft.Width + Settings.PADDING.ColInter |
END; |
ColLeft.Height := G.Buffer.Height - Settings.PADDING.Top - Settings.PADDING.Bottom; |
Lines := ColLeft.Height DIV LineH; |
ColLeft.Height := Lines * LineH; |
ColRight.Height := ColLeft.Height; |
IF done & resize THEN |
resized := FALSE; |
Push(b_stk); |
stk1(b_stk); |
stk1(f_stk); |
IF contents # NIL THEN |
d := FLT(Ycont) / FLT(contents.Ymax) |
END; |
W := ColLeft.Width; |
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter; |
W1 := W; |
main(XML.FB, FALSE); |
Search.resize; |
stk2(b_stk); |
stk2(f_stk); |
IF contents # NIL THEN |
Ycont := FLOOR(FLT(contents.Ymax) * d); |
Ycont := Ycont - Ycont MOD LineH; |
SU.MinMax(Ycont, 0, contents.Ymax) |
END; |
Pop(b_stk); |
END |
END Resize; |
PROCEDURE SetColors*; |
BEGIN |
Settings.Colors[BACK_COLOR] := Ini.GetColor("back", Settings.Colors[BACK_COLOR]); |
Settings.Colors[TEXT_COLOR] := Ini.GetColor("text", Settings.Colors[TEXT_COLOR]); |
Settings.Colors[ITALIC_COLOR] := Ini.GetColor("italic", Settings.Colors[ITALIC_COLOR]); |
Settings.Colors[LINK_COLOR] := Ini.GetColor("link", Settings.Colors[LINK_COLOR]); |
Settings.Colors[VISITED_COLOR] := Ini.GetColor("visited", Settings.Colors[LINK_COLOR]); |
END SetColors; |
PROCEDURE Resized(set1, set2: TSettings): BOOLEAN; |
RETURN (set1.FontSize # set2.FontSize) OR (set1.TwoCol # set2.TwoCol) OR |
(set1.PARAGRAPH # set2.PARAGRAPH) OR (set1.EPIGRAPH # set2.EPIGRAPH) OR |
(set1.PADDING.LRpc # set2.PADDING.LRpc) OR (set1.PADDING.CInt # set2.PADDING.CInt) |
OR (set1.InterLin # set2.InterLin) |
END Resized; |
PROCEDURE SetSettings*(NewSet: TSettings); |
BEGIN |
resized := Resized(Settings, NewSet) OR resized; |
Settings := NewSet; |
Font.Init(Settings.Colors[ITALIC_COLOR], Settings.Colors[TEXT_COLOR], Settings.FontSize); |
Resize(G.Buffer.Width, G.Buffer.Height) |
END SetSettings; |
PROCEDURE Init*(Left, Top, Width, Height: INTEGER); |
BEGIN |
G.Resize(Width, Height); |
Canvas_X := Left; |
Canvas_Y := Top |
END Init; |
PROCEDURE Start; |
BEGIN |
XML.Open(FileName); |
main(XML.FB, TRUE); |
done := TRUE; |
SU.Halt |
END Start; |
PROCEDURE CleanHistory*(fname: S.STRING); |
VAR F: File.FS; pos, pos2, fsize, size, buf, buf2: INTEGER; c: CHAR; |
BEGIN |
F := File.Open(fname); |
IF F # NIL THEN |
fsize := File.Seek(F, 0, 2); |
pos := File.Seek(F, 0, 0); |
buf := K.malloc(fsize + 1024); |
buf2 := K.malloc(fsize + 1024); |
pos := File.Read(F, buf, fsize); |
File.Close(F); |
pos := 0; |
pos2 := 0; |
WHILE pos < fsize DO |
sys.GET(buf + pos, size); |
sys.GET(buf + pos + 4, c); |
IF c = 0X THEN |
sys.MOVE(buf + pos, buf2 + pos2, size); |
pos2 := pos2 + size |
END; |
pos := pos + size |
END; |
F := File.Create(fname); |
pos := File.Write(F, buf2, pos2); |
File.Close(F); |
buf := K.free(buf); |
buf2 := K.free(buf2) |
END |
END CleanHistory; |
PROCEDURE Save; |
VAR history: File.FS; win_size_x, win_size_y, size, pos: INTEGER; |
PROCEDURE WriteInt(history: File.FS; x: INTEGER); |
BEGIN |
IF Write.Int(history, x) THEN END |
END WriteInt; |
PROCEDURE WriteStk(history: File.FS; VAR stk: XML.LIST; links: BOOLEAN); |
VAR |
cur: StackItem; |
BEGIN |
WriteInt(history, XML.ListCount(stk)); |
cur := stk.first(StackItem); |
WHILE cur # NIL DO |
WriteInt(history, cur.body.num); |
IF ~links THEN |
WriteInt(history, cur.Ycur) |
END; |
cur := cur.next(StackItem) |
END |
END WriteStk; |
BEGIN |
Ini.Save(Settings.Colors, Settings.b_pict); |
history := File.Open(Ini.History); |
IF history = NIL THEN |
history := File.Create(Ini.History) |
ELSE |
pos := File.Seek(history, 0 , 2) |
END; |
size := 1 + 18*4 + 1 + 8*(XML.ListCount(b_stk) + XML.ListCount(f_stk)) + 4*XML.ListCount(vis_ref) + 12; |
WriteInt(history, size); |
IF Write.Char(history, 0X) THEN END; |
WriteInt(history, fsize2); |
WriteInt(history, chksum); |
SU.GetWindowSize(win_size_x, win_size_y); |
WriteInt(history, win_size_x); |
WriteInt(history, win_size_y); |
WriteInt(history, Settings.PADDING.LRpc); |
WriteInt(history, Settings.PADDING.Top); |
WriteInt(history, Settings.PADDING.CInt); |
WriteInt(history, Settings.PARAGRAPH); |
WriteInt(history, Settings.EPIGRAPH); |
WriteInt(history, Settings.InterLin); |
IF Write.Boolean(history, Settings.TwoCol) THEN END; |
WriteInt(history, Settings.FontSize); |
WriteInt(history, body.num); |
WriteInt(history, Ymin); |
WriteInt(history, Ymax); |
WriteInt(history, Ycur); |
WriteInt(history, Ycont); |
WriteStk(history, b_stk, FALSE); |
WriteStk(history, f_stk, FALSE); |
WriteStk(history, vis_ref, TRUE); |
WriteInt(history, size); |
File.Close(history); |
CleanHistory(Ini.History) |
END Save; |
PROCEDURE ReadInt(VAR x: INTEGER); |
BEGIN |
IF Read.Int(history, x) THEN END |
END ReadInt; |
PROCEDURE Load; |
VAR body_num, ycur, size, pos: INTEGER; |
PROCEDURE ReadStk(VAR stk: XML.LIST); |
VAR n, num: INTEGER; |
BEGIN |
ReadInt(n); |
WHILE n > 0 DO |
ReadInt(num); |
body := XML.GetTagByNum(num); |
ReadInt(Ycur); |
Push(stk); |
DEC(n) |
END |
END ReadStk; |
PROCEDURE ReadRef; |
VAR |
n, num: INTEGER; |
ref: XML.TAG; |
BEGIN |
ReadInt(n); |
WHILE n > 0 DO |
ReadInt(num); |
ref := XML.GetTagByNum(num); |
IF ref # NIL THEN |
PushRef(ref); |
ref.Visited := TRUE |
END; |
DEC(n) |
END |
END ReadRef; |
BEGIN |
ReadInt(Settings.PADDING.LRpc); |
ReadInt(Settings.PADDING.Top); |
ReadInt(Settings.PADDING.CInt); |
ReadInt(Settings.PARAGRAPH); |
ReadInt(Settings.EPIGRAPH); |
ReadInt(Settings.InterLin); |
IF Read.Boolean(history, Settings.TwoCol) THEN END; |
ReadInt(Settings.FontSize); |
SetSettings(Settings); |
ReadInt(body_num); |
ReadInt(Ymin); |
ReadInt(Ymax); |
ReadInt(ycur); |
ReadInt(Ycont); |
ReadStk(b_stk); |
ReadStk(f_stk); |
ReadRef; |
ReadInt(size); |
pos := File.Seek(history, -size, 1); |
pos := File.Seek(history, 4, 1); |
IF Write.Char(history, 1X) THEN END; |
Ycur := ycur; |
body := XML.GetTagByNum(body_num); |
File.Close(history) |
END Load; |
PROCEDURE GetWinSize*(hist_fn: S.STRING; VAR win_size_x, win_size_y: INTEGER); |
VAR c: CHAR; size, pos, x, y, fsize, _chksum: INTEGER; found: BOOLEAN; |
BEGIN |
fsize2 := RF.FileSize(hist_fn); |
chksum := RF.ChkSum(hist_fn); |
found := FALSE; |
history := File.Open(Ini.History); |
pos := File.Seek(history, -4, 2); |
last := FALSE; |
WHILE pos >= 0 DO |
IF Read.Int(history, size) THEN |
pos := File.Seek(history, -size + 4, 1); |
END; |
IF Read.Char(history, c) THEN END; |
ReadInt(fsize); |
ReadInt(_chksum); |
IF (c = 0X) & (fsize = fsize2) & (_chksum = chksum) THEN |
found := TRUE; |
IF Read.Int(history, x) & Read.Int(history, y) THEN |
win_size_x := x; |
win_size_y := y; |
ELSE |
found := FALSE |
END; |
pos := -1 |
ELSE |
IF ~last THEN |
last := TRUE; |
ReadInt(x); |
ReadInt(y); |
ReadInt(Settings.PADDING.LRpc); |
ReadInt(Settings.PADDING.Top); |
ReadInt(Settings.PADDING.CInt); |
ReadInt(Settings.PARAGRAPH); |
ReadInt(Settings.EPIGRAPH); |
ReadInt(Settings.InterLin); |
IF Read.Boolean(history, Settings.TwoCol) THEN END; |
ReadInt(Settings.FontSize); |
END; |
pos := File.Seek(history, pos - 8, 0) |
END |
END; |
IF ~found THEN |
File.Close(history) |
END |
END GetWinSize; |
PROCEDURE Open*(FName: S.STRING; DrawWindow, _DrawStatus, _DrawToolbar: SU.ENTRY); |
VAR PID, event: INTEGER; |
BEGIN |
DrawStatus := _DrawStatus; |
DrawToolbar := _DrawToolbar; |
cursor := SU.LoadCursor(Cursor.GetCursor()); |
references := V.create(1024); |
ref_depth := 0; |
done := FALSE; |
loaded := FALSE; |
FilePath := FName; |
FileName := FName; |
S.GetPath(FilePath); |
W := ColLeft.Width; |
W1 := W; |
W2 := ColLeft.Width + ColRight.Width + Settings.PADDING.ColInter; |
Lines := ColLeft.Height DIV LineH; |
ColLeft.Height := Lines * LineH; |
PID := SU.NewThread(Start, Stack); |
WHILE ~SU.IsTerminated(PID) DO |
event := SU.CheckEvent(); |
IF event = 3 THEN |
SU.TerminateThreadId(PID); |
SU.Halt |
END; |
G.Progress(RF.Progress()); |
G.Draw(Canvas_X, Canvas_Y); |
DrawWindow; |
SU.Pause(30) |
END; |
IF ~done THEN |
SU.Halt |
END; |
loaded := TRUE; |
resized := TRUE; |
IF history # NIL THEN |
Load |
ELSE |
SetSettings(Settings) |
END |
END Open; |
PROCEDURE Close*; |
BEGIN |
SU.DelCursor(cursor); |
Save; |
SU.Halt |
END Close; |
PROCEDURE SetScrollBar*(_sb: box_lib.scrollbar); |
BEGIN |
sb := _sb |
END SetScrollBar; |
PROCEDURE Set_b_pict*(b_pict: BOOLEAN); |
BEGIN |
Settings.b_pict := b_pict |
END Set_b_pict; |
BEGIN |
clickRef := NIL; |
hoverRef := NIL; |
mouseDown := FALSE |
END DOM. |
/programs/other/fb2reader/SRC/FB2READ.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/File.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Font.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Graph.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Icons.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Ini.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/KOSAPI.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/LISTS.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Libimg.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/OpenDlg.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/RTL.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Read.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/ReadFile.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Search.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/SearchForm.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/SelEnc.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Settings.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Strings.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/SysUtils.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Toolbar.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Txt2fb2.ob07 |
---|
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("<") |
ELSIF ch = ">" THEN |
WriteStr(">") |
ELSIF ch = "&" THEN |
WriteStr("&") |
ELSIF ch = "'" THEN |
WriteStr("'") |
ELSIF ch = 22X THEN |
WriteStr(""") |
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. |
/programs/other/fb2reader/SRC/Vector.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Window.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/Write.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/XML.ob07 |
---|
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, "&", "&"); |
S.Replace(chars, "<", "<"); |
S.Replace(chars, ">", ">"); |
S.Replace(chars, """, 22X); |
S.Replace(chars, "'", "'"); |
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. |
/programs/other/fb2reader/SRC/box_lib.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/encode.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/kfonts.ob07 |
---|
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. |
/programs/other/fb2reader/SRC/tables.ob07 |
---|
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. |