Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 8727 → Rev 8728

/programs/develop/cedit/SRC/API.ob07
0,0 → 1,332
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2020-2021, 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;
 
_import*, 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 OutChar (c: CHAR);
BEGIN
K.sysfunc3(63, 1, ORD(c))
END OutChar;
 
 
PROCEDURE OutLn;
BEGIN
OutChar(0DX);
OutChar(0AX)
END OutLn;
 
 
PROCEDURE OutStr (pchar: INTEGER);
VAR
c: CHAR;
BEGIN
IF pchar # 0 THEN
REPEAT
SYSTEM.GET(pchar, c);
IF c # 0X THEN
OutChar(c)
END;
INC(pchar)
UNTIL c = 0X
END
END OutStr;
 
 
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN
IF lpCaption # 0 THEN
OutLn;
OutStr(lpCaption);
OutChar(":");
OutLn
END;
OutStr(lpText);
IF lpCaption # 0 THEN
OutLn
END
END DebugMsg;
 
 
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;
BEGIN
OutString("import error: ");
IF K.imp_error.error = 1 THEN
OutString("can't load '"); OutString(K.imp_error.lib)
ELSIF K.imp_error.error = 2 THEN
OutString("not found '"); OutString(K.imp_error.proc); OutString("' in '"); OutString(K.imp_error.lib)
END;
OutString("'");
OutLn
END imp_error;
 
 
PROCEDURE init* (import_, code: INTEGER);
BEGIN
multi := FALSE;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init;
_import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0);
IF ~_import THEN
imp_error
END
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/develop/cedit/SRC/CEdit.ob07
0,0 → 1,1658
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE CEdit;
 
IMPORT
SYSTEM, OpenDlg, K := KolibriOS,
U := Utils, Lines, Menu, List,
G := Graph, T := Text, E := Encodings,
CB := Clipboard, Languages,
ChangeLog, Scroll,
RW, Ini, box_lib, LibImg;
 
CONST
header = "CEdit (20-may-2021)";
 
ShellFilter = "";(* "SH|"; *)
EditFilter = "SH|ASM|TXT|INC|OB07|C|CPP|H|PAS|PP|LUA|INI";
 
fontWidth = K.fontWidth;
fontHeight = K.fontHeight;
scrollWidth = 22;
 
btnClose = 1;
btnNew = 20;
btnOpen = 21;
btnSave = 22;
btnSearch = 23;
btnUndo = 24;
btnRedo = 25;
btnUpper = 26;
btnLower = 27;
btnBuild = 28;
btnRun = 29;
btnUp = 30;
btnDown = 31;
btnLeft = 32;
btnRight = 33;
btnYes = 40;
btnNo = 41;
btnFindEdit = 50;
btnReplaceEdit = 51;
btnGotoEdit = 52;
btnFindNext = 60;
btnReplace = 61;
btnReplaceAll = 62;
btnGoto = 63;
btnCloseFind = 64;
 
btnFile = 70;
btnEdit = 71;
btnEncoding = 72;
btnView = 73;
btnSyntax = 74;
btnProgram = 75;
btnTools = 76;
 
MainMenuHeight = fontHeight + 7;
 
btnColor = 0CCCCCCH;
btnHeight = 25;
btnWidth = 75;
btnTop = MainMenuHeight + 3;
toolBtnSize = 24;
toolbarDelim = 7;
 
TOP = btnTop + toolBtnSize + 7;
RIGHT = scrollWidth - 2;
BOTTOM = scrollWidth + 25;
 
winColor = K.winColor; minWinWidth = 635; minWinHeight = 542;
 
toolbarColor = 0DFDFDFH;
 
SEARCH_PADDING = 10;
searchLeft = 10;
EditBox_Width = 180;
EDITBOX_MAXCHARS = 500;
 
menuFileX = searchLeft;
menuEditX = menuFileX + 4*fontWidth + 2 + 7;
menuEncodingX = menuEditX + 4*fontWidth + 2 + 7;
menuViewX = menuEncodingX + 8*fontWidth + 2 + 7;
menuSyntaxX = menuViewX + 4*fontWidth + 2 + 7;
menuProgramX = menuSyntaxX + 6*fontWidth + 2 + 7;
menuToolsX = menuProgramX + 7*fontWidth + 2 + 7;
 
menuCut = 1;
menuCopy = 2;
menuPaste = 3;
menuDelete = 4;
menuSelectAll = 5;
 
menuUndo = 6;
menuRedo = 7;
 
menuSearch = 8;
menuGoto = 9;
 
menuNew = 10;
menuOpen = 11;
menuSave = 12;
menuSaveAs = 13;
menuFolder = 14;
menuExit = 15;
 
menuNumbers = 20;
(*menuSettings = 21;*)
menuColors = 1000;
menuMaxColors = menuColors + Ini.MAX_SECTIONS - 1;
 
menuNone = 30;
menuC = 31;
menuFasm = 32;
menuIni = 33;
menuLua = 34;
menuOberon = 35;
menuPascal = 36;
 
menuBuild = 50;
menuBuildScript = 51;
menuRun = 52;
menuRunScript = 53;
menuDebug = 54;
menuDebugScript = 55;
 
menuUTF8BOM = 60;
menuUTF8 = 61;
menuCP866 = 62;
menuWin1251 = 63;
 
menuPipet = 70;
menuSysFunc = 71;
 
VAR
canvas: G.tCanvas;
font: G.tFont;
text: T.tText;
winWidth, winHeight: INTEGER;
shift: SET;
AppPath, runScript, buildScript, debugScript: RW.tFileName;
OD: OpenDlg.Dialog;
confirm, notFound, search, modified: BOOLEAN;
 
leftButton, VScroll, HScroll: BOOLEAN;
vScroll, hScroll: Scroll.tScroll;
LEFT: INTEGER;
 
FindEdit, ReplaceEdit, GotoEdit: box_lib.edit_box;
CS, WH, BKW: box_lib.checkbox;
 
new_searchText, searchText, replaceText, gotoText: T.tString;
cs, whole: BOOLEAN;
 
replaced: INTEGER;
 
mainTID: INTEGER;
 
context, menuFile, menuEdit, menuEncoding, menuView, menuSyntax, menuProgram, menuTools: Menu.tMenu;
 
icons: INTEGER;
grayIcons: INTEGER;
 
IPC: ARRAY 64 OF INTEGER;
 
 
PROCEDURE WritePos (y: INTEGER);
VAR
s1, s2: ARRAY 32 OF WCHAR;
line, col: INTEGER;
BEGIN
T.getPos(text, col, line);
U.int2str(line, s1);
U.int2str(col, s2);
U.append(s1, ": ");
U.append(s1, s2);
K.DrawText(LEFT, y, 0, s1)
END WritePos;
 
 
PROCEDURE EditBox_Focus (edit: box_lib.edit_box): BOOLEAN;
RETURN 1 IN BITS(edit.flags)
END EditBox_Focus;
 
 
PROCEDURE EditBox_SetFocus (edit: box_lib.edit_box; value: BOOLEAN);
BEGIN
IF value THEN
edit.flags := ORD(BITS(edit.flags) + {1})
ELSE
edit.flags := ORD(BITS(edit.flags) - {1})
END;
(* IF value THEN
edit.color := 0FFFFFFH
ELSE
edit.color := 0D0D0D0H
END;*)
IF search THEN
box_lib.edit_box_draw(edit)
END
END EditBox_SetFocus;
 
 
PROCEDURE Rect (left, top, right, bottom, color: INTEGER);
BEGIN
K.DrawLine(left, top, right, top, color);
K.DrawLine(left, bottom, right, bottom, color);
K.DrawLine(left, top, left, bottom, color);
K.DrawLine(right, top, right, bottom, color);
END Rect;
 
 
PROCEDURE Message (s: ARRAY OF WCHAR);
CONST
minWidth = 30;
height = 40;
borderColor = 808080H;
VAR
top, left, right, bottom, x, y, width: INTEGER;
BEGIN
width := minWidth + LENGTH(s)*fontWidth;
left := (canvas.width - width) DIV 2 + LEFT;
top := (canvas.height - height) DIV 2 + TOP;
bottom := top + height - 1;
right := left + width - 1;
x := minWidth DIV 2 + left;
y := (height - fontHeight) DIV 2 + top;
K.DrawRect(left, top, width, height, winColor);
Rect(left, top, right, bottom, borderColor);
K.DrawText(x, y, 0, s);
END Message;
 
 
PROCEDURE NotFound;
BEGIN
IF notFound THEN
Message("not found");
notFound := FALSE;
EditBox_SetFocus(FindEdit, TRUE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE)
END
END NotFound;
 
 
PROCEDURE Replaced;
VAR
s, s1: ARRAY 32 OF WCHAR;
BEGIN
IF replaced # 0 THEN
s := "replaced: ";
U.int2str(replaced, s1);
U.append(s, s1);
Message(s);
replaced := 0;
EditBox_SetFocus(FindEdit, TRUE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE)
END
END Replaced;
 
 
PROCEDURE icons16 (icons, n, x, y: INTEGER);
VAR
sizeX, sizeY, data: INTEGER;
BEGIN
LibImg.GetInf(icons, sizeX, sizeY, data);
K.DrawImage(data + 16*16*3*n, 16, 16, x, y)
END icons16;
 
 
PROCEDURE toolbarIcons;
CONST
iconPad = (toolBtnSize - 16) DIV 2;
VAR
x, color: INTEGER;
BEGIN
x := searchLeft + (toolBtnSize + 5)*2;
IF text.modified THEN
icons16(icons, 5, x + iconPad, btnTop + iconPad)
ELSE
icons16(grayIcons, 5, x + iconPad, btnTop + iconPad)
END;
 
IF text.edition # NIL THEN
x := searchLeft + (toolBtnSize + 5)*4 + toolbarDelim*2;
IF ChangeLog.isFirstGuard(text.edition) THEN
icons16(grayIcons, 37, x + iconPad, btnTop + iconPad)
ELSE
icons16(icons, 37, x + iconPad, btnTop + iconPad)
END;
 
x := searchLeft + (toolBtnSize + 5)*5 + toolbarDelim*2;
IF ChangeLog.isLastGuard(text.edition) THEN
icons16(grayIcons, 36, x + iconPad, btnTop + iconPad)
ELSE
icons16(icons, 36, x + iconPad, btnTop + iconPad)
END
(* ELSE
x := searchLeft + (toolBtnSize + 5)*4;
icons16(grayIcons, 37, x + iconPad, btnTop + iconPad);
x := searchLeft + (toolBtnSize + 5)*5;
icons16(grayIcons, 36, x + iconPad, btnTop + iconPad)*)
END;
 
IF T.selected(text) THEN
color := 00000FFH
ELSE
color := 0808080H
END;
 
x := searchLeft + (toolBtnSize + 5)*6 + toolbarDelim*3;
K.DrawRect(x, btnTop, toolBtnSize, toolBtnSize, toolbarColor);
K.DrawText69(x + (toolBtnSize - 12) DIV 2, btnTop + (toolBtnSize - 9) DIV 2 + 2, color, "AB");
INC(x, toolBtnSize + 5);
K.DrawRect(x, btnTop, toolBtnSize, toolBtnSize, toolbarColor);
K.DrawText69(x + (toolBtnSize - 12) DIV 2, btnTop + (toolBtnSize - 9) DIV 2 + 2, color, "ab");
 
x := searchLeft + (toolBtnSize + 5)*8 + toolbarDelim*4;
IF buildScript # "" THEN
icons16(icons, 54, x + iconPad, btnTop + iconPad)
ELSE
icons16(grayIcons, 54, x + iconPad, btnTop + iconPad)
END;
INC(x, toolBtnSize + 5);
IF runScript # "" THEN
icons16(icons, 53, x + iconPad, btnTop + iconPad)
ELSE
icons16(grayIcons, 53, x + iconPad, btnTop + iconPad)
END
END toolbarIcons;
 
 
PROCEDURE WriteModified (x, y: INTEGER);
BEGIN
modified := text.modified;
K.DrawRect(x, TOP + canvas.height + scrollWidth - 1, 9*fontWidth, BOTTOM - scrollWidth + 1, winColor);
IF modified THEN
K.DrawText866(x, y, 0, "modified")
END
END WriteModified;
 
 
PROCEDURE repaint;
VAR
width, height, scrollX, scrollY, y: INTEGER;
BEGIN
IF text # NIL THEN
IF confirm THEN
K.DeleteButton(btnYes);
K.DeleteButton(btnNo);
confirm := FALSE
END;
T.draw(text);
K.ClientSize(width, height);
y := height - (BOTTOM - scrollWidth) + (BOTTOM - scrollWidth - 16) DIV 2;
K.DrawRect(LEFT, TOP + canvas.height + scrollWidth - 1, 16*fontWidth, BOTTOM - scrollWidth + 1, winColor);
WritePos(y);
 
IF modified # text.modified THEN
WriteModified(width - 9*fontWidth, y)
END;
 
T.getScroll(text, scrollX, scrollY);
vScroll.value := scrollY; vScroll.maxVal := text.count - 1;
hScroll.value := scrollX; hScroll.maxVal := Lines.maxLength;
Scroll.draw(vScroll, LEFT + canvas.width - 1, TOP + scrollWidth - 1);
Scroll.draw(hScroll, LEFT + scrollWidth, TOP + canvas.height - 1);
 
G.DrawCanvas(canvas, LEFT, TOP);
NotFound;
Replaced;
toolbarIcons
END
END repaint;
 
 
PROCEDURE resize;
VAR
cliWidth, cliHeight: INTEGER;
BEGIN
K.WinSize(winWidth, winHeight);
IF winWidth < minWinWidth THEN
winWidth := minWinWidth
END;
IF winHeight < minWinHeight THEN
winHeight := minWinHeight
END;
K.SetWinSize(winWidth, winHeight);
K.WinSize(winWidth, winHeight);
K.ClientSize(cliWidth, cliHeight);
G.destroy(canvas);
canvas := G.CreateCanvas(cliWidth - (LEFT + RIGHT + 1), cliHeight - (TOP + BOTTOM));
G.SetFont(canvas, font);
T.setCanvas(canvas);
T.resize(canvas.width, canvas.height);
Scroll.resize(vScroll, vScroll.xSize, canvas.height - scrollWidth*2 + 1);
Scroll.resize(hScroll, canvas.width - scrollWidth*2, hScroll.ySize);
END resize;
 
 
PROCEDURE SearchPanel (left, top: INTEGER);
VAR
y, right, bottom, color: INTEGER;
BEGIN
right := left + EditBox_Width + SEARCH_PADDING*2;
bottom := top + 395 + btnHeight + SEARCH_PADDING;
color := T.colors.border;
Rect(left, top, right, bottom, color);
K.CreateButton(btnCloseFind, right - 20, top, 20, 20, 0EF999FH, "");
K.DrawLine(right - 14, top + 5, right - 5, top + 14, 0FFFFFFH);
K.DrawLine(right - 15, top + 5, right - 5, top + 15, 0FFFFFFH);
K.DrawLine(right - 15, top + 6, right - 6, top + 15, 0FFFFFFH);
K.DrawLine(right - 15, top + 14, right - 6, top + 5, 0FFFFFFH);
K.DrawLine(right - 15, top + 15, right - 5, top + 5, 0FFFFFFH);
K.DrawLine(right - 14, top + 15, right - 5, top + 6, 0FFFFFFH);
 
INC(top, 15);
INC(left, SEARCH_PADDING);
K.DrawText866(left, top, 0, "find");
K.DrawText866(left, top + 55, 0, "replace with");
K.CreateButton(btnFindEdit + ORD({30}), left, top + 20, EditBox_Width, fontHeight + 5, 0, "");
K.CreateButton(btnReplaceEdit + ORD({30}), left, top + 75, EditBox_Width, fontHeight + 5, 0, "");
K.DrawText866(left, top + 330, 0, "go to line");
K.CreateButton(btnGotoEdit + ORD({30}), left, top + 350, EditBox_Width, fontHeight + 5, 0, "");
BKW.top_s := BKW.top_s MOD 65536 + (top + 110) * 65536;
CS.top_s := CS.top_s MOD 65536 + (top + 140) * 65536;
WH.top_s := WH.top_s MOD 65536 + (top + 170) * 65536;
BKW.left_s := BKW.left_s MOD 65536 + left * 65536;
CS.left_s := CS.left_s MOD 65536 + left * 65536;
WH.left_s := WH.left_s MOD 65536 + left * 65536;
FindEdit.top := top + 20;
ReplaceEdit.top := top + 75;
GotoEdit.top := top + 350;
FindEdit.left := left;
ReplaceEdit.left := left;
GotoEdit.left := left;
box_lib.edit_box_draw(FindEdit);
box_lib.edit_box_draw(ReplaceEdit);
box_lib.edit_box_draw(GotoEdit);
box_lib.check_box_draw2(BKW); K.DrawText866(left + 20, top + 110, 0, "backward");
box_lib.check_box_draw2(CS); K.DrawText866(left + 20, top + 140, 0, "match case");
box_lib.check_box_draw2(WH); K.DrawText866(left + 20, top + 170, 0, "whole word");
y := top + 200;
K.CreateButton(btnFindNext, left, y, btnWidth, btnHeight, btnColor, "next"); INC(y, btnHeight + 10);
K.CreateButton(btnReplace, left, y, btnWidth, btnHeight, btnColor, "replace"); INC(y, btnHeight + 10);
K.CreateButton(btnReplaceAll, left, y, btnWidth + 5*fontWidth - 2, btnHeight, btnColor, "replace all");
K.CreateButton(btnGoto, left, top + 380, btnWidth, btnHeight, btnColor, "go");
END SearchPanel;
 
 
PROCEDURE gray (icons: INTEGER);
VAR
sizeX, sizeY, data, x, y: INTEGER;
b, g, r, gr: BYTE;
BEGIN
LibImg.GetInf(icons, sizeX, sizeY, data);
FOR y := 0 TO sizeY - 1 DO
FOR x := 0 TO sizeX - 1 DO
SYSTEM.GET8(data, b);
SYSTEM.GET8(data + 1, g);
SYSTEM.GET8(data + 2, r);
gr := (r + g + b) DIV 3;
SYSTEM.PUT8(data, gr);
SYSTEM.PUT8(data + 1, gr);
SYSTEM.PUT8(data + 2, gr);
INC(data, 3);
END
END
END gray;
 
 
PROCEDURE iconsBackColor (icons: INTEGER);
VAR
sizeX, sizeY, data, x, y: INTEGER;
b, g, r: BYTE;
BEGIN
LibImg.GetInf(icons, sizeX, sizeY, data);
FOR y := 0 TO sizeY - 1 DO
FOR x := 0 TO sizeX - 1 DO
SYSTEM.GET8(data, b);
SYSTEM.GET8(data + 1, g);
SYSTEM.GET8(data + 2, r);
IF b + g + r = 765 THEN
b := toolbarColor MOD 256;
g := toolbarColor DIV 256 MOD 256;
r := toolbarColor DIV 65536 MOD 256
END;
SYSTEM.PUT8(data, b);
SYSTEM.PUT8(data + 1, g);
SYSTEM.PUT8(data + 2, r);
INC(data, 3);
END
END
END iconsBackColor;
 
 
PROCEDURE draw_window;
CONST
selMenuColor = 0CCE8FFH;
iconPad = (toolBtnSize - 16) DIV 2;
VAR
width, height, x, y: INTEGER;
 
 
PROCEDURE drawToolbarBtn (id, x: INTEGER);
BEGIN
K.DrawRect(x, btnTop, toolBtnSize, toolBtnSize, toolbarColor);
K.DrawLine(x, btnTop + toolBtnSize, x + toolBtnSize, btnTop + toolBtnSize, 0808080H);
K.DrawLine(x + toolBtnSize, btnTop, x + toolBtnSize, btnTop + toolBtnSize, 0808080H);
K.CreateButton(id + ORD({30}), x, btnTop, toolBtnSize, toolBtnSize, btnColor, "");
END drawToolbarBtn;
 
 
PROCEDURE drawMainMenu (menu: Menu.tMenu; x: INTEGER; btn: INTEGER; caption: ARRAY OF WCHAR);
VAR
menuColor, n: INTEGER;
BEGIN
IF menu.tid # 0 THEN
menuColor := selMenuColor
ELSE
menuColor := winColor
END;
n := LENGTH(caption);
K.DrawRect(x, 0, n*fontWidth + 2, MainMenuHeight, menuColor);
K.CreateButton(btn + ORD({30}), x, 0, n*fontWidth + 2, MainMenuHeight, btnColor, caption);
END drawMainMenu;
 
 
BEGIN
K.BeginDraw;
K.CreateWindow(50 + K.GetTickCount() MOD 128, 50 + K.GetTickCount() MOD 128, winWidth, winHeight, winColor, 73H, 0, 0, header);
IF (text # NIL) & ~K.RolledUp() THEN
confirm := FALSE;
K.ClientSize(width, height);
 
K.DrawRect(0, 0, width, TOP, winColor);
K.DrawRect(0, 0, LEFT, height, winColor);
K.DrawRect(LEFT + canvas.width - 1, TOP + canvas.height - 1, scrollWidth, scrollWidth, winColor);
 
drawMainMenu(menuFile, menuFileX, btnFile, "file");
drawMainMenu(menuEdit, menuEditX, btnEdit, "edit");
drawMainMenu(menuEncoding, menuEncodingX, btnEncoding, "encoding");
drawMainMenu(menuView, menuViewX, btnView, "view");
drawMainMenu(menuSyntax, menuSyntaxX, btnSyntax, "syntax");
drawMainMenu(menuProgram, menuProgramX, btnProgram, "program");
drawMainMenu(menuTools, menuToolsX, btnTools, "tools");
 
x := searchLeft;
 
drawToolbarBtn(btnNew, x);
icons16(icons, 2, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
 
drawToolbarBtn(btnOpen, x);
icons16(icons, 0, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
 
drawToolbarBtn(btnSave, x);
INC(x, toolBtnSize + 5 + toolbarDelim);
 
drawToolbarBtn(btnSearch, x);
icons16(icons, 49, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5 + toolbarDelim);
 
drawToolbarBtn(btnUndo, x);
INC(x, toolBtnSize + 5);
 
drawToolbarBtn(btnRedo, x);
INC(x, toolBtnSize + 5 + toolbarDelim);
 
drawToolbarBtn(btnUpper, x);
K.DrawText69(x + (toolBtnSize - 12) DIV 2, btnTop + (toolBtnSize - 9) DIV 2 + 2, 0, "AB");
INC(x, toolBtnSize + 5);
 
drawToolbarBtn(btnLower, x);
K.DrawText69(x + (toolBtnSize - 12) DIV 2, btnTop + (toolBtnSize - 9) DIV 2 + 2, 0, "ab");
INC(x, toolBtnSize + 5 + toolbarDelim);
 
drawToolbarBtn(btnBuild, x);
icons16(icons, 54, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
 
drawToolbarBtn(btnRun, x);
icons16(icons, 53, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
 
K.CreateButton(btnUp, LEFT + canvas.width - 1, TOP, scrollWidth - 1, scrollWidth, btnColor, 0X);
K.DrawText69(LEFT + canvas.width - 1 + (scrollWidth - 6) DIV 2, TOP + (scrollWidth - 9) DIV 2, 0, 18X);
K.CreateButton(btnDown, LEFT + canvas.width - 1, TOP + canvas.height - scrollWidth - 1, scrollWidth - 1, scrollWidth, btnColor, 0X);
K.DrawText69(LEFT + canvas.width - 1 + (scrollWidth - 6) DIV 2, TOP + canvas.height - scrollWidth + (scrollWidth - 9) DIV 2, 0, 19X);
 
K.CreateButton(btnLeft, LEFT, TOP + canvas.height - 1, scrollWidth, scrollWidth - 1, btnColor, 0X);
K.DrawText69(LEFT + (scrollWidth - 6) DIV 2, TOP + canvas.height - 1 + (scrollWidth - 9) DIV 2 + 1, 0, 1BX);
K.CreateButton(btnRight, LEFT + canvas.width - scrollWidth - 1, TOP + canvas.height - 1, scrollWidth, scrollWidth - 1, btnColor, 0X);
K.DrawText69(LEFT + canvas.width - scrollWidth - 1 + (scrollWidth - 6) DIV 2, TOP + canvas.height - 1 + (scrollWidth - 9) DIV 2 + 1, 0, 1AX);
 
y := (btnHeight - fontHeight) DIV 2 + btnTop;
CASE text.enc OF
|E.UTF8: K.DrawText866(width - 6*fontWidth, y, 0, "UTF-8")
|E.UTF8BOM: K.DrawText866(width - 10*fontWidth, y, 0, "UTF-8-BOM")
|E.CP866: K.DrawText866(width - 6*fontWidth, y, 0, "CP866")
|E.W1251: K.DrawText866(width - 13*fontWidth, y, 0, "Windows-1251")
END;
IF search THEN
SearchPanel(searchLeft, TOP)
END;
 
y := height - (BOTTOM - scrollWidth) + (BOTTOM - scrollWidth - 16) DIV 2;
K.DrawRect(LEFT + 16*fontWidth, TOP + canvas.height + scrollWidth - 1, width - LEFT - 25*fontWidth, BOTTOM - scrollWidth + 1, winColor);
K.DrawText866(LEFT + 16*fontWidth, y, 0, text.fileName);
WriteModified(width - 9*fontWidth, y);
repaint
END;
K.EndDraw
END draw_window;
 
 
PROCEDURE mouse (VAR x, y: INTEGER);
VAR
mouseX, mouseY,
cliX, cliY,
winX, winY: INTEGER;
BEGIN
K.MousePos(mouseX, mouseY);
K.WinPos(winX, winY);
K.ClientPos(cliX, cliY);
x := mouseX - winX - cliX - LEFT;
y := mouseY - winY - cliY - TOP;
END mouse;
 
 
PROCEDURE getKBState;
VAR
kbState: SET;
BEGIN
kbState := K.GetControlKeys();
IF {0, 1} * kbState # {} THEN
INCL(shift, T.SHIFT)
ELSE
EXCL(shift, T.SHIFT)
END;
 
IF {2, 3} * kbState # {} THEN
INCL(shift, T.CTRL)
ELSE
EXCL(shift, T.CTRL)
END
END getKBState;
 
 
PROCEDURE OpenFile (VAR FileName: RW.tFileName; filter: ARRAY OF CHAR);
BEGIN
OpenDlg.SetFilter(OD, filter);
OpenDlg.Show(OD, 500, 400);
WHILE OD.status = 2 DO
K.Pause(30)
END;
IF OD.status = 1 THEN
COPY(OD.FilePath, FileName)
ELSE
FileName := ""
END
END OpenFile;
 
 
PROCEDURE error (s: RW.tFileName);
BEGIN
K.Run("/rd/1/@notify", s)
END error;
 
 
PROCEDURE saveAs;
VAR
fileName: RW.tFileName;
ext: ARRAY 8 OF CHAR;
BEGIN
OD._type := OpenDlg.tsave;
U.getFileName(text.fileName, OD.FileName, U.SLASH);
IF OD.FileName = "" THEN
OD.FileName := "NewFile.";
CASE text.lang OF
|Languages.langNone: ext := "txt"
|Languages.langC: ext := "c"
|Languages.langFasm: ext := "asm"
|Languages.langIni: ext := "ini"
|Languages.langLua: ext := "lua"
|Languages.langOberon: ext := "ob07"
|Languages.langPascal: ext := "pas"
END;
U.append8(OD.FileName, ext)
END;
OpenFile(fileName, EditFilter);
IF fileName # "" THEN
IF T.save(text, fileName, text.enc, RW.EOL_CRLF) THEN
T.setName(text, fileName)
ELSE
error("'cedit: error saving file' -E")
END
END
END saveAs;
 
 
PROCEDURE save;
BEGIN
IF text.modified THEN
IF text.fileName # "" THEN
IF ~T.save(text, text.fileName, text.enc, RW.EOL_CRLF) THEN
error("'cedit: error saving file' -E")
END
ELSE
saveAs
END
END
END save;
 
 
PROCEDURE SelfRun (file: ARRAY OF CHAR);
BEGIN
K.Run(AppPath, file)
END SelfRun;
 
 
PROCEDURE open;
VAR
fileName: RW.tFileName;
BEGIN
OD._type := OpenDlg.topen;
OpenFile(fileName, EditFilter);
IF fileName # "" THEN
SelfRun(fileName)
END
END open;
 
 
PROCEDURE Confirm;
CONST
width = btnWidth*2 + 30;
height = btnHeight*2 + 20;
lineColor = 808080H;
VAR
left, top, right, bottom: INTEGER;
BEGIN
draw_window;
confirm := TRUE;
left := (canvas.width - width) DIV 2 + LEFT;
top := (canvas.height - height) DIV 2 + TOP;
right := left + width - 1;
bottom := top + height - 1;
K.DrawRect(left, top, width, height, winColor);
Rect(left, top, right, bottom, lineColor);
K.DrawText866(left + (width - 10*fontWidth) DIV 2, top + 10, 0, "save file?");
K.CreateButton(btnYes, left + 10, top + 35, btnWidth, btnHeight, btnColor, "yes");
K.CreateButton(btnNo, left + 20 + btnWidth, top + 35, btnWidth, btnHeight, btnColor, "no");
END Confirm;
 
 
PROCEDURE createEdit (left, top: INTEGER): box_lib.edit_box;
VAR
edit, EditBox0: box_lib.edit_box;
BEGIN
NEW(EditBox0);
EditBox0.text := K.malloc(EDITBOX_MAXCHARS + 2);
ASSERT(EditBox0.text # 0);
edit := box_lib.kolibri_new_edit_box(left, top, EditBox_Width, EDITBOX_MAXCHARS, EditBox0);
edit.flags := 4002H;
edit.text_color := 30000000H;
EditBox_SetFocus(edit, FALSE)
RETURN edit
END createEdit;
 
 
PROCEDURE createSearchForm;
BEGIN
FindEdit := createEdit(searchLeft, TOP + 20);
ReplaceEdit := createEdit(searchLeft, TOP + 20 + 55);
GotoEdit := createEdit(searchLeft, TOP + 20 + 330);
GotoEdit.flags := ORD(BITS(GotoEdit.flags) + BITS(8000H));
BKW := box_lib.kolibri_new_check_box(searchLeft, TOP + 90 + 20, 16, 16, "", 8*fontWidth + 4);
CS := box_lib.kolibri_new_check_box(searchLeft, TOP + 120 + 20, 16, 16, "", 10*fontWidth + 4);
WH := box_lib.kolibri_new_check_box(searchLeft, TOP + 150 + 20, 16, 16, "", 10*fontWidth + 4);
END createSearchForm;
 
 
PROCEDURE EditBox_GetValue (edit: box_lib.edit_box; VAR s: ARRAY OF WCHAR);
VAR
str: ARRAY EDITBOX_MAXCHARS + 1 OF CHAR;
i: INTEGER;
BEGIN
box_lib.edit_box_get_value(edit, str);
i := 0;
WHILE str[i] # 0X DO
s[i] := WCHR(E.cp866[ORD(str[i])]);
INC(i)
END;
s[i] := 0X
END EditBox_GetValue;
 
 
PROCEDURE Search;
BEGIN
search := ~search;
IF search THEN
LEFT := searchLeft + EditBox_Width + SEARCH_PADDING*3;
IF T.search(text, searchText, cs, whole) THEN END
ELSE
LEFT := searchLeft;
IF T.search(text, "", FALSE, FALSE) THEN END
END;
EditBox_SetFocus(FindEdit, search);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE);
resize;
draw_window
END Search;
 
 
PROCEDURE click (x, y: INTEGER): INTEGER;
VAR
scrollX, scrollY: INTEGER;
BEGIN
IF (0 <= x) & (x < canvas.width) & (0 <= y) & (y < canvas.height) THEN
leftButton := TRUE;
EditBox_SetFocus(FindEdit, FALSE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE);
IF ~(T.SHIFT IN shift) THEN
T.resetSelect(text)
END;
T.mouse(text, x, y);
repaint
ELSIF (canvas.width < x) & (x < canvas.width + scrollWidth) & (scrollWidth < y) & (y < canvas.height - scrollWidth) THEN
VScroll := TRUE;
DEC(x, canvas.width);
DEC(y, scrollWidth);
Scroll.mouse(vScroll, x, y);
T.getScroll(text, scrollX, scrollY);
T.scroll(text, 0, vScroll.value - scrollY);
repaint
ELSIF (scrollWidth < x) & (x < canvas.width - scrollWidth) & (canvas.height < y) & (y < canvas.height + scrollWidth) THEN
HScroll := TRUE;
DEC(x, scrollWidth);
DEC(y, canvas.height);
Scroll.mouse(hScroll, x, y);
T.getScroll(text, scrollX, scrollY);
T.scroll(text, hScroll.value - scrollX, 0);
repaint
END
RETURN K.GetTickCount()
END click;
 
 
PROCEDURE LeftButtonUp;
BEGIN
leftButton := FALSE;
VScroll := FALSE;
HScroll := FALSE;
Scroll.MouseUp(vScroll);
Scroll.MouseUp(hScroll);
END LeftButtonUp;
 
 
PROCEDURE close;
BEGIN
IF text.modified THEN
Confirm
ELSE
K.Exit
END
END close;
 
 
PROCEDURE MenuItemClick (menu: Menu.tMenu; id: INTEGER);
BEGIN
K.SendIPC(mainTID, id)
END MenuItemClick;
 
 
PROCEDURE goto;
VAR
gotoVal: INTEGER;
BEGIN
EditBox_GetValue(GotoEdit, gotoText);
IF U.str2int(gotoText, gotoVal) & T.goto(text, gotoVal) THEN END
END goto;
 
 
PROCEDURE Script (script: ARRAY OF CHAR);
BEGIN
IF script # "" THEN
K.Run("/rd/1/@open", script)
END
END Script;
 
 
PROCEDURE receiveIPC;
BEGIN
IF IPC[0] # Menu.lastTID THEN
IPC[2] := 0
END;
CASE IPC[2] OF
|0:
|menuCut: T.key(text, ORD("X"), {T.CTRL})
|menuCopy: T.key(text, ORD("C"), {T.CTRL})
|menuPaste: T.key(text, ORD("V"), {T.CTRL})
|menuDelete: T.key(text, 46, {})
|menuSelectAll: T.key(text, ORD("A"), {T.CTRL})
 
|menuNew:
SelfRun("")
|menuOpen:
open
|menuSave:
save;
repaint
|menuSaveAs:
saveAs;
repaint
|menuFolder:
K.Run("/rd/1/File Managers/Eolite", text.fileName)
|menuExit:
close
|menuUndo:
T.undo(text);
repaint
|menuRedo:
T.redo(text);
repaint
|menuSearch:
IF ~search THEN
Search
END;
EditBox_SetFocus(FindEdit, TRUE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE)
|menuGoto:
IF ~search THEN
Search
END;
EditBox_SetFocus(GotoEdit, TRUE);
EditBox_SetFocus(FindEdit, FALSE);
EditBox_SetFocus(ReplaceEdit, FALSE)
|menuNumbers:
T.toggleNumbers(text)
|menuNone:
T.setLang(text, Languages.langNone)
|menuC:
T.setLang(text, Languages.langC)
|menuFasm:
T.setLang(text, Languages.langFasm)
|menuIni:
T.setLang(text, Languages.langIni)
|menuLua:
T.setLang(text, Languages.langLua)
|menuOberon:
T.setLang(text, Languages.langOberon)
|menuPascal:
T.setLang(text, Languages.langPascal)
|menuBuild:
Script(buildScript)
|menuBuildScript:
OpenFile(buildScript, ShellFilter)
|menuRun:
Script(runScript)
|menuRunScript:
OpenFile(runScript, ShellFilter)
|menuDebug:
Script(debugScript)
|menuDebugScript:
OpenFile(debugScript, ShellFilter)
|menuUTF8BOM:
text.enc := E.UTF8BOM
|menuUTF8:
text.enc := E.UTF8
|menuCP866:
text.enc := E.CP866
|menuWin1251:
text.enc := E.W1251
|menuPipet:
K.Run("/rd/1/develop/pipet", "")
|menuSysFunc:
K.Run("/rd/1/docpack", "f")
|menuColors..menuMaxColors:
Ini.selectSection(IPC[2] - menuColors)
END;
IPC[0] := 0;
IPC[1] := 0
END receiveIPC;
 
 
PROCEDURE MenuKeyDown (menu: Menu.tMenu; key: INTEGER): BOOLEAN;
VAR
menuItem: INTEGER;
BEGIN
menuItem := -1;
getKBState;
IF (T.CTRL IN shift) THEN
CASE key DIV 65536 OF
|21: menuItem := menuRedo
|30: menuItem := menuSelectAll
|33: menuItem := menuSearch
|34: menuItem := menuGoto
|44: menuItem := menuUndo
|45: menuItem := menuCut
|46: menuItem := menuCopy
|47: menuItem := menuPaste
|24: menuItem := menuOpen
|31: menuItem := menuSave
|49: menuItem := menuNew
|67: menuItem := menuBuild
ELSE
END
ELSE
IF key DIV 65536 = 83 THEN
menuItem := menuDelete
ELSIF key DIV 65536 = 67 THEN
menuItem := menuRun
END
END;
IF menuItem # -1 THEN
IF Menu.isEnabled(menu, menuItem) THEN
MenuItemClick(menu, menuItem)
ELSE
menuItem := -1
END
END
RETURN menuItem # -1
END MenuKeyDown;
 
 
PROCEDURE CreateContextMenu (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuUndo, "undo ctrl-Z");
Menu.AddMenuItem(menu, menuRedo, "redo ctrl-Y");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuCut, "cut ctrl-X");
Menu.AddMenuItem(menu, menuCopy, "copy ctrl-C");
Menu.AddMenuItem(menu, menuPaste, "paste ctrl-V");
Menu.AddMenuItem(menu, menuDelete, "delete");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuSelectAll, "select all ctrl-A");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateContextMenu;
 
 
PROCEDURE CreateMenuFile (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuNew, "new ctrl-N");
Menu.AddMenuItem(menu, menuOpen, "open ctrl-O");
Menu.AddMenuItem(menu, menuSave, "save ctrl-S");
Menu.AddMenuItem(menu, menuSaveAs, "save as");
Menu.AddMenuItem(menu, menuFolder, "folder");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuExit, "exit");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuFile;
 
 
PROCEDURE CreateMenuEdit (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuUndo, "undo ctrl-Z");
Menu.AddMenuItem(menu, menuRedo, "redo ctrl-Y");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuSearch, "search ctrl-F");
Menu.AddMenuItem(menu, menuGoto, "go to line ctrl-G");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuCut, "cut ctrl-X");
Menu.AddMenuItem(menu, menuCopy, "copy ctrl-C");
Menu.AddMenuItem(menu, menuPaste, "paste ctrl-V");
Menu.AddMenuItem(menu, menuDelete, "delete");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuSelectAll, "select all ctrl-A");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuEdit;
 
 
PROCEDURE CreateMenuEncoding (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuUTF8BOM, "UTF-8-BOM");
Menu.AddMenuItem(menu, menuUTF8, "UTF-8");
Menu.AddMenuItem(menu, menuCP866, "CP866");
Menu.AddMenuItem(menu, menuWin1251, "Windows-1251");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuEncoding;
 
 
PROCEDURE CreateMenuView (): Menu.tMenu;
VAR
menu: List.tList;
colors: Ini.tSection;
idx: INTEGER;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuNumbers, "line numbers");
Menu.delimiter(menu);
(*Menu.AddMenuItem(menu, menuSettings, "settings");*)
 
colors := Ini.sections.first(Ini.tSection);
idx := menuColors;
WHILE colors # NIL DO
Menu.AddMenuItem(menu, idx, colors.name);
INC(idx);
colors := colors.next(Ini.tSection)
END;
 
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuView;
 
 
PROCEDURE CreateMenuSyntax (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuC, "C");
Menu.AddMenuItem(menu, menuFasm, "Fasm");
Menu.AddMenuItem(menu, menuIni, "Ini");
Menu.AddMenuItem(menu, menuLua, "Lua");
Menu.AddMenuItem(menu, menuOberon, "Oberon");
Menu.AddMenuItem(menu, menuPascal, "Pascal");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuNone, "none");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuSyntax;
 
 
PROCEDURE CreateMenuProgram (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuBuild, "build ctrl+F9");
Menu.AddMenuItem(menu, menuBuildScript, "script");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuRun, "run F9");
Menu.AddMenuItem(menu, menuRunScript, "script");
Menu.delimiter(menu);
Menu.AddMenuItem(menu, menuDebug, "debug");
Menu.AddMenuItem(menu, menuDebugScript, "script");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuProgram;
 
 
PROCEDURE CreateMenuTools (): Menu.tMenu;
VAR
menu: List.tList;
BEGIN
menu := List.create(NIL);
Menu.AddMenuItem(menu, menuPipet, "pipet");
Menu.AddMenuItem(menu, menuSysFunc, "system functions");
RETURN Menu.create(menu, MenuItemClick, MenuKeyDown)
END CreateMenuTools;
 
 
PROCEDURE CanvasToScreen (VAR x, y: INTEGER);
VAR
cliX, cliY,
winX, winY: INTEGER;
BEGIN
K.WinPos(winX, winY);
K.ClientPos(cliX, cliY);
x := x + winX + cliX + LEFT;
y := y + winY + cliY + TOP;
END CanvasToScreen;
 
 
PROCEDURE ShowMenu (menu: Menu.tMenu);
VAR
winX, winY, cliX, cliY, x, y, i: INTEGER;
selected: BOOLEAN;
BEGIN
IF menu # context THEN
K.WinPos(winX, winY);
K.ClientPos(cliX, cliY);
x := winX + cliX;
y := MainMenuHeight + winY + cliY
ELSE
mouse(x, y);
IF ~((0 <= x) & (x < canvas.width) & (0 <= y) & (y < canvas.height)) THEN
menu := NIL
END
END;
 
IF menu = menuFile THEN
Menu.setEnabled(menu, menuSave, text.modified);
Menu.setEnabled(menu, menuFolder, text.fileName # "");
INC(x, menuFileX)
ELSIF (menu = menuEdit) OR (menu = context) THEN
Menu.setEnabled(menu, menuUndo, ~ChangeLog.isFirstGuard(text.edition));
Menu.setEnabled(menu, menuRedo, ~ChangeLog.isLastGuard(text.edition));
selected := T.selected(text);
Menu.setEnabled(menu, menuCut, selected);
Menu.setEnabled(menu, menuCopy, selected);
Menu.setEnabled(menu, menuDelete, selected);
Menu.setEnabled(menu, menuPaste, CB.available());
IF menu = menuEdit THEN
INC(x, menuEditX)
ELSE
IF y + menu.height >= canvas.height THEN
DEC(y, menu.height)
END;
IF x + menu.width >= canvas.width THEN
DEC(x, menu.width)
END;
CanvasToScreen(x, y)
END
ELSIF menu = menuEncoding THEN
Menu.setCheck(menu, menuUTF8BOM, ORD(text.enc = E.UTF8BOM)*2);
Menu.setCheck(menu, menuUTF8, ORD(text.enc = E.UTF8)*2);
Menu.setCheck(menu, menuCP866, ORD(text.enc = E.CP866)*2);
Menu.setCheck(menu, menuWin1251, ORD(text.enc = E.W1251)*2);
INC(x, menuEncodingX)
ELSIF menu = menuView THEN
(*Menu.setEnabled(menu, menuSettings, FALSE);*)
Menu.setCheck(menu, menuNumbers, ORD(text.numbers));
FOR i := 0 TO Ini.sections.count - 1 DO
Menu.setCheck(menu, menuColors + i, ORD(Ini.curSectionNum = i)*2)
END;
INC(x, menuViewX)
ELSIF menu = menuSyntax THEN
Menu.setCheck(menu, menuNone, ORD(text.lang = Languages.langNone)*2);
Menu.setCheck(menu, menuC, ORD(text.lang = Languages.langC)*2);
Menu.setCheck(menu, menuFasm, ORD(text.lang = Languages.langFasm)*2);
Menu.setCheck(menu, menuIni, ORD(text.lang = Languages.langIni)*2);
Menu.setCheck(menu, menuLua, ORD(text.lang = Languages.langLua)*2);
Menu.setCheck(menu, menuOberon, ORD(text.lang = Languages.langOberon)*2);
Menu.setCheck(menu, menuPascal, ORD(text.lang = Languages.langPascal)*2);
INC(x, menuSyntaxX)
ELSIF menu = menuProgram THEN
Menu.setEnabled(menu, menuBuild, buildScript # "");
Menu.setEnabled(menu, menuDebug, debugScript # "");
Menu.setEnabled(menu, menuRun, runScript # "");
INC(x, menuProgramX)
ELSIF menu = menuTools THEN
INC(x, menuToolsX)
END;
 
IF menu # NIL THEN
IF Menu.opened(menu) THEN
Menu.close(menu)
END;
Menu.open(menu, x, y)
END
END ShowMenu;
 
 
PROCEDURE main;
VAR
width, height, x, y, scrollX, scrollY: INTEGER;
key: INTEGER;
msState: SET;
scroll: INTEGER;
err: INTEGER;
fileName, filePath: RW.tFileName;
resized: BOOLEAN;
firstClickX, firstClickY, time: INTEGER;
BEGIN
modified := FALSE;
mainTID := K.ThreadID();
K.SetIPC(IPC);
U.ptr2str(K.GetName(), AppPath);
U.getPath(AppPath, fileName);
U.append8(fileName, "/Icons16.png");
icons := LibImg.LoadFromFile(fileName, 16, y);
grayIcons := LibImg.LoadFromFile(fileName, 16, y);
gray(grayIcons);
iconsBackColor(icons);
iconsBackColor(grayIcons);
Ini.load(AppPath);
K.SetEventsMask({0, 1, 2, 5, 6, 31});
LeftButtonUp;
resized := FALSE;
shift := {};
winWidth := minWinWidth;
winHeight := minWinHeight;
LEFT := 10;
canvas := G.CreateCanvas(winWidth - (LEFT + RIGHT + 10), winHeight - (TOP + BOTTOM + 4) - K.SkinHeight());
font := G.CreateFont(1, "", {});
G.SetFont(canvas, font);
T.init(NIL);
T.setCanvas(canvas);
U.ptr2str(K.GetCommandLine(), fileName);
context := CreateContextMenu();
menuFile := CreateMenuFile();
menuEdit := CreateMenuEdit();
menuEncoding := CreateMenuEncoding();
menuView := CreateMenuView();
menuSyntax := CreateMenuSyntax();
menuProgram := CreateMenuProgram();
menuTools := CreateMenuTools();
IF fileName = "" THEN
text := T.New();
filePath := "/rd/1"
ELSE
text := T.open(fileName, err);
IF text = NIL THEN
error("'cedit: error opening file' -E");
K.Exit
ELSE
U.getPath(fileName, filePath)
END
END;
OD := OpenDlg.Create(draw_window, OpenDlg.topen, filePath, "");
 
vScroll := Scroll.create(scrollWidth, canvas.height - scrollWidth*2 + 1, 0A0A0A0H, winColor);
hScroll := Scroll.create(canvas.width - scrollWidth*2, scrollWidth, 0A0A0A0H, winColor);
T.resize(canvas.width, canvas.height);
T.SetPos(text, 0, 0);
confirm := FALSE;
notFound := FALSE;
search := FALSE;
createSearchForm;
new_searchText := "";
searchText := "";
cs := FALSE;
whole := FALSE;
replaced := 0;
draw_window;
repaint;
buildScript := "";
runScript := "";
debugScript := "";
WHILE TRUE DO
CASE K.WaitForEvent() OF
|1:
IF ~K.RolledUp() THEN
K.WinSize(width, height);
IF (width # winWidth) OR (height # winHeight) THEN
resize;
resized := TRUE
END;
K.SetEventsMask({0, 1, 2, 5, 6, 31})
ELSE
K.SetEventsMask({0, 30, 31})
END;
draw_window
|2:
key := K.GetKey();
getKBState;
IF key DIV 65536 = 61 THEN (* F3 *)
key := -1;
IF search & (searchText # "") THEN
notFound := ~T.findNext(text, box_lib.check_box_get_value(BKW))
END
ELSIF key DIV 65536 = 67 THEN (* F9 *)
key := -1;
IF T.CTRL IN shift THEN
Script(buildScript)
ELSE
Script(runScript)
END
ELSIF (key DIV 65536 = 55) & (key DIV 256 MOD 256 = 52) THEN
key := -1 (* PrtScn *)
ELSIF (T.CTRL IN shift) & (key DIV 65536 = 33) THEN
key := -1;
IF ~search THEN
Search
END;
EditBox_SetFocus(FindEdit, TRUE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE);
ELSIF (T.CTRL IN shift) & (key DIV 65536 = 34) THEN
key := -1;
IF ~search THEN
Search
END;
EditBox_SetFocus(GotoEdit, TRUE);
EditBox_SetFocus(FindEdit, FALSE);
EditBox_SetFocus(ReplaceEdit, FALSE)
END;
IF (key # -1) & EditBox_Focus(FindEdit) THEN
box_lib.edit_box_key(FindEdit, key);
EditBox_GetValue(FindEdit, new_searchText);
IF new_searchText # searchText THEN
searchText := new_searchText;
notFound := ~T.search(text, searchText, cs, whole)
END
ELSIF (key # -1) & EditBox_Focus(ReplaceEdit) THEN
box_lib.edit_box_key(ReplaceEdit, key);
EditBox_GetValue(ReplaceEdit, replaceText)
ELSIF (key # -1) & EditBox_Focus(GotoEdit) THEN
IF (key DIV 256) MOD 256 = 13 THEN
goto
ELSE
box_lib.edit_box_key(GotoEdit, key)
END
ELSIF key # -1 THEN
CASE key DIV 65536 OF
|73: key := 33
|81: key := 34
|71: key := 36
|79: key := 35
|72: key := 38
|80: key := 40
|75: key := 37
|77: key := 39
|82: key := -1 (* insert *)
|83: key := 46
|59, 60, 62..66, 68, 87, 88: key := -1 (* F1, F2, F4..F8, F10, F11, F12 *)
ELSE
IF (T.CTRL IN shift) THEN
CASE key DIV 65536 OF
|21: T.redo(text);
key := -1
|22: key := ORD("U")
|24: key := -1;
open
|30: key := ORD("A")
|31: key := -1;
save
|38: key := ORD("L")
|44: T.undo(text);
key := -1
|45: key := ORD("X")
|46: key := ORD("C")
|47: key := ORD("V")
|49: key := -1;
SelfRun("")
ELSE
key := -1
END
ELSE
T.input(text, E.cp866[key DIV 256 MOD 256]);
key := -1
END
END;
IF key # -1 THEN
T.key(text, key, shift)
END
END;
repaint
|3:
CASE K.ButtonCode() OF
|0:
 
|btnFile:
ShowMenu(menuFile)
|btnEdit:
ShowMenu(menuEdit)
|btnEncoding:
ShowMenu(menuEncoding)
|btnView:
ShowMenu(menuView)
|btnSyntax:
ShowMenu(menuSyntax)
|btnProgram:
ShowMenu(menuProgram)
|btnTools:
ShowMenu(menuTools)
|btnNo:
K.Exit
|btnYes:
save;
IF ~text.modified THEN
K.Exit
END;
repaint
|btnClose:
close
|btnNew:
SelfRun("")
|btnOpen:
open
|btnSave:
save;
repaint
|btnSearch:
IF ~search THEN
Search
END
|btnCloseFind:
Search
|btnUndo:
T.undo(text);
repaint
|btnRedo:
T.redo(text);
repaint
|btnUpper:
T.chCase(text, TRUE);
repaint
|btnLower:
T.chCase(text, FALSE);
repaint
|btnBuild:
Script(buildScript)
|btnRun:
Script(runScript)
|btnUp:
T.scroll(text, 0, -1);
repaint
|btnDown:
T.scroll(text, 0, 1);
repaint
|btnLeft:
T.scroll(text, -1, 0);
repaint
|btnRight:
T.scroll(text, 1, 0);
repaint
|btnFindEdit:
EditBox_SetFocus(FindEdit, TRUE);
EditBox_SetFocus(ReplaceEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE)
|btnReplaceEdit:
EditBox_SetFocus(ReplaceEdit, TRUE);
EditBox_SetFocus(FindEdit, FALSE);
EditBox_SetFocus(GotoEdit, FALSE)
|btnGotoEdit:
EditBox_SetFocus(GotoEdit, TRUE);
EditBox_SetFocus(FindEdit, FALSE);
EditBox_SetFocus(ReplaceEdit, FALSE)
|btnFindNext:
IF searchText # "" THEN
notFound := ~T.findNext(text, box_lib.check_box_get_value(BKW));
repaint
END
|btnReplace:
T.replace(text, replaceText, LENGTH(searchText));
repaint
|btnReplaceAll:
notFound := ~T.search(text, searchText, cs, whole);
IF ~notFound THEN
replaced := T.replaceAll(text, replaceText, LENGTH(searchText));
END;
repaint
|btnGoto:
goto;
repaint
END
|6:
Menu.close(menuFile);
Menu.close(menuEdit);
Menu.close(menuEncoding);
Menu.close(menuView);
Menu.close(menuSyntax);
Menu.close(menuProgram);
Menu.close(menuTools);
Menu.close(context);
IF ~resized THEN
getKBState;
msState := K.MouseState();
IF ~(0 IN msState) OR (16 IN msState) THEN
LeftButtonUp
END;
scroll := K.Scroll();
IF scroll # 0 THEN
T.scroll(text, 0, scroll*3);
repaint
END;
IF leftButton THEN
IF K.GetTickCount() - time > 9 THEN
mouse(x, y);
T.mouse(text, x, y);
repaint
END
END;
IF VScroll THEN
mouse(x, y);
Scroll.mouse(vScroll, x, y - scrollWidth);
T.getScroll(text, scrollX, scrollY);
T.scroll(text, 0, vScroll.value - scrollY);
repaint
END;
IF HScroll THEN
mouse(x, y);
Scroll.mouse(hScroll, x - scrollWidth, y);
T.getScroll(text, scrollX, scrollY);
T.scroll(text, hScroll.value - scrollX, 0);
repaint
END;
IF (8 IN msState) & ~(24 IN msState) THEN
mouse(firstClickX, firstClickY);
time := click(firstClickX, firstClickY)
END;
IF 9 IN msState THEN
ShowMenu(context)
END;
IF 24 IN msState THEN
mouse(x, y);
IF (ABS(x - firstClickX) < 5) & (ABS(y - firstClickY) < 5) THEN
VScroll := FALSE;
HScroll := FALSE;
IF (0 <= x) & (x < canvas.width) & (0 <= y) & (y < canvas.height) THEN
leftButton := FALSE;
T.selectWord(text);
repaint
END
ELSE
firstClickX := x;
firstClickY := y;
time := click(firstClickX, firstClickY)
END
END
END;
IF search THEN
IF EditBox_Focus(FindEdit) THEN
box_lib.edit_box_mouse(FindEdit)
END;
IF EditBox_Focus(ReplaceEdit) THEN
box_lib.edit_box_mouse(ReplaceEdit)
END;
IF EditBox_Focus(GotoEdit) THEN
box_lib.edit_box_mouse(GotoEdit)
END;
box_lib.check_box_mouse2(CS);
box_lib.check_box_mouse2(WH);
box_lib.check_box_mouse2(BKW);
IF box_lib.check_box_get_value(CS) # cs THEN
cs := ~cs;
notFound := ~T.search(text, searchText, cs, whole);
repaint
END;
IF box_lib.check_box_get_value(WH) # whole THEN
whole := ~whole;
notFound := ~T.search(text, searchText, cs, whole);
repaint
END
END;
resized := FALSE
|7: receiveIPC
ELSE
END
END
END main;
 
 
BEGIN
main
END CEdit.
/programs/develop/cedit/SRC/ChangeLog.ob07
0,0 → 1,188
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE ChangeLog;
 
IMPORT List, Lines, (*API,*) SYSTEM;
 
TYPE
tIntItem = POINTER TO RECORD (List.tItem)
adr, val: INTEGER
END;
 
tBoolItem = POINTER TO RECORD (List.tItem)
adr: INTEGER; val: BOOLEAN
END;
(*
tUntypedPtr = POINTER TO RECORD (List.tItem)
p: INTEGER
END;
 
tTypedPtr = POINTER TO RECORD (List.tItem)
p: List.tItem
END;
*)
tGuard* = POINTER TO RECORD (List.tItem)
 
END;
 
 
VAR
Log*: List.tList;
guard: tGuard;
isLast: BOOLEAN;
 
 
PROCEDURE isLastGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
res: BOOLEAN;
BEGIN
IF guard # NIL THEN
item := Log.last;
WHILE ~(item IS tGuard) DO
item := item.prev
END;
res := guard = item
ELSE
res := TRUE
END
RETURN res
END isLastGuard;
 
 
PROCEDURE isFirstGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
BEGIN
ASSERT(guard # NIL);
item := Log.first;
WHILE ~(item IS tGuard) DO
item := item.next
END
RETURN guard = item
END isFirstGuard;
 
 
PROCEDURE setGuard* (_guard: tGuard);
BEGIN
guard := _guard;
isLast := isLastGuard(_guard)
END setGuard;
 
 
PROCEDURE redo* (item: List.tItem);
BEGIN
IF item IS tIntItem THEN
SYSTEM.PUT(item(tIntItem).adr, item(tIntItem).val)
ELSIF item IS tBoolItem THEN
SYSTEM.PUT(item(tBoolItem).adr, item(tBoolItem).val)
END
END redo;
 
 
PROCEDURE clear (guard: tGuard);
VAR
item: List.tItem;
(*res: INTEGER;*)
BEGIN
isLast := TRUE;
REPEAT
item := List.pop(Log);
IF item # guard THEN
(*
IF item IS tUntypedPtr THEN
res := API._DISPOSE(item(tUntypedPtr).p)
ELSIF item IS tTypedPtr THEN
DISPOSE(item(tTypedPtr).p)
END;*)
DISPOSE(item)
END
UNTIL item = guard;
List.append(Log, item)
END clear;
 
 
PROCEDURE changeWord (adrV, adrX: INTEGER);
VAR
item: tIntItem;
BEGIN
NEW(item);
item.adr := adrV;
SYSTEM.GET(adrX, item.val);
IF ~isLast THEN
clear(guard)
END;
List.append(Log, item)
END changeWord;
 
 
PROCEDURE changeBool (VAR v: BOOLEAN; x: BOOLEAN);
VAR
item: tBoolItem;
BEGIN
NEW(item);
item.adr := SYSTEM.ADR(v);
item.val := x;
IF ~isLast THEN
clear(guard)
END;
List.append(Log, item)
END changeBool;
 
 
PROCEDURE changeInt (VAR v: INTEGER; x: INTEGER);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changeInt;
 
 
PROCEDURE changePtr (VAR v: List.tItem; x: List.tItem);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changePtr;
 
(*
PROCEDURE typedPtr (p: List.tItem);
VAR
item: tTypedPtr;
BEGIN
NEW(item);
item.p := p;
List.append(Log, item)
END typedPtr;
 
 
PROCEDURE untypedPtr (p: INTEGER);
VAR
item: tUntypedPtr;
BEGIN
NEW(item);
item.p := p;
List.append(Log, item)
END untypedPtr;
*)
 
BEGIN
guard := NIL;
isLast := TRUE;
List.init(changeInt, changePtr);
Lines.init(changeInt, changePtr, changeBool(*, typedPtr, untypedPtr*));
Log := List.create(NIL)
END ChangeLog.
/programs/develop/cedit/SRC/Clipboard.ob07
0,0 → 1,169
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Clipboard;
 
IMPORT SYSTEM, K := KOSAPI, E := Encodings, Lines;
 
CONST
TTEXT = 0;
lenEOL* = 2;
 
TYPE
tBuffer* = POINTER TO RECORD
dataPtr*: INTEGER;
pos: INTEGER
END;
 
 
PROCEDURE free (ptr: INTEGER);
BEGIN
ptr := K.free(ptr)
END free;
 
 
PROCEDURE bufSize* (buffer: tBuffer): INTEGER;
RETURN buffer.pos - buffer.dataPtr
END bufSize;
 
 
PROCEDURE put* (buffer: tBuffer);
VAR
a, cnt, size: INTEGER;
ptr, pchar: INTEGER;
wch: WCHAR;
BEGIN
cnt := bufSize(buffer) DIV 2;
size := cnt + 12;
a := K.malloc(size);
ASSERT(a # 0);
SYSTEM.PUT32(a, size);
SYSTEM.PUT32(a + 4, TTEXT);
SYSTEM.PUT32(a + 8, 1);
pchar := a + 12;
ptr := buffer.dataPtr;
WHILE cnt > 0 DO
SYSTEM.GET(ptr, wch);
SYSTEM.PUT(pchar, CHR(E.UNI[ORD(wch), E.CP866] MOD 256));
INC(pchar);
INC(ptr, 2);
DEC(cnt)
END;
K.sysfunc2(54, 3);
K.sysfunc4(54, 2, size, a)
END put;
 
 
PROCEDURE create* (bufSize: INTEGER): tBuffer;
VAR
res: tBuffer;
BEGIN
NEW(res);
res.dataPtr := K.malloc(bufSize*SYSTEM.SIZE(WCHAR) + 4096);
ASSERT(res.dataPtr # 0);
res.pos := res.dataPtr
RETURN res
END create;
 
 
PROCEDURE destroy* (VAR buffer: tBuffer);
BEGIN
IF buffer # NIL THEN
IF buffer.dataPtr # 0 THEN
free(buffer.dataPtr)
END;
DISPOSE(buffer)
END
END destroy;
 
 
PROCEDURE append* (buffer: tBuffer; line: Lines.tLine; first, last: INTEGER);
VAR
strSize: INTEGER;
BEGIN
strSize := (last - first + 1)*SYSTEM.SIZE(WCHAR);
IF strSize > 0 THEN
SYSTEM.MOVE(Lines.getPChar(line, first), buffer.pos, strSize);
INC(buffer.pos, strSize)
END
END append;
 
 
PROCEDURE appends* (buffer: tBuffer; s: ARRAY OF WCHAR; first, last: INTEGER);
VAR
strSize: INTEGER;
BEGIN
strSize := (last - first + 1)*SYSTEM.SIZE(WCHAR);
IF strSize > 0 THEN
SYSTEM.MOVE(SYSTEM.ADR(s[first]), buffer.pos, strSize);
INC(buffer.pos, strSize)
END
END appends;
 
 
PROCEDURE eol* (buffer: tBuffer);
VAR
s: ARRAY 2 OF WCHAR;
BEGIN
s[0] := 0DX; s[1] := 0AX;
appends(buffer, s, 0, 1)
END eol;
 
 
PROCEDURE eot* (buffer: tBuffer);
END eot;
 
 
PROCEDURE available* (): BOOLEAN;
VAR
ptr: INTEGER;
n, size, typ, x: INTEGER;
res: BOOLEAN;
BEGIN
res := FALSE;
n := K.sysfunc2(54, 0);
IF n > 0 THEN
ptr := K.sysfunc3(54, 1, n - 1);
SYSTEM.GET32(ptr, size);
SYSTEM.GET32(ptr + 4, typ);
SYSTEM.GET(ptr + 8, x);
res := (typ = TTEXT) & (x = 1);
free(ptr)
END
RETURN res
END available;
 
 
PROCEDURE get* (VAR cnt: INTEGER): INTEGER;
VAR
ptr: INTEGER;
BEGIN
ptr := 0;
cnt := 0;
IF available() THEN
ptr := K.sysfunc3(54, 1, K.sysfunc2(54, 0) - 1);
SYSTEM.GET32(ptr, cnt);
DEC(cnt, 12);
INC(ptr, 12)
END
RETURN ptr
END get;
 
 
END Clipboard.
/programs/develop/cedit/SRC/Encodings.ob07
0,0 → 1,127
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Encodings;
 
CONST
CP866* = 0; W1251* = 1; UTF8* = 2; UTF8BOM* = 3; UTF16LE* = 4;
 
UNDEF* = -1;
 
TYPE
CP = ARRAY 256 OF INTEGER;
 
VAR
cpW1251*, cp866*: CP;
UNI*: ARRAY 65536, 2 OF INTEGER;
 
 
PROCEDURE InitCP (VAR cp: CP);
VAR
i: INTEGER;
BEGIN
FOR i := 0H TO 7FH DO
cp[i] := i
END
END InitCP;
 
 
PROCEDURE Init8 (VAR cp: CP; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER);
BEGIN
cp[n] := a; INC(n);
cp[n] := b; INC(n);
cp[n] := c; INC(n);
cp[n] := d; INC(n);
cp[n] := e; INC(n);
cp[n] := f; INC(n);
cp[n] := g; INC(n);
cp[n] := h; INC(n);
END Init8;
 
 
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, UNDEF, 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] := i
END;
InitCP(cp)
END InitW1251;
 
 
PROCEDURE InitCP866 (VAR cp: CP);
VAR
n, i: INTEGER;
BEGIN
FOR i := 0410H TO 043FH DO
cp[i - 0410H + 80H] := i
END;
FOR i := 0440H TO 044FH DO
cp[i - 0440H + 0E0H] := 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;
 
 
PROCEDURE setUNI;
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 65535 DO
UNI[i, CP866] := UNDEF;
UNI[i, W1251] := UNDEF;
END;
FOR i := 0 TO 255 DO
IF cpW1251[i] # UNDEF THEN
UNI[cpW1251[i], W1251] := i
END;
IF cp866[i] # UNDEF THEN
UNI[cp866[i], CP866] := i
END
END
END setUNI;
 
 
BEGIN
InitW1251(cpW1251);
InitCP866(cp866);
setUNI
END Encodings.
/programs/develop/cedit/SRC/File.ob07
0,0 → 1,330
(*
Copyright 2016, 2018, 2021 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 *)
06AH, 044H, (* push 68 *)
058H, (* pop eax *)
06AH, 01BH, (* push 27 *)
05BH, (* pop ebx *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *)
0CDH, 040H, (* int 64 *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
089H, 011H, (* mov dword [ecx], edx *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 8 *)
)
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 FileSize* (FName: ARRAY OF CHAR): INTEGER;
VAR
Info: rFD;
res: INTEGER;
BEGIN
IF GetFileInfo(FName, Info) THEN
res := Info.size
ELSE
res := -1
END
RETURN res
END FileSize;
 
 
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: F.pos := 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
F.pos := 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
F.pos := 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/develop/cedit/SRC/Graph.ob07
0,0 → 1,280
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Graph;
 
IMPORT SYSTEM, K := KOSAPI;
 
CONST
 
modeCOPY = 0;
modeNOT = 1;
modeXOR = 2;
 
TYPE
 
tFont* = POINTER TO RECORD
handle*: INTEGER;
height*: INTEGER;
width*: INTEGER;
size: INTEGER;
name*: ARRAY 256 OF WCHAR
END;
 
tCanvas* = POINTER TO RECORD
bitmap: INTEGER;
width*, height*: INTEGER;
color, backColor, textColor: INTEGER;
font*: tFont;
mode: INTEGER
END;
 
 
PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER);
BEGIN
K.sysfunc7(65, canvas.bitmap, canvas.width*65536 + canvas.height, x*65536 + y, 32, 0, 0);
END DrawCanvas;
 
 
PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.color := color
END SetColor;
 
 
PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.textColor := color
END SetTextColor;
 
 
PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.backColor := color
END SetBkColor;
 
 
PROCEDURE CreateFont* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;
VAR
font: tFont;
BEGIN
NEW(font);
font.size := MAX(MIN(height, 8), 1);
font.width := font.size*8;
font.height := font.size*16;
DEC(font.size);
font.name := name
RETURN font
END CreateFont;
 
 
PROCEDURE SetFont* (canvas: tCanvas; font: tFont);
BEGIN
canvas.font := font
END SetFont;
 
 
PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);
VAR
X1, X2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
X1 := MAX(MIN(x1, x2), 0);
X2 := MIN(MAX(x1, x2), canvas.width - 1);
IF (0 <= y) & (y < canvas.height) THEN
color := canvas.color;
ptr := canvas.bitmap + y*canvas.width*4 + X1*4;
FOR i := X1 TO X2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, 4)
END
END
END HLine;
 
 
PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);
VAR
Y1, Y2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
Y1 := MAX(MIN(y1, y2), 0);
Y2 := MIN(MAX(y1, y2), canvas.height - 1);
IF (0 <= x) & (x < canvas.width) THEN
color := canvas.color;
ptr := canvas.bitmap + Y1*canvas.width*4 + x*4;
FOR i := Y1 TO Y2 DO
IF canvas.mode = modeNOT THEN
SYSTEM.GET32(ptr, color);
color := ORD(-BITS(color)*{0..23})
ELSIF canvas.mode = modeXOR THEN
SYSTEM.GET32(ptr, color);
color := ORD((BITS(color)/BITS(canvas.color))*{0..23})
END;
SYSTEM.PUT32(ptr, color);
INC(ptr, canvas.width*4)
END
END
END VLine;
 
 
PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeNOT;
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END notVLine;
 
 
PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeXOR;
SetColor(canvas, 0FF0000H);
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END xorVLine;
 
 
PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);
VAR
ptr: INTEGER;
color: INTEGER;
d: INTEGER;
BEGIN
color := canvas.color;
ptr := canvas.bitmap + y*canvas.width*4 + x1*4;
IF k = -1 THEN
d := canvas.width*4 + 4
ELSIF k = 1 THEN
d := 4 - canvas.width*4
END;
WHILE x1 <= x2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, d);
INC(x1)
END
END DLine;
 
 
PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
VAR
y: INTEGER;
BEGIN
FOR y := top TO bottom DO
HLine(canvas, y, left, right)
END
END FillRect;
 
 
PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
BEGIN
HLine(canvas, top, left, right);
HLine(canvas, bottom, left, right);
VLine(canvas, left, top, bottom);
VLine(canvas, right, top, bottom)
END Rect;
 
 
PROCEDURE clear* (canvas: tCanvas);
VAR
ptr, ptr2, w, i: INTEGER;
BEGIN
HLine(canvas, 0, 0, canvas.width - 1);
w := canvas.width*4;
ptr := canvas.bitmap;
ptr2 := ptr;
i := canvas.height - 1;
WHILE i > 0 DO
INC(ptr2, w);
SYSTEM.MOVE(ptr, ptr2, w);
DEC(i)
END
END clear;
 
 
PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER);
CONST
WCHAR_SIZE = 2;
VAR
color, i: INTEGER;
BEGIN
IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN
IF x < 0 THEN
i := -(x DIV canvas.font.width);
INC(x, i*canvas.font.width);
DEC(n, i)
ELSE
i := 0
END;
IF n > 0 THEN
n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0);
color := canvas.color;
canvas.color := canvas.backColor;
FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height);
canvas.color := color;
(* WHILE n > 0 DO
K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, 1, canvas.bitmap - 8);
INC(x, canvas.font.width);
INC(i);
DEC(n)
END*)
K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, n, canvas.bitmap - 8)
END
END
END TextOut;
 
 
PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);
BEGIN
TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n)
END TextOut2;
 
 
PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;
VAR
canvas: tCanvas;
BEGIN
NEW(canvas);
canvas.bitmap := K.malloc(width*height*4 + 8);
ASSERT(canvas.bitmap # 0);
SYSTEM.PUT32(canvas.bitmap, width);
SYSTEM.PUT32(canvas.bitmap + 4, height);
INC(canvas.bitmap, 8);
canvas.width := width;
canvas.height := height;
canvas.mode := modeCOPY
RETURN canvas
END CreateCanvas;
 
 
PROCEDURE destroy* (VAR canvas: tCanvas);
BEGIN
IF canvas # NIL THEN
canvas.bitmap := K.free(canvas.bitmap);
DISPOSE(canvas)
END
END destroy;
 
 
END Graph.
/programs/develop/cedit/SRC/Ini.ob07
0,0 → 1,182
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Ini;
 
IMPORT
 
KOSAPI, SYSTEM, RW, Text, Utils, File, List, Languages;
 
 
CONST
 
fileName = "cedit.ini";
 
MAX_LEN = 32;
MAX_SECTIONS* = 10;
 
 
TYPE
 
tString = ARRAY 128 OF CHAR;
 
tSectionName = ARRAY MAX_LEN OF WCHAR;
tASCIISectionName = ARRAY MAX_LEN OF CHAR;
 
tSection* = POINTER TO RECORD (List.tItem)
name*: tSectionName
END;
 
 
VAR
 
get_color: PROCEDURE [stdcall] (f_name: RW.tFileName; sec_name: tASCIISectionName; key_name: tString; def_val: INTEGER): INTEGER;
get_str: PROCEDURE [stdcall] (f_name, sec_name, key_name, buffer, buf_len, def_val: INTEGER): INTEGER;
enum_sections: PROCEDURE [stdcall] (f_name: RW.tFileName; callback: INTEGER);
 
IniFileName: RW.tFileName;
sections*: List.tList;
 
curSection*: tASCIISectionName;
curSectionNum*: INTEGER;
 
 
PROCEDURE getColor (key: tString; def: INTEGER): INTEGER;
RETURN get_color(IniFileName, curSection, key, def)
END getColor;
 
 
PROCEDURE getStr* (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
BEGIN
IF get_str(SYSTEM.ADR(IniFileName[0]), SYSTEM.ADR(secName[0]), SYSTEM.ADR(keyName[0]), SYSTEM.ADR(s[0]), LEN(s) - 1, SYSTEM.SADR("")) = -1 THEN
s[0] := 0X
END
END getStr;
 
 
PROCEDURE [stdcall] section_callback (fileName, sectionName: RW.tFileName): INTEGER;
VAR
section: tSection;
name: tSectionName;
i: INTEGER;
BEGIN
IF sections.count < MAX_SECTIONS THEN
i := 0;
WHILE (i < MAX_LEN - 1) & (sectionName[i] # 0X) DO
name[i] := WCHR(ORD(sectionName[i]));
INC(i)
END;
name[i] := 0X
END;
IF Utils.streq(SYSTEM.ADR(name[0]), SYSTEM.WSADR("color_"), 6) THEN
Utils.reverse(name);
name[LENGTH(name) - 6] := 0X;
Utils.reverse(name);
NEW(section);
section.name := name;
List.append(sections, section)
END
RETURN 1
END section_callback;
 
 
PROCEDURE selectSection* (idx: INTEGER);
VAR
i: INTEGER;
item: List.tItem;
section: tSection;
 
text, back, seltext, selback, modified, saved, curline, numtext, numback,
comment, string, num, delim, key1, key2, key3: INTEGER;
BEGIN
IF (0 <= idx) & (idx < sections.count) THEN
curSectionNum := idx;
item := List.getItem(sections, idx);
section := item(tSection);
i := 0;
WHILE section.name[i] # 0X DO
curSection[i] := CHR(ORD(section.name[i]));
INC(i)
END;
curSection[i] := 0X;
Utils.reverse8(curSection);
Utils.append8(curSection, "_roloc");
Utils.reverse8(curSection)
ELSE
curSection := ""
END;
 
text := getColor("text", 0000000H);
back := getColor("back", 0FFFFFFH);
seltext := getColor("seltext", 0FFFFFFH);
selback := getColor("selback", 00000FFH);
modified := getColor("modified", 0E8E800H);
saved := getColor("saved", 000D000H);
curline := getColor("curline", 0FFFFC8H);
numtext := getColor("numtext", 0000000H);
numback := getColor("numback", 0E6E6E6H);
 
comment := getColor("comment", 0800080H);
string := getColor("string", 0008000H);
num := getColor("num", 0800000H);
delim := getColor("delim", 0000080H);
key1 := getColor("key1", 0000080H);
key2 := getColor("key2", 0008080H);
key3 := getColor("key3", 0008080H);
 
Text.setColors(text, back, seltext, selback, modified, saved, curline, numtext, numback,
comment, string, num, delim, key1, key2, key3, 808080H);
END selectSection;
 
 
PROCEDURE load* (path: RW.tFileName);
VAR
Lib: INTEGER;
 
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR
a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
SYSTEM.PUT(v, a)
END GetProc;
 
BEGIN
sections := List.create(NIL);
IF File.Exists("/rd/1/settings/cedit.ini") THEN
IniFileName := "/rd/1/settings/cedit.ini"
ELSE
Utils.getPath(path, IniFileName);
Utils.append8(IniFileName, Utils.SLASH);
Utils.append8(IniFileName, fileName);
END;
 
Lib := KOSAPI.LoadLib("/rd/1/Lib/Libini.obj");
GetProc(Lib, SYSTEM.ADR(get_color), "ini_get_color");
GetProc(Lib, SYSTEM.ADR(get_str), "ini_get_str");
GetProc(Lib, SYSTEM.ADR(enum_sections), "ini_enum_sections");
 
enum_sections(IniFileName, SYSTEM.ADR(section_callback));
Languages.init(getStr);
selectSection(0);
END load;
 
 
END Ini.
/programs/develop/cedit/SRC/KOSAPI.ob07
0,0 → 1,430
(*
BSD 2-Clause License
 
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
MODULE KOSAPI;
 
IMPORT SYSTEM;
 
 
TYPE
 
STRING = ARRAY 1024 OF CHAR;
 
 
VAR
 
DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
 
imp_error*: RECORD
 
proc*, lib*: STRING;
error*: INTEGER
 
END;
 
 
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 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;
VAR
imp, lib, exp, proc, res: INTEGER;
fail, done: BOOLEAN;
procname, libname: STRING;
 
BEGIN
SYSTEM.CODE(060H); (* pusha *)
fail := FALSE;
done := FALSE;
res := 0;
libname := "/rd/1/lib/";
REPEAT
SYSTEM.GET(import_table, imp);
IF imp # 0 THEN
SYSTEM.GET(import_table + 4, lib);
GetStr(lib, 10, libname);
exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
fail := exp = 0;
ELSE
done := TRUE
END;
IF fail THEN
done := TRUE;
imp_error.proc := "";
imp_error.lib := libname;
imp_error.error := 1
END;
IF (imp # 0) & ~fail THEN
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);
INC(imp, 4)
ELSE
imp_error.proc := procname;
imp_error.lib := libname;
imp_error.error := 2
END
END
UNTIL proc = 0;
init(exp);
INC(import_table, 8)
END
UNTIL done;
IF fail THEN
res := 1
END;
import_table := res;
SYSTEM.CODE(061H) (* popa *)
RETURN import_table
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*;
BEGIN
DLL_INIT := dll_Init;
imp_error.lib := "";
imp_error.proc := "";
imp_error.error := 0
END _init;
 
 
END KOSAPI.
/programs/develop/cedit/SRC/KolibriOS.ob07
0,0 → 1,301
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE KolibriOS;
 
IMPORT
KOSAPI, SYSTEM;
 
CONST
winColor* = 0EEEEEEH;
fontWidth* = 8;
fontHeight* = 16;
 
 
PROCEDURE GetCommandLine* (): INTEGER;
RETURN KOSAPI.GetCommandLine()
END GetCommandLine;
 
 
PROCEDURE GetName* (): INTEGER;
RETURN KOSAPI.GetName()
END GetName;
 
 
PROCEDURE CreateWindow* (x, y, w, h, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(htext[0]))
END CreateWindow;
 
 
PROCEDURE BeginDraw*;
BEGIN
KOSAPI.sysfunc2(12, 1)
END BeginDraw;
 
 
PROCEDURE EndDraw*;
BEGIN
KOSAPI.sysfunc2(12, 2)
END EndDraw;
 
 
PROCEDURE WaitForEvent* (): INTEGER;
RETURN KOSAPI.sysfunc1(10)
END WaitForEvent;
 
 
PROCEDURE ThreadInfo (offsa, offsb: INTEGER; VAR a, b: INTEGER);
VAR
buffer: ARRAY 1024 OF BYTE;
BEGIN
KOSAPI.sysfunc3(9, SYSTEM.ADR(buffer[0]), -1);
SYSTEM.GET32(SYSTEM.ADR(buffer[0]) + offsa, a);
SYSTEM.GET32(SYSTEM.ADR(buffer[0]) + offsb, b);
END ThreadInfo;
 
 
PROCEDURE WinSize* (VAR width, height: INTEGER);
BEGIN
ThreadInfo(42, 46, width, height)
END WinSize;
 
 
PROCEDURE WinPos* (VAR x, y: INTEGER);
BEGIN
ThreadInfo(34, 38, x, y)
END WinPos;
 
 
PROCEDURE ClientSize* (VAR width, height: INTEGER);
BEGIN
ThreadInfo(62, 66, width, height)
END ClientSize;
 
 
PROCEDURE ClientPos* (VAR x, y: INTEGER);
BEGIN
ThreadInfo(54, 58, x, y)
END ClientPos;
 
 
PROCEDURE ThreadID* (): INTEGER;
VAR
id: INTEGER;
BEGIN
ThreadInfo(30, 30, id, id)
RETURN id
END ThreadID;
 
 
PROCEDURE RolledUp* (): BOOLEAN;
VAR
buffer: ARRAY 1024 OF BYTE;
BEGIN
KOSAPI.sysfunc3(9, SYSTEM.ADR(buffer[0]), -1)
RETURN ODD(LSR(buffer[70], 2))
END RolledUp;
 
 
PROCEDURE SetWinSize* (width, height: INTEGER);
BEGIN
KOSAPI.sysfunc5(67, -1, -1, width, height)
END SetWinSize;
 
 
PROCEDURE DrawText* (x, y, color: INTEGER; text: ARRAY OF WCHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(0A0H, 24), SYSTEM.ADR(text[0]), 0, 0)
END DrawText;
 
 
PROCEDURE DrawText69* (x, y, color: INTEGER; text: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(080H, 24), SYSTEM.ADR(text[0]), 0, 0)
END DrawText69;
 
 
PROCEDURE DrawText866* (x, y, color: INTEGER; text: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(0D0H, 24), SYSTEM.ADR(text[0]), 0, winColor)
END DrawText866;
 
 
PROCEDURE MousePos* (VAR x, y: INTEGER);
VAR
res: INTEGER;
BEGIN
res := KOSAPI.sysfunc2(37, 0);
y := res MOD 65536;
x := res DIV 65536
END MousePos;
 
 
PROCEDURE CreateButton* (id, Left, Top, Width, Height, Color: INTEGER; Caption: ARRAY OF WCHAR);
VAR
x, y: INTEGER;
BEGIN
KOSAPI.sysfunc5(8, LSL(Left, 16) + Width, LSL(Top, 16) + Height, id, Color);
x := Left + (Width - fontWidth * LENGTH(Caption)) DIV 2;
y := Top + (Height - fontHeight) DIV 2 + 1;
DrawText(x, y, 0, Caption)
END CreateButton;
 
 
PROCEDURE DeleteButton* (id: INTEGER);
BEGIN
KOSAPI.sysfunc5(8, 0, 0, id + 80000000H, 0)
END DeleteButton;
 
 
PROCEDURE GetTickCount* (): INTEGER;
RETURN KOSAPI.sysfunc2(26, 9)
END GetTickCount;
 
 
PROCEDURE Pause* (time: INTEGER);
BEGIN
KOSAPI.sysfunc2(5, time)
END Pause;
 
 
PROCEDURE ButtonCode* (): INTEGER;
VAR
res: INTEGER;
BEGIN
res := KOSAPI.sysfunc1(17);
IF res MOD 256 = 0 THEN
res := LSR(res, 8)
ELSE
res := 0
END
RETURN res
END ButtonCode;
 
 
PROCEDURE Exit*;
BEGIN
KOSAPI.sysfunc1(-1)
END Exit;
 
 
PROCEDURE ExitID* (tid: INTEGER);
BEGIN
KOSAPI.sysfunc3(18, 18, tid)
END ExitID;
 
 
PROCEDURE CreateThread* (proc: INTEGER; stack: ARRAY OF INTEGER): INTEGER;
RETURN KOSAPI.sysfunc4(51, 1, proc, SYSTEM.ADR(stack[LEN(stack) - 2]))
END CreateThread;
 
 
PROCEDURE Run* (program, param: ARRAY OF CHAR);
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 := SYSTEM.ADR(param[0]);
info.rsrvd1 := 0;
info.rsrvd2 := 0;
COPY(program, info.fname);
KOSAPI.sysfunc2(70, SYSTEM.ADR(info))
END Run;
 
 
PROCEDURE DrawRect* (x, y, width, height, color: INTEGER);
BEGIN
KOSAPI.sysfunc4(13, x*65536 + width, y*65536 + height, color)
END DrawRect;
 
 
PROCEDURE DrawLine* (x1, y1, x2, y2: INTEGER; color: INTEGER);
BEGIN
KOSAPI.sysfunc4(38, x1*65536 + x2, y1*65536 + y2, color)
END DrawLine;
 
 
PROCEDURE DrawImage* (data, sizeX, sizeY, x, y: INTEGER);
BEGIN
KOSAPI.sysfunc4(7, data, sizeX*65536 + sizeY, x*65536 + y)
END DrawImage;
 
 
PROCEDURE SetEventsMask* (mask: SET);
BEGIN
KOSAPI.sysfunc2(40, ORD(mask))
END SetEventsMask;
 
 
PROCEDURE SkinHeight* (): INTEGER;
RETURN KOSAPI.sysfunc2(48, 4)
END SkinHeight;
 
 
PROCEDURE GetKey* (): INTEGER;
RETURN KOSAPI.sysfunc1(2)
END GetKey;
 
 
PROCEDURE MouseState* (): SET;
RETURN BITS(KOSAPI.sysfunc2(37, 3))
END MouseState;
 
 
PROCEDURE Scroll* (): INTEGER;
RETURN ASR(LSL(KOSAPI.sysfunc2(37, 7), 16), 16)
END Scroll;
 
 
PROCEDURE GetControlKeys* (): SET;
RETURN BITS(KOSAPI.sysfunc2(66, 3))
END GetControlKeys;
 
 
PROCEDURE malloc* (size: INTEGER): INTEGER;
RETURN KOSAPI.malloc(size)
END malloc;
 
 
PROCEDURE SetIPC* (buffer: ARRAY OF INTEGER);
BEGIN
KOSAPI.sysfunc4(60, 1, SYSTEM.ADR(buffer[0]), LEN(buffer)*SYSTEM.SIZE(INTEGER));
END SetIPC;
 
 
PROCEDURE SendIPC* (tid, msg: INTEGER);
BEGIN
KOSAPI.sysfunc5(60, 2, tid, SYSTEM.ADR(msg), SYSTEM.SIZE(INTEGER))
END SendIPC;
 
 
END KolibriOS.
/programs/develop/cedit/SRC/Languages.ob07
0,0 → 1,379
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Languages;
 
IMPORT Lines;
 
 
CONST
 
langNone* = 0; langC* = 1; langOberon* = 2; langPascal* = 3;
langFasm* = 4; langLua* = 5; langIni* = 6;
 
TYPE
 
tLine = Lines.tLine;
 
tKeyWords = RECORD
words: ARRAY 200, 32 OF WCHAR; cnt: INTEGER
END;
 
procGetStr = PROCEDURE (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
 
 
VAR
 
oberonKW, cKW, pascalKW, luaKW, iniKW, fasmKW: ARRAY 3 OF tKeyWords;
 
 
PROCEDURE checkKW (s: ARRAY OF WCHAR; KW: tKeyWords): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := KW.cnt - 1;
WHILE (i >= 0) & (s # KW.words[i]) DO
DEC(i)
END
RETURN i >= 0
END checkKW;
 
 
PROCEDURE isKey* (s: ARRAY OF WCHAR; lang, kwSet: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := FALSE;
CASE lang OF
|langC: res := checkKW(s, cKW[kwSet - 1])
|langOberon: res := checkKW(s, oberonKW[kwSet - 1])
|langPascal: res := checkKW(s, pascalKW[kwSet - 1])
|langLua: res := checkKW(s, luaKW[kwSet - 1])
|langIni: res := checkKW(s, iniKW[kwSet - 1])
|langFasm: res := checkKW(s, fasmKW[kwSet - 1])
END
RETURN res
END isKey;
 
 
PROCEDURE SkipString* (line: tLine; VAR pos: INTEGER; n: INTEGER);
VAR
quot: WCHAR;
BEGIN
quot := Lines.getChar(line, pos);
REPEAT
INC(pos)
UNTIL (pos > n) OR (Lines.getChar(line, pos) = quot)
END SkipString;
 
 
PROCEDURE C (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "/" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
pos := n
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 1;
cond := 0
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth = 1 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = "/") & (cond = 1) THEN
cond := 0;
depth := 0
ELSE
cond := 0
END
END
END C;
 
 
PROCEDURE getChar (line: tLine; i: INTEGER): WCHAR;
VAR
res: WCHAR;
BEGIN
IF i >= line.length THEN
res := 0X
ELSE
res := Lines.getChar(line, i)
END
RETURN res
END getChar;
 
 
PROCEDURE LuaLong* (line: tLine; pos: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := -1;
IF getChar(line, pos) = "[" THEN
INC(pos);
WHILE getChar(line, pos) = "=" DO
INC(res);
INC(pos)
END;
IF getChar(line, pos) = "[" THEN
INC(res)
ELSE
res := -1
END
END
RETURN res
END LuaLong;
 
 
PROCEDURE Lua (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
k: INTEGER;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "-" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
k := LuaLong(line, pos + 1);
IF k >= 0 THEN
depth := k*2 + 1
ELSE
pos := n
END
END
ELSIF c = "[" THEN
cond := 0;
k := LuaLong(line, pos);
IF k >= 0 THEN
depth := (k + 1)*2
END
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth > 0 THEN
IF (cond = 0) & (c = "]") THEN
cond := 1
ELSIF (cond >= 1) & (c = "=") THEN
INC(cond)
ELSIF (cond >= 1) & (c = "]") & (cond*2 - depth MOD 2 = depth) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Lua;
 
 
PROCEDURE Pascal (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "(" THEN
cond := 1
ELSIF c = "/" THEN
IF cond = 2 THEN
cond := 0;
pos := n
ELSE
cond := 2
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 2;
cond := 0
ELSIF c = "'" THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "{" THEN
IF Lines.getChar(line, pos + 1) = "$" THEN
depth := 3
ELSE
depth := 1
END;
cond := 0
ELSE
cond := 0
END
ELSIF depth IN {1, 3} THEN
IF c = "}" THEN
depth := 0
END
ELSIF depth = 2 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = ")") & (cond = 1) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Pascal;
 
 
PROCEDURE Oberon (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF (depth = 0) & (c = "/") THEN
IF cond = 3 THEN
cond := 0;
pos := n
ELSE
cond := 3
END
ELSIF (depth = 0) & ((c = "'") OR (c = '"')) THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "(" THEN
cond := 1
ELSIF c = "*" THEN
IF cond = 1 THEN
INC(depth);
cond := 0
ELSE
cond := 2
END
ELSIF c = ")" THEN
IF cond = 2 THEN
IF depth > 0 THEN
DEC(depth)
END
END;
cond := 0
ELSE
cond := 0
END;
END Oberon;
 
 
PROCEDURE Ini (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
cond := 0;
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = ";" THEN
pos := n
ELSIF c = '"' THEN
SkipString(line, pos, n)
ELSIF c = "[" THEN
depth := 1
END
ELSIF depth = 1 THEN
IF c = "]" THEN
depth := 0
END
END
END Ini;
 
 
PROCEDURE comments* (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER; lang: INTEGER);
BEGIN
CASE lang OF
|langNone:
|langFasm:
|langC: C(line, depth, cond, pos, n)
|langOberon: Oberon(line, depth, cond, pos, n)
|langPascal: Pascal(line, depth, cond, pos, n)
|langLua: Lua(line, depth, cond, pos, n)
|langIni: Ini(line, depth, cond, pos, n)
END
END comments;
 
 
PROCEDURE EnterKW (s: ARRAY OF CHAR; VAR KW: tKeyWords);
CONST
SPACE = 20X; CR = 0DX; LF = 0AX; TAB = 9X; COMMA = ",";
VAR
i, j, k: INTEGER;
 
PROCEDURE delim (c: CHAR): BOOLEAN;
RETURN (c = COMMA) OR (c = SPACE) OR (c = CR) OR (c = LF) OR (c = TAB)
END delim;
 
BEGIN
k := KW.cnt;
i := 0;
REPEAT
j := 0;
WHILE (s[i] # 0X) & ~delim(s[i]) DO
KW.words[k, j] := WCHR(ORD(s[i]));
INC(i);
INC(j)
END;
KW.words[k, j] := 0X;
INC(k);
WHILE delim(s[i]) DO
INC(i)
END
UNTIL s[i] = 0X;
KW.cnt := k
END EnterKW;
 
 
PROCEDURE loadKW (VAR KW: ARRAY OF tKeyWords; getStr: procGetStr; lang: ARRAY OF CHAR);
VAR
s: ARRAY 16*1024 OF CHAR;
key: ARRAY 4 OF CHAR;
i: INTEGER;
BEGIN
key := "KW1";
FOR i := 0 TO 2 DO
KW[i].cnt := 0;
key[2] := CHR(ORD("1") + i);
getStr(lang, key, s);
EnterKW(s, KW[i])
END;
END loadKW;
 
 
PROCEDURE init* (getStr: procGetStr);
BEGIN
loadKW(oberonKW, getStr, "lang_Oberon");
loadKW(cKW, getStr, "lang_C");
loadKW(pascalKW, getStr, "lang_Pascal");
loadKW(luaKW, getStr, "lang_Lua");
loadKW(iniKW, getStr, "lang_Ini");
loadKW(fasmKW, getStr, "lang_Fasm");
END init;
 
 
END Languages.
/programs/develop/cedit/SRC/Lines.ob07
0,0 → 1,421
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Lines;
 
IMPORT
List, SYSTEM, API, Utils;
 
CONST
WCHAR_SIZE = 2;
SPACE = 20X;
 
TYPE
 
tLine* = POINTER TO RECORD (List.tItem)
ptr: INTEGER;
length*: INTEGER;
modified*, saved*, temp: BOOLEAN;
cin*, cout*, pos*: INTEGER
END;
 
PmovInt = PROCEDURE (VAR v: INTEGER; x: INTEGER);
PmovBool = PROCEDURE (VAR v: BOOLEAN; x: BOOLEAN);
PmovPtr = PROCEDURE (VAR v: List.tItem; x: List.tItem);
(*
PTypedPtr = PROCEDURE (p: List.tItem);
PUntypedPtr = PROCEDURE (p: INTEGER);
*)
 
VAR
 
_movInt: PmovInt;
_movBool: PmovBool;
_movPtr: PmovPtr;
(* _typedPtr: PTypedPtr;
_untypedPtr: PUntypedPtr;*)
 
maxLength*: INTEGER;
 
 
PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
BEGIN
_movInt(v, x)
END movInt;
 
 
PROCEDURE movBool (VAR v: BOOLEAN; x: BOOLEAN);
BEGIN
_movBool(v, x)
END movBool;
 
 
PROCEDURE movPtr (VAR v: List.tItem; x: List.tItem);
BEGIN
_movPtr(v, x)
END movPtr;
 
 
PROCEDURE malloc (size: INTEGER): INTEGER;
VAR
ptr: INTEGER;
BEGIN
IF size > maxLength THEN
maxLength := size
END;
size := size*WCHAR_SIZE + 4;
INC(size, (-size) MOD 32);
ptr := API._NEW(size)
RETURN ptr
END malloc;
 
 
PROCEDURE free (line: tLine; newPtr: INTEGER);
BEGIN
IF line.ptr # 0 THEN
IF line.temp THEN
line.ptr := API._DISPOSE(line.ptr)
ELSE
line.ptr := 0
END
END;
IF ~line.temp THEN
movInt(line.ptr, newPtr);
(* IF newPtr # 0 THEN
_untypedPtr(newPtr)
END*)
END;
line.ptr := newPtr
END free;
 
 
PROCEDURE create* (temp: BOOLEAN): tLine;
VAR
line: tLine;
BEGIN
NEW(line);
ASSERT(line # NIL);
(* IF ~temp THEN
_typedPtr(line)
END;*)
line.next := NIL;
line.prev := NIL;
IF ~temp THEN
movPtr(line.next, NIL);
movPtr(line.prev, NIL)
END;
line.ptr := malloc(1);
ASSERT(line.ptr # 0);
IF ~temp THEN
(*_untypedPtr(line.ptr);*)
movInt(line.ptr, line.ptr)
END;
SYSTEM.PUT16(line.ptr, 0);
line.length := 0;
IF ~temp THEN
movInt(line.length, 0)
END;
line.temp := temp;
line.modified := FALSE;
line.saved := FALSE;
IF ~temp THEN
movBool(line.modified, FALSE);
movBool(line.saved, FALSE)
END;
line.cin := 0;
line.cout := 0;
line.pos := 0
RETURN line
END create;
 
 
PROCEDURE destroy* (VAR line: tLine);
BEGIN
IF line.temp THEN
free(line, 0);
DISPOSE(line)
ELSE
line := NIL
END
END destroy;
 
 
PROCEDURE modify* (line: tLine);
BEGIN
IF ~line.temp THEN
movBool(line.modified, TRUE);
movBool(line.saved, FALSE)
END;
line.modified := TRUE;
line.saved := FALSE
END modify;
 
 
PROCEDURE save* (line: tLine);
BEGIN
IF ~line.temp THEN
movBool(line.saved, TRUE);
movBool(line.modified, FALSE)
END;
line.modified := FALSE;
line.saved := TRUE
END save;
 
 
PROCEDURE getChar* (line: tLine; i: INTEGER): WCHAR;
VAR
c: WCHAR;
BEGIN
SYSTEM.GET(line.ptr + i*WCHAR_SIZE, c)
RETURN c
END getChar;
 
 
PROCEDURE trimLength* (line: tLine): INTEGER;
VAR
i: INTEGER;
BEGIN
i := line.length - 1;
WHILE (i >= 0) & (getChar(line, i) = SPACE) DO
DEC(i)
END
RETURN i + 1
END trimLength;
 
 
PROCEDURE getPChar* (line: tLine; i: INTEGER): INTEGER;
RETURN line.ptr + i*WCHAR_SIZE
END getPChar;
 
 
PROCEDURE setChar* (line: tLine; i: INTEGER; c: WCHAR);
BEGIN
SYSTEM.PUT(line.ptr + i*WCHAR_SIZE, c)
END setChar;
 
 
PROCEDURE concat* (line: tLine; s: ARRAY OF WCHAR);
VAR
Len: INTEGER;
ptr: INTEGER;
BEGIN
Len := LENGTH(s);
ptr := malloc(line.length + Len + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, line.length*WCHAR_SIZE);
SYSTEM.MOVE(SYSTEM.ADR(s[0]), ptr + line.length*WCHAR_SIZE, Len*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length + Len)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length + Len)
END;
INC(line.length, Len);
free(line, ptr)
END concat;
 
 
PROCEDURE delChar* (line: tLine; pos: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF pos < line.length THEN
ptr := malloc(line.length);
ASSERT(ptr # 0);
IF ~line.temp THEN
movInt(line.length, line.length - 1)
END;
DEC(line.length);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE + WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END
END delChar;
 
 
PROCEDURE insert* (line: tLine; pos: INTEGER; c: WCHAR);
VAR
ptr: INTEGER;
BEGIN
ptr := malloc(line.length + 2);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.PUT(ptr + pos*WCHAR_SIZE, c);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + pos*WCHAR_SIZE + WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
IF ~line.temp THEN
movInt(line.length, line.length + 1)
END;
INC(line.length);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END insert;
 
 
PROCEDURE insert2* (line1: tLine; pos: INTEGER; line2: tLine);
VAR
ptr: INTEGER;
BEGIN
IF line2.length > 0 THEN
ptr := malloc(line1.length + line2.length + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line1.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line2.ptr, ptr + pos*WCHAR_SIZE, line2.length*WCHAR_SIZE);
SYSTEM.MOVE(line1.ptr + pos*WCHAR_SIZE, ptr + (pos + line2.length)*WCHAR_SIZE, (line1.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line1.length + line2.length)*WCHAR_SIZE, 0);
IF ~line1.temp THEN
movInt(line1.length, line1.length + line2.length)
END;
IF ~line2.temp THEN
movInt(line2.length, 0)
END;
INC(line1.length, line2.length);
line2.length := 0;
free(line1, ptr);
free(line2, 0)
END
END insert2;
 
 
PROCEDURE insert3* (line: tLine; pos, n: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF n > 0 THEN
ptr := malloc(line.length + n + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + (pos + n)*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length + n)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length + n)
END;
INC(line.length, n);
free(line, ptr)
END
END insert3;
 
 
PROCEDURE delCharN* (line: tLine; pos, n: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF n > 0 THEN
ptr := malloc(line.length - n + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + (pos + n)*WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos - n)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length - n)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length - n)
END;
DEC(line.length, n);
free(line, ptr)
END
END delCharN;
 
 
PROCEDURE wrap* (line, nextLine: tLine; pos: INTEGER);
VAR
ptr1, ptr2: INTEGER;
n: INTEGER;
BEGIN
ptr1 := malloc(pos + 1);
ASSERT(ptr1 # 0);
n := line.length - pos;
ptr2 := malloc(n + 1);
ASSERT(ptr2 # 0);
SYSTEM.MOVE(line.ptr, ptr1, pos*WCHAR_SIZE);
SYSTEM.PUT16(ptr1 + pos*WCHAR_SIZE, 0);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr2, n*WCHAR_SIZE);
SYSTEM.PUT16(ptr2 + n*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, pos)
END;
IF ~nextLine.temp THEN
movInt(nextLine.length, n)
END;
line.length := pos;
nextLine.length := n;
free(line, ptr1);
free(nextLine, ptr2)
END wrap;
 
 
PROCEDURE copy* (line: tLine);
VAR
ptr: INTEGER;
BEGIN
ptr := malloc(line.length + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, line.length*WCHAR_SIZE);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END copy;
 
 
PROCEDURE chCase* (line: tLine; pos1, pos2: INTEGER; upper: BOOLEAN): BOOLEAN;
VAR
i: INTEGER;
modified: BOOLEAN;
c: WCHAR;
func: PROCEDURE (VAR c: WCHAR): BOOLEAN;
BEGIN
modified := FALSE;
IF upper THEN
func := Utils.cap
ELSE
func := Utils.low
END;
i := pos2;
WHILE i >= pos1 DO
c := getChar(line, i);
IF func(c) THEN
modified := TRUE
END;
DEC(i)
END;
 
IF modified THEN
copy(line);
i := pos2;
WHILE i >= pos1 DO
c := getChar(line, i);
IF func(c) THEN
setChar(line, i, c)
END;
DEC(i)
END;
modify(line)
END
RETURN modified
END chCase;
 
 
PROCEDURE init* (movInt: PmovInt; movPtr: PmovPtr; movBool: PmovBool(*; typedPtr: PTypedPtr; untypedPtr: PUntypedPtr*));
BEGIN
_movInt := movInt;
_movPtr := movPtr;
_movBool := movBool;
(* _typedPtr := typedPtr;
_untypedPtr := untypedPtr;*)
END init;
 
 
BEGIN
maxLength := 64
END Lines.
/programs/develop/cedit/SRC/List.ob07
0,0 → 1,227
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE List;
 
TYPE
 
tItem* = POINTER TO RECORD
prev*, next*: tItem
END;
 
tList* = POINTER TO RECORD
first*, last*: tItem;
count*: INTEGER
END;
 
PmovInt = PROCEDURE (VAR v: INTEGER; x: INTEGER);
PmovPtr = PROCEDURE (VAR v: tItem; x: tItem);
 
 
VAR
 
_movInt: PmovInt;
_movPtr: PmovPtr;
 
 
PROCEDURE create* (list: tList): tList;
BEGIN
IF list = NIL THEN
NEW(list)
END;
list.first := NIL;
list.last := NIL;
list.count := 0
RETURN list
END create;
 
 
PROCEDURE getItem* (list: tList; idx: INTEGER): tItem;
VAR
item: tItem;
BEGIN
IF idx < 0 THEN
item := NIL
ELSE
item := list.first;
WHILE (idx > 0) & (item # NIL) DO
item := item.next;
DEC(idx)
END
END
RETURN item
END getItem;
 
 
PROCEDURE delete* (list: tList; item: tItem);
VAR
prev, next: tItem;
BEGIN
prev := item.prev;
next := item.next;
IF prev # NIL THEN
prev.next := next;
IF next # NIL THEN
next.prev := prev
ELSE
list.last := prev
END
ELSE
list.first := next;
IF next # NIL THEN
next.prev := NIL
ELSE
list.last := NIL
END
END;
DEC(list.count)
END delete;
 
 
PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
BEGIN
_movInt(v, x);
v := x
END movInt;
 
 
PROCEDURE movPtr (VAR v: tItem; x: tItem);
BEGIN
_movPtr(v, x);
v := x
END movPtr;
 
 
PROCEDURE _delete* (list: tList; item: tItem);
VAR
prev, next: tItem;
BEGIN
prev := item.prev;
next := item.next;
IF prev # NIL THEN
movPtr(prev.next, next);
IF next # NIL THEN
movPtr(next.prev, prev)
ELSE
movPtr(list.last, prev)
END
ELSE
movPtr(list.first, next);
IF next # NIL THEN
movPtr(next.prev, NIL)
ELSE
movPtr(list.last, NIL)
END
END;
movInt(list.count, list.count - 1)
END _delete;
 
 
PROCEDURE _append* (list: tList; item: tItem);
BEGIN
movPtr(item.prev, list.last);
IF list.last # NIL THEN
movPtr(list.last.next, item)
ELSE
movPtr(list.first, item)
END;
movPtr(list.last, item);
movPtr(item.next, NIL);
movInt(list.count, list.count + 1)
END _append;
 
 
PROCEDURE _insert* (list: tList; item, newItem: tItem);
VAR
next: tItem;
BEGIN
next := item.next;
IF next # NIL THEN
movPtr(next.prev, newItem);
movPtr(newItem.next, next);
movPtr(item.next, newItem);
movPtr(newItem.prev, item);
movInt(list.count, list.count + 1)
ELSE
_append(list, newItem)
END
END _insert;
 
 
PROCEDURE append* (list: tList; item: tItem);
BEGIN
item.prev := list.last;
IF list.last # NIL THEN
list.last.next := item
ELSE
list.first := item
END;
list.last := item;
item.next := NIL;
INC(list.count)
END append;
 
 
PROCEDURE insert* (list: tList; item, newItem: tItem);
VAR
next: tItem;
BEGIN
next := item.next;
IF next # NIL THEN
next.prev := newItem;
newItem.next := next;
item.next := newItem;
newItem.prev := item;
INC(list.count)
ELSE
append(list, newItem)
END
END insert;
 
 
PROCEDURE pop* (list: tList): tItem;
VAR
res: tItem;
BEGIN
IF list.count # 0 THEN
res := list.last;
list.last := res.prev;
DEC(list.count);
IF list.count # 0 THEN
list.last.next := NIL
ELSE
list.first := NIL
END;
res.prev := NIL;
res.next := NIL
ELSE
res := NIL
END
RETURN res
END pop;
 
 
PROCEDURE init* (movInt: PmovInt; movPtr: PmovPtr);
BEGIN
_movInt := movInt;
_movPtr := movPtr
END init;
 
 
END List.
/programs/develop/cedit/SRC/Menu.ob07
0,0 → 1,357
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Menu;
 
IMPORT
SYSTEM, G := Graph, List, K := KolibriOS;
 
CONST
fontHeight = 20;
fontWidth = 8;
 
RIGHT = 16;
LEFT = 16;
TOP = 1;
 
backColor = 0F0F0F0H;
foreColor = 0;
selBackColor = 091C9F7H;
selForeColor = 0;
disBackColor = backColor;
disForeColor = 808080H;
disSelBackColor = 0E4E4E4H;
disSelForeColor = disForeColor;
 
 
TYPE
tItem* = POINTER TO RECORD (List.tItem)
id*, check: INTEGER;
text: ARRAY 32 OF WCHAR;
enabled, delim: BOOLEAN
END;
 
tMenu* = POINTER TO RECORD
(*stack: POINTER TO RECORD stk: ARRAY 250000 OF INTEGER END;*)
tid*: INTEGER;
winX, winY, width*, height*: INTEGER;
selItem, cliItem: INTEGER;
 
font: G.tFont;
canvas: G.tCanvas;
 
items: List.tList;
click: PROCEDURE (menu: tMenu; id: INTEGER);
key: PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN
END;
 
tClick = PROCEDURE (menu: tMenu; id: INTEGER);
tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
 
VAR
lastTID*: INTEGER;
stack: ARRAY 250000 OF INTEGER;
 
 
PROCEDURE exit (m: tMenu);
BEGIN
m.tid := 0;
K.Exit
END exit;
 
 
PROCEDURE repaint (m: tMenu);
VAR
y, i: INTEGER;
item: tItem;
BkColor, TextColor: INTEGER;
canvas: G.tCanvas;
 
BEGIN
canvas := m.canvas;
G.SetColor(canvas, backColor);
G.clear(canvas);
G.SetColor(canvas, ORD((-BITS(backColor))*{0..23}) );
G.Rect(canvas, 0, 0, m.width, m.height);
y := TOP;
i := 0;
item := m.items.first(tItem);
WHILE item # NIL DO
IF item.enabled THEN
IF i # m.selItem THEN
BkColor := backColor;
TextColor := foreColor
ELSE
BkColor := selBackColor;
TextColor := selForeColor
END
ELSE
IF i # m.selItem THEN
BkColor := disBackColor;
TextColor := disForeColor
ELSE
BkColor := disSelBackColor;
TextColor := disSelForeColor
END
END;
G.SetColor(canvas, BkColor);
G.FillRect(canvas, 1, y, m.width - 1, y + fontHeight - 4);
G.SetTextColor(canvas, TextColor);
G.SetBkColor(canvas, BkColor);
G.TextOut2(canvas, LEFT, y + (fontHeight - 16) DIV 2 - 2, item.text, LENGTH(item.text));
 
IF item.check = 1 THEN
G.SetColor(canvas, TextColor);
G.DLine(canvas, 4, 7, y + (fontHeight - 16) DIV 2 + 5, -1);
G.DLine(canvas, 4, 7, y + (fontHeight - 16) DIV 2 + 6, -1);
G.DLine(canvas, 7, 12, y + (fontHeight - 16) DIV 2 + 8, 1);
G.DLine(canvas, 7, 12, y + (fontHeight - 16) DIV 2 + 9, 1);
ELSIF item.check = 2 THEN
G.SetColor(canvas, TextColor);
G.FillRect(canvas, 6, y + fontHeight DIV 2 - 4, 10, y + fontHeight DIV 2)
END;
 
INC(y, fontHeight);
IF item.delim THEN
G.SetColor(canvas, ORD((-BITS(backColor))*{0..23}));
G.HLine(canvas, y - 2, 1, m.width - 1)
END;
INC(i);
item := item.next(tItem)
END;
G.DrawCanvas(canvas, 0, 0)
END repaint;
 
 
PROCEDURE draw_window (m: tMenu);
BEGIN
K.BeginDraw;
K.CreateWindow(m.winX, m.winY, m.width, m.height, 0, 61H, 0, 1, "");
repaint(m);
K.EndDraw
END draw_window;
 
 
PROCEDURE mouse (m: tMenu; VAR x, y: INTEGER);
VAR
mouseX, mouseY: INTEGER;
BEGIN
K.MousePos(mouseX, mouseY);
x := mouseX - m.winX;
y := mouseY - m.winY;
END mouse;
 
 
PROCEDURE click (m: tMenu; i: INTEGER);
VAR
item: List.tItem;
BEGIN
item := List.getItem(m.items, i);
IF item(tItem).enabled THEN
m.click(m, item(tItem).id);
exit(m)
END
END click;
 
 
PROCEDURE [stdcall] window (m: tMenu);
VAR
x, y: INTEGER;
key: INTEGER;
msState: SET;
BEGIN
m.selItem := -1;
m.cliItem := -1;
K.SetEventsMask({0, 1, 5});
WHILE TRUE DO
CASE K.WaitForEvent() OF
|1:
draw_window(m)
|2:
key := K.GetKey();
IF key DIV 65536 = 72 THEN
DEC(m.selItem);
IF m.selItem < 0 THEN
m.selItem := 0
END
ELSIF key DIV 65536 = 80 THEN
INC(m.selItem);
IF m.selItem >= m.items.count THEN
m.selItem := m.items.count - 1
END
ELSIF key DIV 65536 = 28 THEN
IF m.selItem >= 0 THEN
click(m, m.selItem)
END;
m.cliItem := -1
ELSE
IF m.key(m, key) THEN
exit(m)
END
END;
repaint(m)
|6:
msState := K.MouseState();
mouse(m, x, y);
IF (0 <= x) & (x < m.width) & (0 <= y) & (y < m.height) THEN
m.selItem := (y - TOP) DIV fontHeight;
IF 8 IN msState THEN
m.cliItem := (y - TOP) DIV fontHeight
END;
IF 16 IN msState THEN
IF m.cliItem = m.selItem THEN
click(m, m.cliItem)
END;
m.cliItem := -1
END
ELSE
m.cliItem := -1;
IF {8, 9, 10} * msState # {} THEN
exit(m)
END
END;
repaint(m)
END
END
END window;
 
 
PROCEDURE AddMenuItem* (items: List.tList; id: INTEGER; s: ARRAY OF WCHAR);
VAR
item: tItem;
BEGIN
NEW(item);
item.id := id;
item.text := s;
item.enabled := TRUE;
item.delim := FALSE;
List.append(items, item);
END AddMenuItem;
 
 
PROCEDURE delimiter* (items: List.tList);
BEGIN
items.last(tItem).delim := TRUE
END delimiter;
 
 
PROCEDURE getItem (m: tMenu; id: INTEGER): tItem;
VAR
item: tItem;
BEGIN
item := m.items.first(tItem);
WHILE (item # NIL) & (item.id # id) DO
item := item.next(tItem)
END
RETURN item
END getItem;
 
 
PROCEDURE setEnabled* (m: tMenu; id: INTEGER; value: BOOLEAN);
VAR
item: tItem;
BEGIN
item := getItem(m, id);
IF item # NIL THEN
item.enabled := value
END
END setEnabled;
 
 
PROCEDURE setCheck* (m: tMenu; id: INTEGER; value: INTEGER);
VAR
item: tItem;
BEGIN
item := getItem(m, id);
IF item # NIL THEN
item.check := value
END
END setCheck;
 
 
PROCEDURE isEnabled* (m: tMenu; id: INTEGER): BOOLEAN;
VAR
item: tItem;
BEGIN
item := getItem(m, id)
RETURN (item # NIL) & item.enabled
END isEnabled;
 
 
PROCEDURE opened* (m: tMenu): BOOLEAN;
RETURN m.tid # 0
END opened;
 
 
PROCEDURE open* (m: tMenu; x, y: INTEGER);
BEGIN
IF m.tid = 0 THEN
m.winX := x;
m.winY := y;
(* DISPOSE(m.stack);
NEW(m.stack);
SYSTEM.PUT(SYSTEM.ADR(m.stack.stk[LEN(m.stack.stk) - 1]), m);
lastTID := K.CreateThread(SYSTEM.ADR(window), m.stack.stk);*)
SYSTEM.PUT(SYSTEM.ADR(stack[LEN(stack) - 1]), m);
lastTID := K.CreateThread(SYSTEM.ADR(window), stack);
m.tid := lastTID
END
END open;
 
 
PROCEDURE close* (m: tMenu);
BEGIN
IF m.tid # 0 THEN
K.ExitID(m.tid);
(*DISPOSE(m.stack);*)
m.tid := 0
END
END close;
 
 
PROCEDURE create* (items: List.tList; click: tClick; key: tKey): tMenu;
VAR
m: tMenu;
maxLength: INTEGER;
item: tItem;
BEGIN
NEW(m);
m.tid := 0;
m.items := items;
m.click := click;
m.key := key;
maxLength := 0;
item := items.first(tItem);
WHILE item # NIL DO
maxLength := MAX(maxLength, LENGTH(item.text));
item := item.next(tItem)
END;
m.width := maxLength*fontWidth + LEFT + RIGHT;
m.height := items.count*fontHeight - 2;
m.font := G.CreateFont(1, "", {});
m.canvas := G.CreateCanvas(m.width + 1, m.height + 1);
(*m.stack := NIL;*)
G.SetFont(m.canvas, m.font);
RETURN m
END create;
 
 
BEGIN
lastTID := 0
END Menu.
/programs/develop/cedit/SRC/OpenDlg.ob07
0,0 → 1,173
(*
Copyright 2016, 2018, 2020, 2021 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;
 
CONST
topen* = 0;
tsave* = 1;
tdir* = 2;
 
TYPE
 
DRAW_WINDOW = PROCEDURE;
 
tFilterArea = POINTER TO RECORD
size: INTEGER;
filter: ARRAY 4096 OF CHAR
END;
 
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: tFilterArea;
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;
 
VAR
 
Dialog_start, Dialog_init: PROCEDURE [stdcall] (od: Dialog);
 
filter_area: tFilterArea;
 
 
PROCEDURE Show*(od: Dialog; Width, Height: INTEGER);
BEGIN
IF od # NIL THEN
od.X := Width;
od.Y := Height;
Dialog_start(od)
END
END Show;
 
 
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;
 
 
PROCEDURE SetFilter* (dlg: Dialog; filter: ARRAY OF CHAR);
VAR
n, i: INTEGER;
BEGIN
IF filter = "" THEN
dlg.filter_area := NIL
ELSE
dlg.filter_area := filter_area;
filter_area.filter := filter;
n := LENGTH(filter_area.filter);
FOR i := 0 TO 3 DO
filter_area.filter[n + i] := "|"
END;
filter_area.filter[n + 4] := 0X;
filter_area.size := LENGTH(filter_area.filter);
replace(filter_area.filter, "|", 0X)
END
END SetFilter;
 
 
PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
VAR res: Dialog;
BEGIN
NEW(res);
IF res # NIL THEN
NEW(filter_area);
IF filter_area # NIL THEN
res.filter_area := filter_area;
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);
SetFilter(res, filter);
res.X := 0;
res.Y := 0;
res.s_opendir_path := res.s_dir_default_path;
res.FilePath := "";
res.FileName := "";
res.status := 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("/rd/1/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]);
Dialog_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;
 
PROCEDURE Load;
VAR Lib: INTEGER;
 
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
sys.PUT(v, a)
END GetProc;
 
BEGIN
Lib := KOSAPI.LoadLib("/rd/1/Lib/Proc_lib.obj");
GetProc(Lib, sys.ADR(Dialog_init), "OpenDialog_init");
GetProc(Lib, sys.ADR(Dialog_start), "OpenDialog_start");
END Load;
 
BEGIN
Load
END OpenDlg.
/programs/develop/cedit/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/develop/cedit/SRC/RW.ob07
0,0 → 1,508
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE RW;
 
IMPORT
File, SYSTEM, KOSAPI, E := Encodings,
CB := Clipboard, Lines;
 
 
CONST
 
CR = 0DX; LF = 0AX; TAB = 9X; SPACE = 20X;
BOM = 0FEFFX;
 
TAB_SIZE* = 4;
 
BUF_SIZE = 65536;
 
NAME_LEN = 1024;
 
EOL_LF* = 0; EOL_CRLF* = 1; EOL_CR* = 2;
 
 
TYPE
 
tFileName* = ARRAY NAME_LEN OF CHAR;
 
tEOL = ARRAY 3 OF WCHAR;
 
tInput* = POINTER TO RECORD
buffer: INTEGER;
pos, cnt: INTEGER;
enc: INTEGER;
CR: BOOLEAN;
clipbrd: BOOLEAN;
getChar: PROCEDURE (file: tInput): INTEGER
END;
 
tOutput* = POINTER TO RECORD
handle: File.FS;
buffer: ARRAY BUF_SIZE OF BYTE;
pos: INTEGER;
eol: tEOL;
putChar: PROCEDURE (file: tOutput; code: INTEGER): BOOLEAN
END;
 
 
VAR
 
eol*: ARRAY 3 OF tEOL;
 
 
PROCEDURE getByte (file: tInput): BYTE;
VAR
res: BYTE;
BEGIN
IF file.cnt > 0 THEN
SYSTEM.GET8(file.buffer + file.pos, res);
INC(file.pos);
DEC(file.cnt)
ELSE
res := 0
END
RETURN res
END getByte;
 
 
PROCEDURE peakByte (file: tInput): BYTE;
VAR
res: BYTE;
BEGIN
IF file.cnt > 0 THEN
SYSTEM.GET8(file.buffer + file.pos, res)
ELSE
res := 0
END
RETURN res
END peakByte;
 
 
PROCEDURE getCharUTF8 (file: tInput): INTEGER;
VAR
code, n: INTEGER;
b: BYTE;
BEGIN
b := getByte(file);
IF b <= 07FH THEN
n := 0
ELSIF (0C0H <= b) & (b <= 0DFH) THEN
DEC(b, 0C0H);
n := 1
ELSIF (0E0H <= b) & (b <= 0EFH) THEN
DEC(b, 0E0H);
n := 2
ELSIF (0F0H <= b) & (b <= 0F7H) THEN
DEC(b, 0F0H);
n := 3
ELSIF (0F8H <= b) & (b <= 0FBH) THEN
DEC(b, 0F8H);
n := 4
ELSIF (0FCH <= b) & (b <= 0FDH) THEN
DEC(b, 0FCH);
n := 5
ELSIF b = 0FEH THEN
b := 0;
n := 6
ELSIF b = 0FFH THEN
n := -1
ELSIF (080H <= b) & (b <= 0BFH) THEN
n := -1
END;
 
code := b;
 
IF n > 2 THEN
n := -1
END;
 
WHILE n > 0 DO
DEC(n);
b := peakByte(file);
IF (080H <= b) & (b <= 0BFH) THEN
code := code*64 + getByte(file) - 080H
ELSE
n := -1
END
END;
 
IF n = -1 THEN
code := E.UNDEF
END
 
RETURN code
END getCharUTF8;
 
 
PROCEDURE getCharW1251 (file: tInput): INTEGER;
RETURN E.cpW1251[getByte(file)]
END getCharW1251;
 
 
PROCEDURE getCharCP866 (file: tInput): INTEGER;
RETURN E.cp866[getByte(file)]
END getCharCP866;
 
 
PROCEDURE getCharUTF16LE (file: tInput): INTEGER;
RETURN getByte(file) + getByte(file) * 256
END getCharUTF16LE;
 
 
PROCEDURE getString* (file: tInput; line: Lines.tLine; VAR eol: BOOLEAN): INTEGER;
VAR
c: WCHAR;
i, L, k, n: INTEGER;
s: ARRAY 1000 OF WCHAR;
BEGIN
L := LEN(s);
eol := FALSE;
n := 0;
i := ORD(file.cnt > 0) - 1;
WHILE (file.cnt > 0) & ~eol DO
c := WCHR(file.getChar(file) MOD 65536);
IF c = CR THEN
eol := TRUE;
file.CR := TRUE
ELSIF (c = LF) OR (c = 0X) THEN
IF ~file.CR THEN
eol := TRUE
END;
file.CR := FALSE
ELSIF c = TAB THEN
k := TAB_SIZE - i MOD TAB_SIZE;
WHILE k > 0 DO
s[i] := SPACE;
INC(i);
IF i = L THEN
Lines.concat(line, s);
INC(n, i);
i := 0
END;
DEC(k)
END;
file.CR := FALSE
ELSIF c = BOM THEN
file.CR := FALSE
ELSE
s[i] := c;
INC(i);
IF i = L THEN
Lines.concat(line, s);
INC(n, i);
i := 0
END;
file.CR := FALSE
END
END;
IF i >= 0 THEN
s[i] := 0X;
Lines.concat(line, s);
END;
INC(n, i)
RETURN n
END getString;
 
 
PROCEDURE detectEncoding (text: tInput): INTEGER;
VAR
pos, cnt, res: INTEGER;
continue, bom: BOOLEAN;
b: BYTE;
cp866, w1251: INTEGER;
BEGIN
pos := text.pos;
cnt := text.cnt;
continue := TRUE;
WHILE (text.cnt > 0) & continue DO
IF getByte(text) > 127 THEN
continue := FALSE
END
END;
text.cnt := cnt;
text.pos := pos;
IF continue THEN
res := E.CP866
ELSE
bom := getCharUTF8(text) = ORD(BOM);
continue := TRUE;
text.cnt := cnt;
text.pos := pos;
WHILE (text.cnt > 0) & continue DO
IF getCharUTF8(text) = E.UNDEF THEN
continue := FALSE
END
END;
IF continue THEN
IF bom THEN
res := E.UTF8BOM
ELSE
res := E.UTF8
END
ELSE
text.cnt := cnt;
text.pos := pos;
cp866 := 0;
w1251 := 0;
WHILE text.cnt > 0 DO
b := getByte(text);
IF b > 127 THEN
IF b >= 192 THEN
INC(w1251)
ELSE
INC(cp866)
END
END
END;
IF w1251 > cp866 THEN
res := E.W1251
ELSE
res := E.CP866
END
END;
text.cnt := cnt;
text.pos := pos
END
RETURN res
END detectEncoding;
 
 
PROCEDURE load* (name: tFileName; VAR enc: INTEGER): tInput;
VAR
res: tInput;
fsize: INTEGER;
BEGIN
NEW(res);
res.pos := 0;
res.CR := FALSE;
res.getChar := NIL;
res.clipbrd := FALSE;
fsize := File.FileSize(name);
IF fsize = 0 THEN
res.buffer := KOSAPI.malloc(4096);
ASSERT(res.buffer # 0);
res.cnt := 0
ELSE
res.buffer := File.Load(name, res.cnt)
END;
IF res.buffer = 0 THEN
DISPOSE(res)
ELSE
enc := detectEncoding(res);
IF (enc = E.UTF8BOM) OR (enc = E.UTF8) THEN
res.getChar := getCharUTF8
ELSIF enc = E.CP866 THEN
res.getChar := getCharCP866
ELSIF enc = E.W1251 THEN
res.getChar := getCharW1251
END;
res.enc := enc
END
RETURN res
END load;
 
 
PROCEDURE clipboard* (): tInput;
VAR
res: tInput;
BEGIN
NEW(res);
res.pos := 0;
res.CR := FALSE;
res.clipbrd := TRUE;
res.getChar := NIL;
res.enc := E.CP866;
res.getChar := getCharCP866;
res.buffer := CB.get(res.cnt);
IF res.buffer = 0 THEN
DISPOSE(res)
END
RETURN res
END clipboard;
 
 
PROCEDURE putByte (file: tOutput; b: BYTE);
VAR
c: INTEGER;
BEGIN
IF file.pos = BUF_SIZE THEN
c := File.Write(file.handle, SYSTEM.ADR(file.buffer[0]), BUF_SIZE);
file.pos := 0
END;
file.buffer[file.pos] := b;
INC(file.pos)
END putByte;
 
 
PROCEDURE putString* (file: tOutput; line: Lines.tLine; n: INTEGER): INTEGER;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < n) & file.putChar(file, ORD(Lines.getChar(line, i))) DO
INC(i)
END
RETURN i
END putString;
 
 
PROCEDURE newLine* (file: tOutput): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (file.eol[i] # 0X) & file.putChar(file, ORD(file.eol[i])) DO
INC(i)
END
RETURN i = LENGTH(file.eol)
END newLine;
 
 
PROCEDURE putCharUTF8 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := TRUE;
IF code <= 7FH THEN
putByte(file, code)
ELSIF (80H <= code) & (code <= 7FFH) THEN
putByte(file, code DIV 64 + 0C0H);
putByte(file, code MOD 64 + 080H)
ELSIF (800H <= code) & (code <= 0FFFFH) THEN
putByte(file, code DIV 4096 + 0E0H);
putByte(file, (code DIV 64) MOD 64 + 080H);
putByte(file, code MOD 64 + 080H)
ELSE
res := FALSE
END
RETURN res
END putCharUTF8;
 
 
PROCEDURE putCharW1251 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
n: INTEGER;
res: BOOLEAN;
BEGIN
res := TRUE;
n := E.UNI[code, E.W1251];
IF n # E.UNDEF THEN
putByte(file, n)
ELSE
res := FALSE
END
RETURN res
END putCharW1251;
 
 
PROCEDURE putCharCP866 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
n: INTEGER;
res: BOOLEAN;
BEGIN
res := TRUE;
n := E.UNI[code, E.CP866];
IF n # E.UNDEF THEN
putByte(file, n)
ELSE
res := FALSE
END
RETURN res
END putCharCP866;
 
 
PROCEDURE putCharUTF16LE (file: tOutput; code: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF (0 <= code) & (code <= 65535) THEN
res := TRUE;
putByte(file, code MOD 256);
putByte(file, code DIV 256)
ELSE
res := FALSE
END
RETURN res
END putCharUTF16LE;
 
 
PROCEDURE close* (VAR file: tOutput): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := TRUE;
IF file # NIL THEN
IF file.handle # NIL THEN
IF file.pos > 0 THEN
res := File.Write(file.handle, SYSTEM.ADR(file.buffer[0]), file.pos) = file.pos
END;
File.Close(file.handle)
END;
DISPOSE(file)
END
RETURN res
END close;
 
 
PROCEDURE create* (name: tFileName; enc, nl: INTEGER): tOutput;
VAR
res: tOutput;
BEGIN
NEW(res);
res.pos := 0;
res.eol := eol[nl];
res.putChar := NIL;
IF (enc = E.UTF8) OR (enc = E.UTF8BOM) THEN
res.putChar := putCharUTF8;
IF enc = E.UTF8BOM THEN
ASSERT(res.putChar(res, ORD(BOM)))
END
ELSIF enc = E.UTF16LE THEN
res.putChar := putCharUTF16LE;
ELSIF enc = E.W1251 THEN
res.putChar := putCharW1251
ELSIF enc = E.CP866 THEN
res.putChar := putCharCP866
END;
ASSERT(res.putChar # NIL);
res.handle := File.Create(name);
IF res.handle = NIL THEN
DISPOSE(res)
END
RETURN res
END create;
 
 
PROCEDURE destroy* (VAR file: tInput);
BEGIN
IF file # NIL THEN
IF file.buffer # 0 THEN
file.buffer := KOSAPI.free(file.buffer - 12*ORD(file.clipbrd))
END;
DISPOSE(file)
END
END destroy;
 
 
BEGIN
eol[EOL_LF] := LF;
eol[EOL_CRLF] := CR + LF;
eol[EOL_CR] := CR
END RW.
/programs/develop/cedit/SRC/Search.ob07
0,0 → 1,123
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Search;
 
IMPORT
CB := Clipboard, List, Utils, SYSTEM;
 
 
TYPE
 
tBuffer* = CB.tBuffer;
 
IdxTable* = ARRAY 65536, 2 OF INTEGER;
 
tPos* = POINTER TO RECORD (List.tItem)
pos*: INTEGER
END;
 
 
PROCEDURE index* (text: tBuffer; VAR table: IdxTable; cs: BOOLEAN): tBuffer;
VAR
pChar, cnt, i: INTEGER;
c: WCHAR;
res: tBuffer;
BEGIN
pChar := text.dataPtr;
cnt := CB.bufSize(text) DIV 2;
 
FOR i := 0 TO 65535 DO
table[i, 1] := 0
END;
 
i := cnt;
WHILE i > 0 DO
SYSTEM.GET(pChar, c);
IF ~cs & Utils.cap(c) THEN
SYSTEM.PUT(pChar, c)
END;
INC(table[ORD(c), 1]);
INC(pChar, 2);
DEC(i)
END;
 
res := CB.create(cnt * SYSTEM.SIZE(INTEGER));
 
table[0, 0] := res.dataPtr;
FOR i := 1 TO 65535 DO
table[i, 0] := table[i - 1, 0] + table[i - 1, 1] * SYSTEM.SIZE(INTEGER)
END;
 
pChar := text.dataPtr;
i := 0;
WHILE i < cnt DO
SYSTEM.GET(pChar, c);
SYSTEM.PUT(table[ORD(c), 0], i);
INC(table[ORD(c), 0], SYSTEM.SIZE(INTEGER));
INC(pChar, 2);
INC(i)
END;
 
FOR i := 0 TO 65535 DO
DEC(table[i, 0], table[i, 1] * SYSTEM.SIZE(INTEGER))
END
 
RETURN res
END index;
 
 
PROCEDURE find* (text: tBuffer; table: IdxTable; s: ARRAY OF WCHAR; whole: BOOLEAN; list: List.tList);
VAR
k, pos, n, x, prev_item_pos: INTEGER;
item: tPos;
c1, c2: WCHAR;
flag: BOOLEAN;
BEGIN
n := LENGTH(s);
k := table[ORD(s[0]), 1];
pos := table[ORD(s[0]), 0];
prev_item_pos := 0;
WHILE k > 0 DO
SYSTEM.GET(pos, x);
IF Utils.streq(text.dataPtr + x*2, SYSTEM.ADR(s[0]), n) THEN
flag := whole;
IF flag THEN
IF x > 0 THEN
SYSTEM.GET(text.dataPtr + (x - 1)*2, c1);
ELSE
c1 := 0X
END;
SYSTEM.GET(text.dataPtr + (x + n)*2, c2);
flag := Utils.isLetter(c1) OR Utils.isLetter(c2) OR Utils.isDigit(c1) OR Utils.isDigit(c2) OR (c1 = "_") OR (c2 = "_")
END;
IF ~flag & (x >= prev_item_pos) THEN
prev_item_pos := x + n;
NEW(item);
item.pos := x;
List.append(list, item)
END
END;
INC(pos, SYSTEM.SIZE(INTEGER));
DEC(k)
END
END find;
 
 
END Search.
/programs/develop/cedit/SRC/Text.ob07
0,0 → 1,2144
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Text;
 
IMPORT
List, Lines,
G := Graph,
U := Utils,
RW, Search,
E := Encodings,
CB := Clipboard,
ChangeLog,
Lang := Languages;
 
 
CONST
 
SPACE = 20X;
TAB = RW.TAB_SIZE;
lenEOL = CB.lenEOL;
 
SHIFT* = 0; CTRL* = 1;
 
mark_width = 2;
pad_left = mark_width + 3;
pad_top = 1;
inter = 2;
 
 
TYPE
 
tPoint = RECORD
X, Y: INTEGER
END;
 
pPoint = POINTER TO tPoint;
 
tString* = ARRAY 1000 OF WCHAR;
 
tLine = Lines.tLine;
 
tGuard = POINTER TO RECORD (ChangeLog.tGuard)
selected: BOOLEAN;
cursor, select2, scroll: tPoint;
CurX: INTEGER
END;
 
tText* = POINTER TO RECORD (List.tList)
cursor, select, select2: pPoint;
scroll: tPoint;
CurX: INTEGER;
modified*: BOOLEAN;
 
edition*: tGuard;
comments, numbers*, guard,
search, cs, whole: BOOLEAN;
curLine: tLine;
fileName*: RW.tFileName;
lang*: INTEGER;
enc*: INTEGER;
table: Search.IdxTable;
foundList: List.tList;
idxData: Search.tBuffer;
foundSel: INTEGER;
searchText: tString
END;
 
tProcedure = PROCEDURE;
 
 
VAR
 
pdelete: PROCEDURE (text: tText);
ShowCursor: PROCEDURE;
 
colors*: RECORD
text, back, seltext, selback, modified, saved, curline, numtext, numback, border*: INTEGER;
comment, string, num, delim, key1, key2, key3: INTEGER
END;
canvas: G.tCanvas;
drawCursor*: BOOLEAN;
padding: RECORD left, top: INTEGER END;
size, textsize: tPoint;
charWidth, charHeight: INTEGER;
 
 
PROCEDURE setName* (text: tText; name: RW.tFileName);
VAR
ext: RW.tFileName;
BEGIN
text.fileName := name;
U.getFileName(text.fileName, ext, ".");
U.upcase(ext);
IF ext = "OB07" THEN
text.lang := Lang.langOberon
ELSIF (ext = "C") OR (ext = "H") OR (ext = "CPP") THEN
text.lang := Lang.langC
ELSIF (ext = "PAS") OR (ext = "PP") THEN
text.lang := Lang.langPascal
ELSIF ext = "ASM" THEN
text.lang := Lang.langFasm
ELSIF ext = "LUA" THEN
text.lang := Lang.langLua
ELSIF ext = "INI" THEN
text.lang := Lang.langIni
ELSE
text.lang := Lang.langNone
END
END setName;
 
 
PROCEDURE setLang* (text: tText; lang: INTEGER);
BEGIN
text.lang := lang;
text.comments := TRUE
END setLang;
 
 
PROCEDURE getPos* (text: tText; VAR x, y: INTEGER);
BEGIN
x := text.cursor.X + 1;
y := text.cursor.Y + 1
END getPos;
 
 
PROCEDURE getScroll* (text: tText; VAR x, y: INTEGER);
BEGIN
x := text.scroll.X;
y := text.scroll.Y
END getScroll;
 
 
PROCEDURE getTextSize* (VAR x, y: INTEGER);
BEGIN
x := textsize.X;
y := textsize.Y
END getTextSize;
 
 
PROCEDURE getTextRect* (VAR left, top, rigth, bottom: INTEGER);
BEGIN
left := padding.left - 1;
top := padding.top - 1;
rigth := size.X - 1;
bottom := top + size.Y - 1;
END getTextRect;
 
 
PROCEDURE toggleNumbers* (text: tText);
BEGIN
text.numbers := ~text.numbers
END toggleNumbers;
 
 
PROCEDURE toggleCursor*;
BEGIN
drawCursor := ~drawCursor
END toggleCursor;
 
 
PROCEDURE getChar (line: tLine; i: INTEGER): WCHAR;
VAR
res: WCHAR;
BEGIN
IF i >= line.length THEN
res := 0X
ELSE
res := Lines.getChar(line, i)
END
RETURN res
END getChar;
 
 
PROCEDURE getString (src: tLine; pos, cnt: INTEGER; VAR dst: ARRAY OF WCHAR): INTEGER;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (pos < src.length) & (cnt > 0) DO
IF i < LEN(dst) - 1 THEN
dst[i] := getChar(src, pos);
INC(i)
END;
INC(pos);
DEC(cnt)
END;
dst[i] := 0X
RETURN i
END getString;
 
 
PROCEDURE NextLine (VAR line: tLine);
BEGIN
line := line.next(tLine)
END NextLine;
 
 
PROCEDURE PrevLine (VAR line: tLine);
BEGIN
line := line.prev(tLine)
END PrevLine;
 
 
PROCEDURE SetColor (textColor, backColor: INTEGER);
BEGIN
G.SetTextColor(canvas, textColor);
G.SetBkColor(canvas, backColor)
END SetColor;
 
 
PROCEDURE ProcessComments (line: tLine; VAR depth, pos: INTEGER; minDepth, n: INTEGER; lang: INTEGER);
VAR
cond: INTEGER;
BEGIN
cond := 0;
WHILE (pos <= n) & (depth > minDepth) DO
Lang.comments(line, depth, cond, pos, n, lang);
INC(pos)
END;
DEC(pos)
END ProcessComments;
 
 
PROCEDURE Comments (text: tText);
VAR
line: tLine;
i: INTEGER;
BEGIN
line := text.first(tLine);
line.cin := 0;
line.cout := 0;
i := 0;
ProcessComments(line, line.cout, i, -1, line.length - 1, text.lang);
NextLine(line);
WHILE line # NIL DO
line.cin := line.prev(tLine).cout;
line.cout := line.cin;
i := 0;
ProcessComments(line, line.cout, i, -1, line.length - 1, text.lang);
NextLine(line)
END;
text.comments := FALSE
END Comments;
 
 
PROCEDURE parse (text: tText; line: tLine; y: INTEGER; backColor: INTEGER; lang: INTEGER);
VAR
c: WCHAR;
i, n, k: INTEGER;
cond, depth: INTEGER;
color: INTEGER;
hex: BOOLEAN;
isDgt: PROCEDURE (c: WCHAR): BOOLEAN;
 
 
PROCEDURE PrintLex (text: tText; line: tLine; lexStart, lexEnd: INTEGER; y: INTEGER; color, backColor: INTEGER);
VAR
lexLen: INTEGER;
BEGIN
SetColor(color, backColor);
lexLen := MAX(MIN(line.length - lexStart, lexEnd - lexStart + 1), 0);
G.TextOut(canvas, padding.left + (lexStart - text.scroll.X) * charWidth, y, Lines.getPChar(line, lexStart), lexLen)
END PrintLex;
 
 
PROCEDURE PrintComment (text: tText; line: tLine; VAR depth, i: INTEGER; y: INTEGER; backColor: INTEGER);
VAR
lexStart: INTEGER;
color: INTEGER;
BEGIN
IF (text.lang = Lang.langLua) & ~ODD(depth) THEN
color := colors.string
ELSIF (text.lang = Lang.langIni) & (depth = 1) THEN
color := colors.key2
ELSIF (text.lang = Lang.langPascal) & (depth = 3) THEN
color := colors.key3
ELSE
color := colors.comment
END;
lexStart := MAX(i - 2, 0);
ProcessComments(line, depth, i, 0, line.length - 1, text.lang);
PrintLex(text, line, lexStart, i, y, color, backColor)
END PrintComment;
 
 
PROCEDURE cap (c: WCHAR): WCHAR;
BEGIN
IF U.cap(c) THEN END
RETURN c
END cap;
 
 
PROCEDURE UL (c: WCHAR): BOOLEAN;
RETURN (cap(c) = "U") OR (cap(c) = "L")
END UL;
 
 
PROCEDURE FL (c: WCHAR): BOOLEAN;
RETURN (cap(c) = "F") OR (cap(c) = "L")
END FL;
 
 
PROCEDURE isFASMdelim (c: WCHAR): BOOLEAN;
VAR
s: ARRAY 19 OF WCHAR;
i: INTEGER;
BEGIN
s := "{}[]<>:,()&*/|+-\#";
i := LEN(s) - 2;
WHILE (i >= 0) & (c # s[i]) DO
DEC(i)
END
RETURN i >= 0
END isFASMdelim;
 
 
PROCEDURE ident (text: tText; VAR i: INTEGER; first, y: INTEGER; line: tLine; backColor: INTEGER; cs: BOOLEAN);
VAR
c: WCHAR;
lexLen: INTEGER;
s: ARRAY 32 OF WCHAR;
color: INTEGER;
BEGIN
c := getChar(line, i);
WHILE U.isLetter(c) OR (c = "_") OR U.isDigit(c) DO
INC(i);
c := getChar(line, i);
END;
DEC(i);
lexLen := getString(line, first, i - first + 1, s);
IF ~cs THEN
U.upcase16(s)
END;
IF Lang.isKey(s, text.lang, 1) THEN
color := colors.key1
ELSIF Lang.isKey(s, text.lang, 2) THEN
color := colors.key2
ELSIF Lang.isKey(s, text.lang, 3) THEN
color := colors.key3
ELSE
color := colors.text
END;
IF color # colors.text THEN
PrintLex(text, line, first, i, y, color, backColor)
END
END ident;
 
 
PROCEDURE String (text: tText; line: tLine; VAR i: INTEGER; y: INTEGER; backColor: INTEGER);
VAR
k: INTEGER;
BEGIN
k := i;
Lang.SkipString(line, i, line.length - 1);
PrintLex(text, line, k, i, y, colors.string, backColor)
END String;
 
 
BEGIN
depth := line.cin;
n := line.length - 1;
i := 0;
IF (depth > 0) & (n >= 0) THEN
PrintComment(text, line, depth, i, y, backColor)
END;
cond := 0;
WHILE i <= n DO
c := getChar(line, i);
 
IF lang = Lang.langFasm THEN
 
IF c = ";" THEN
PrintLex(text, line, i, n, y, colors.comment, backColor);
i := n
ELSIF (c = "'") OR (c = '"') THEN
String(text, line, i, y, backColor)
ELSIF (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i, y, line, backColor, FALSE)
ELSIF isFASMdelim(c) THEN
PrintLex(text, line, i, i, y, colors.delim, backColor)
ELSIF U.isDigit(c) THEN
hex := FALSE;
k := i;
INC(i);
c := getChar(line, i);
IF (cap(c) = "X") & (getChar(line, i - 1) = "0") THEN
INC(i);
hex := TRUE
END;
 
WHILE U.isHex(cap(getChar(line, i))) DO
INC(i)
END;
 
IF (cap(getChar(line, i)) = "H") & ~hex THEN
INC(i)
END;
 
DEC(i);
PrintLex(text, line, k, i, y, colors.num, backColor)
END
 
ELSIF lang = Lang.langC THEN
 
IF depth = 0 THEN
IF c = "/" THEN
IF cond = 0 THEN
cond := 1
ELSE
PrintLex(text, line, i - 1, n, y, colors.comment, backColor);
cond := 0;
i := n
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 1;
INC(i);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
ELSIF (c = "'") OR (c = '"') THEN
String(text, line, i, y, backColor);
cond := 0
ELSIF (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i - ORD((i > 0) & (getChar(line, i - 1) = "#")), y, line, backColor, TRUE);
cond := 0
ELSIF U.isDigit(c) THEN
k := i;
INC(i);
c := getChar(line, i);
IF c = "." THEN
DEC(i);
c := getChar(line, i)
END;
IF (cap(c) = "X") & (getChar(line, i - 1) = "0") THEN
REPEAT
INC(i);
c := getChar(line, i)
UNTIL ~U.isHex(cap(c));
IF UL(c) THEN
INC(i)
END
ELSIF UL(c) THEN
INC(i)
ELSIF U.isDigit(c) THEN
REPEAT
INC(i)
UNTIL ~U.isDigit(getChar(line, i));
c := getChar(line, i);
IF UL(c) THEN
INC(i)
ELSIF c = "." THEN
INC(i);
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
c := getChar(line, i);
IF cap(c) = "E" THEN
INC(i);
c := getChar(line, i);
IF (c = "+") OR (c = "-") THEN
INC(i)
END;
IF U.isDigit(getChar(line, i)) THEN
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
c := getChar(line, i);
IF FL(c) THEN
INC(i)
END
END
ELSIF FL(c) THEN
INC(i)
END
END
END;
DEC(i);
PrintLex(text, line, k, i, y, colors.num, backColor);
cond := 0
ELSE
cond := 0
END
ELSIF depth = 1 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = "/") & (cond = 1) THEN
cond := 0;
depth := 0
ELSE
cond := 0
END
END;
 
ELSIF lang = Lang.langOberon THEN
 
IF (depth = 0) & (c = "/") THEN
IF cond = 3 THEN
PrintLex(text, line, i - 1, n, y, colors.comment, backColor);
cond := 0;
i := n
ELSE
cond := 3
END
ELSIF (depth = 0) & ((c = "'") OR (c = '"')) THEN
String(text, line, i, y, backColor);
cond := 0
ELSIF (depth = 0) & U.isDigit(c) THEN
color := colors.num;
k := i;
INC(i);
WHILE U.isHex(getChar(line, i)) DO
INC(i)
END;
IF i <= n THEN
IF getChar(line, i) = "." THEN
INC(i);
IF getChar(line, i) = "." THEN
DEC(i)
END;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
IF getChar(line, i) = "E" THEN
INC(i);
IF (getChar(line, i) = "+") OR (getChar(line, i) = "-") THEN
INC(i)
END;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END
END
ELSIF getChar(line, i) = "H" THEN
INC(i)
ELSIF getChar(line, i) = "X" THEN
color := colors.string;
INC(i)
END
END;
DEC(i);
PrintLex(text, line, k, i, y, color, backColor);
cond := 0
ELSIF (depth = 0) & (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i, y, line, backColor, TRUE);
cond := 0
ELSIF c = "(" THEN
cond := 1
ELSIF c = "*" THEN
IF cond = 1 THEN
INC(depth);
INC(i);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
ELSE
cond := 2
END
ELSIF c = ")" THEN
IF cond = 2 THEN
IF depth > 0 THEN
DEC(depth)
END
END;
cond := 0
ELSE
cond := 0
END
 
ELSIF lang = Lang.langLua THEN
 
IF depth = 0 THEN
IF c = "-" THEN
IF cond = 1 THEN
IF Lang.LuaLong(line, i + 1) >= 0 THEN
depth := Lang.LuaLong(line, i + 1)*2 + 1;
INC(i);
PrintComment(text, line, depth, i, y, backColor)
ELSE
PrintLex(text, line, i - 1, n, y, colors.comment, backColor);
i := n
END;
cond := 0
ELSE
cond := 1
END
ELSIF c = "[" THEN
cond := 0;
k := Lang.LuaLong(line, i);
IF k >= 0 THEN
depth := (k + 1)*2;
INC(i, 2);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
END
ELSIF (c = "'") OR (c = '"') THEN
String(text, line, i, y, backColor);
cond := 0
ELSIF U.isDigit(c) THEN
k := i;
IF (c = "0") & (cap(getChar(line, i + 1)) = "X") THEN
isDgt := U.isHex;
hex := TRUE;
INC(i, 2)
ELSE
isDgt := U.isDigit;
hex := FALSE
END;
WHILE isDgt(cap(getChar(line, i))) DO
INC(i)
END;
IF getChar(line, i) = "." THEN
INC(i);
IF getChar(line, i) = "." THEN
DEC(i)
END;
WHILE isDgt(cap(getChar(line, i))) DO
INC(i)
END
END;
IF (cap(getChar(line, i)) = "E") OR hex & (cap(getChar(line, i)) = "P") THEN
INC(i);
IF (getChar(line, i) = "-") OR (getChar(line, i) = "+") THEN
INC(i)
END;
WHILE isDgt(cap(getChar(line, i))) DO
INC(i)
END
END;
DEC(i);
PrintLex(text, line, k, i, y, colors.num, backColor);
cond := 0
ELSIF U.isLetter(c) OR (c = "_") THEN
ident(text, i, i, y, line, backColor, TRUE);
cond := 0
ELSE
cond := 0
END
 
ELSIF depth > 0 THEN
IF (cond = 0) & (c = "]") THEN
cond := 1
ELSIF (cond >= 1) & (c = "=") THEN
INC(cond)
ELSIF (cond >= 1) & (c = "]") & (cond * 2 - depth MOD 2 = depth) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
 
ELSIF lang = Lang.langPascal THEN
 
IF depth = 0 THEN
IF c = "(" THEN
cond := 1
ELSIF (c = "*") & (cond = 1) THEN
depth := 2;
INC(i);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
ELSIF c = "/" THEN
IF cond = 2 THEN
PrintLex(text, line, i - 1, n, y, colors.comment, backColor);
cond := 0;
i := n
ELSE
cond := 2
END
ELSIF c = "'" THEN
String(text, line, i, y, backColor);
cond := 0
ELSIF c = "{" THEN
IF getChar(line, i + 1) = "$" THEN
depth := 3
ELSE
depth := 1
END;
INC(i, 2);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
ELSIF c = "#" THEN
k := i;
INC(i);
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
DEC(i);
PrintLex(text, line, k, i, y, colors.string, backColor);
cond := 0
ELSIF c = "$" THEN
IF (i > 0 ) & (getChar(line, i - 1) = "#") THEN
color := colors.string
ELSE
color := colors.num
END;
k := i;
INC(i);
WHILE U.isHex(cap(getChar(line, i))) DO
INC(i)
END;
DEC(i);
PrintLex(text, line, k, i, y, color, backColor);
cond := 0
ELSIF U.isDigit(c) THEN
k := i;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
IF getChar(line, i) = "." THEN
INC(i);
IF getChar(line, i) = "." THEN
DEC(i)
END;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
IF cap(getChar(line, i)) = "E" THEN
INC(i);
IF (getChar(line, i) = "-") OR (getChar(line, i) = "+") THEN
INC(i)
END;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END
END
END;
DEC(i);
PrintLex(text, line, k, i, y, colors.num, backColor);
cond := 0
ELSIF (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i, y, line, backColor, FALSE);
cond := 0
ELSE
cond := 0
END
ELSIF depth IN {1, 3} THEN
IF c = "}" THEN
depth := 0
END
ELSIF depth = 2 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = ")") & (cond = 1) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
 
ELSIF lang = Lang.langIni THEN
 
IF depth = 0 THEN
IF c = ";" THEN
PrintLex(text, line, i, n, y, colors.comment, backColor);
i := n
ELSIF c = '"' THEN
String(text, line, i, y, backColor)
ELSIF c = "=" THEN
PrintLex(text, line, i, i, y, colors.delim, backColor)
ELSIF c = "[" THEN
depth := 1;
INC(i, 2);
PrintComment(text, line, depth, i, y, backColor)
ELSIF U.isDigit(c) THEN
k := i;
WHILE U.isDigit(getChar(line, i)) DO
INC(i)
END;
DEC(i);
PrintLex(text, line, k, i, y, colors.num, backColor)
ELSIF (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i, y, line, backColor, TRUE)
END
ELSIF depth = 1 THEN
IF c = "]" THEN
depth := 0
END
END
 
END;
INC(i)
END
END parse;
 
 
PROCEDURE leadingSpaces (line: tLine): INTEGER;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE getChar(line, i) = SPACE DO
INC(i)
END
RETURN i
END leadingSpaces;
 
 
PROCEDURE plain (text: tText; eot: BOOLEAN): CB.tBuffer;
VAR
buf: CB.tBuffer;
size: INTEGER;
line: tLine;
EOT: ARRAY 2 OF WCHAR;
BEGIN
size := 0;
line := text.first(tLine);
WHILE line # NIL DO
line.pos := size;
INC(size, line.length);
NextLine(line);
IF line # NIL THEN
INC(size, CB.lenEOL)
END
END;
IF eot THEN
INC(size, 2)
END;
buf := CB.create(size);
line := text.first(tLine);
WHILE line # NIL DO
CB.append(buf, line, 0, line.length - 1);
NextLine(line);
IF line # NIL THEN
CB.eol(buf)
END
END;
IF eot THEN
EOT[0] := 0X;
EOT[1] := 0X;
CB.appends(buf, EOT, 0, 1)
END
RETURN buf
END plain;
 
 
PROCEDURE search* (text: tText; s: ARRAY OF WCHAR; cs, whole: BOOLEAN): BOOLEAN;
VAR
pos: List.tItem;
res: BOOLEAN;
plainText: Search.tBuffer;
BEGIN
plainText := NIL;
WHILE text.foundList.count # 0 DO
pos := List.pop(text.foundList);
DISPOSE(pos)
END;
text.whole := whole;
text.cs := cs;
text.searchText := s;
IF ~cs THEN
U.upcase16(text.searchText)
END;
IF text.searchText # "" THEN
plainText := plain(text, TRUE);
text.idxData := Search.index(plainText, text.table, cs);
Search.find(plainText, text.table, text.searchText, whole, text.foundList);
res := text.foundList.count > 0
ELSE
res := TRUE
END;
CB.destroy(plainText);
CB.destroy(text.idxData);
text.search := FALSE;
text.foundSel := 0
RETURN res
END search;
 
 
PROCEDURE modify (text: tText);
BEGIN
text.modified := TRUE;
text.comments := TRUE;
text.search := TRUE;
text.guard := TRUE
END modify;
 
 
PROCEDURE DelLine (text: tText; line: tLine);
BEGIN
List._delete(text, line);
Lines.destroy(line);
modify(text)
END DelLine;
 
 
PROCEDURE setSelect (text: tText);
BEGIN
IF text.select = text.cursor THEN
text.select2^ := text.cursor^;
text.select := text.select2
END
END setSelect;
 
 
PROCEDURE resetSelect* (text: tText);
BEGIN
text.select := text.cursor
END resetSelect;
 
 
PROCEDURE getLine (text: tText; n: INTEGER): tLine;
VAR
item: List.tItem;
BEGIN
item := List.getItem(text, n);
RETURN item(tLine)
END getLine;
 
 
PROCEDURE SetPos* (text: tText; x, y: INTEGER);
VAR
deltaY: INTEGER;
cursor: pPoint;
(* trimLength: INTEGER; *)
BEGIN
cursor := text.cursor;
y := MIN(MAX(y, 0), text.count - 1);
deltaY := y - cursor.Y;
IF deltaY # 0 THEN
cursor.Y := y;
(* trimLength := Lines.trimLength(text.curLine);
IF text.curLine.length # trimLength THEN
Lines.setChar(text.curLine, trimLength, 0X);
text.curLine.length := trimLength
END;*)
IF deltaY = 1 THEN
NextLine(text.curLine)
ELSIF deltaY = -1 THEN
PrevLine(text.curLine)
ELSE
text.curLine := getLine(text, y)
END
END;
cursor.X := MIN(MAX(x, 0), text.curLine.length);
IF text.scroll.Y > cursor.Y THEN
text.scroll.Y := cursor.Y
ELSIF text.scroll.Y + textsize.Y <= cursor.Y THEN
text.scroll.Y := cursor.Y - textsize.Y + 1
END;
IF text.scroll.X > cursor.X THEN
text.scroll.X := cursor.X
ELSIF text.scroll.X + textsize.X <= cursor.X THEN
text.scroll.X := cursor.X - textsize.X + 1
END;
IF (text.select.Y = cursor.Y) & (text.select.X > text.curLine.length) THEN
text.select.X := text.curLine.length
END;
setSelect(text);
text.foundSel := 0;
ShowCursor;
drawCursor := TRUE;
text.CurX := -1
END SetPos;
 
 
PROCEDURE getSelect (text: tText; VAR selBeg, selEnd: tPoint);
BEGIN
selBeg := text.cursor^;
selEnd := text.select^;
IF (selBeg.Y > selEnd.Y) OR (selBeg.Y = selEnd.Y) & (selBeg.X > selEnd.X) THEN
selBeg := text.select^;
selEnd := text.cursor^
END
END getSelect;
 
 
PROCEDURE selected* (text: tText): BOOLEAN;
RETURN (text.cursor.X # text.select.X) OR (text.cursor.Y # text.select.Y)
END selected;
 
 
PROCEDURE delSelect (text: tText);
VAR
selBeg, selEnd: tPoint;
line, last, cur: tLine;
BEGIN
getSelect(text, selBeg, selEnd);
IF (selBeg.Y = selEnd.Y) & (selBeg.X < selEnd.X) THEN
line := text.curLine;
Lines.delCharN(line, selBeg.X, selEnd.X - selBeg.X);
Lines.modify(line);
text.cursor^ := selBeg;
resetSelect(text);
SetPos(text, text.cursor.X, text.cursor.Y);
modify(text)
ELSIF selBeg.Y < selEnd.Y THEN
SetPos(text, selBeg.X, selBeg.Y);
line := text.curLine;
Lines.delCharN(line, selBeg.X, line.length - selBeg.X);
last := getLine(text, selEnd.Y);
Lines.delCharN(last, 0, selEnd.X);
cur := line.next(tLine);
WHILE cur # last DO
DelLine(text, cur);
cur := line.next(tLine)
END;
resetSelect(text);
SetPos(text, text.cursor.X, text.cursor.Y);
pdelete(text);
modify(text)
END;
resetSelect(text)
END delSelect;
 
 
PROCEDURE delete (text: tText);
VAR
i: INTEGER;
nextLine, curLine: tLine;
BEGIN
IF selected(text) THEN
delSelect(text)
ELSE
i := text.cursor.X;
curLine := text.curLine;
IF i < curLine.length THEN
Lines.delChar(curLine, i);
Lines.modify(curLine);
modify(text)
ELSE
nextLine := curLine.next(tLine);
IF nextLine # NIL THEN
Lines.modify(curLine);
modify(text);
Lines.insert2(curLine, i, nextLine);
DelLine(text, nextLine)
END
END
END;
setSelect(text)
END delete;
 
 
PROCEDURE BkSpace (text: tText);
VAR
i, n, k: INTEGER;
curLine, line: tLine;
BEGIN
IF selected(text) THEN
delSelect(text)
ELSE
resetSelect(text);
i := text.cursor.X;
curLine := text.curLine;
IF i > 0 THEN
modify(text);
n := leadingSpaces(curLine);
IF n < i THEN
Lines.delChar(curLine, i - 1);
Lines.modify(curLine);
k := 1
ELSE
n := i;
line := curLine.prev(tLine);
k := n;
WHILE (line # NIL) & (k >= n) DO
IF Lines.trimLength(line) # 0 THEN
k := leadingSpaces(line)
END;
PrevLine(line)
END;
IF k >= n THEN
k := 0
END;
DEC(n, k);
k := n;
Lines.modify(curLine);
Lines.delCharN(curLine, 0, n)
END;
SetPos(text, text.cursor.X - k, text.cursor.Y)
ELSE
PrevLine(curLine);
IF curLine # NIL THEN
SetPos(text, curLine.length, text.cursor.Y - 1);
delete(text)
END
END
END;
setSelect(text)
END BkSpace;
 
 
PROCEDURE enter (text: tText);
VAR
n: INTEGER;
curLine, newLine, line: tLine;
BEGIN
delSelect(text);
newLine := Lines.create(FALSE);
Lines.modify(newLine);
modify(text);
curLine := text.curLine;
IF text.cursor.X < curLine.length THEN
Lines.modify(curLine);
Lines.wrap(curLine, newLine, text.cursor.X)
END;
List._insert(text, curLine, newLine);
SetPos(text, 0, text.cursor.Y + 1);
line := text.curLine.prev(tLine);
n := -1;
WHILE (line # NIL) & (n = -1) DO
IF (*line.length*)Lines.trimLength(line) # 0 THEN
n := leadingSpaces(line)
END;
PrevLine(line)
END;
IF n = -1 THEN
n := 0
END;
Lines.insert3(text.curLine, 0, n);
SetPos(text, n, text.cursor.Y);
resetSelect(text);
WHILE n > 0 DO
Lines.setChar(text.curLine, n - 1, SPACE);
DEC(n)
END
END enter;
 
 
PROCEDURE input* (text: tText; code: INTEGER);
VAR
curLine: tLine;
 
PROCEDURE tab (text: tText);
VAR
i, x: INTEGER;
curLine: tLine;
BEGIN
delSelect(text);
curLine := text.curLine;
x := text.cursor.X;
Lines.modify(curLine);
modify(text);
i := TAB - x MOD TAB;
Lines.insert3(curLine, x, i);
SetPos(text, x + i, text.cursor.Y);
WHILE i > 0 DO
Lines.setChar(curLine, x + i - 1, SPACE);
DEC(i)
END
END tab;
 
BEGIN
IF (code >= ORD(SPACE)) & (code # 127) THEN
delSelect(text);
curLine := text.curLine;
Lines.insert(curLine, text.cursor.X, WCHR(code));
Lines.modify(curLine);
modify(text);
SetPos(text, text.cursor.X + 1, text.cursor.Y)
ELSIF code = 8 THEN
BkSpace(text)
ELSIF code = 9 THEN
tab(text)
ELSIF code = 13 THEN
enter(text)
END
END input;
 
 
PROCEDURE scroll* (text: tText; h, v: INTEGER);
BEGIN
INC(text.scroll.X, h);
INC(text.scroll.Y, v);
text.scroll.X := MIN(MAX(text.scroll.X, 0), Lines.maxLength);
text.scroll.Y := MIN(MAX(text.scroll.Y, 0), text.count - 1)
END scroll;
 
 
PROCEDURE save* (text: tText; name: RW.tFileName; enc, nl: INTEGER): BOOLEAN;
VAR
line: tLine;
file: RW.tOutput;
res: BOOLEAN;
Len: INTEGER;
(* item: List.tItem;*)
BEGIN
res := TRUE;
file := RW.create(name, enc, nl);
IF file # NIL THEN
(* IF ChangeLog.Log.last IS ChangeLog.tGuard THEN
item := List.pop(ChangeLog.Log);
DISPOSE(item)
END;*)
line := text.first(tLine);
WHILE (line # NIL) & res DO
Len := Lines.trimLength(line);
IF RW.putString(file, line, Len) # Len THEN
res := FALSE
END;
IF line.modified THEN
Lines.save(line)
END;
NextLine(line);
IF line # NIL THEN
IF ~RW.newLine(file) THEN
res := FALSE
END
END
END;
IF ~RW.close(file) THEN
res := FALSE
END;
IF res THEN
text.modified := FALSE
END
ELSE
res := FALSE
END;
text.guard := TRUE
RETURN res
END save;
 
 
PROCEDURE redoGuard (text: tText; guard: tGuard);
BEGIN
text.edition := guard;
text.cursor^ := guard.cursor;
text.select2^ := guard.select2;
text.scroll := guard.scroll;
text.CurX := guard.CurX;
IF guard.selected THEN
text.select := text.select2
ELSE
text.select := text.cursor
END;
text.curLine := getLine(text, text.cursor.Y);
text.comments := TRUE;
text.search := TRUE
END redoGuard;
 
 
PROCEDURE undo* (text: tText);
VAR
item: List.tItem;
guard: tGuard;
BEGIN
guard := text.edition;
item := guard.prev;
WHILE (item # NIL) & ~(item IS tGuard) DO
item := item.prev
END;
 
IF item # NIL THEN
guard := item(tGuard);
text.edition := guard;
text.modified := TRUE
END;
 
item := ChangeLog.Log.first;
WHILE item # guard DO
ChangeLog.redo(item);
item := item.next
END;
redoGuard(text, guard);
ChangeLog.setGuard(guard)
END undo;
 
 
PROCEDURE redo* (text: tText);
VAR
item: List.tItem;
guard: tGuard;
BEGIN
guard := text.edition;
item := guard.next;
WHILE (item # NIL) & ~(item IS tGuard) DO
ChangeLog.redo(item);
item := item.next
END;
IF item # NIL THEN
guard := item(tGuard);
redoGuard(text, guard)
END;
ChangeLog.setGuard(guard)
END redo;
 
 
PROCEDURE copy (text: tText);
VAR
selBeg, selEnd: tPoint;
first, line: tLine;
cnt, n: INTEGER;
buffer: CB.tBuffer;
 
 
PROCEDURE append (buffer: CB.tBuffer; line: tLine; first, last: INTEGER);
BEGIN
IF first <= last THEN
CB.append(buffer, line, first, last)
ELSE
IF U.OS = "KOS" THEN
CB.appends(buffer, SPACE, 0, 0)
END
END
END append;
 
 
BEGIN
getSelect(text, selBeg, selEnd);
 
first := getLine(text, selBeg.Y);
line := first;
 
n := selEnd.Y - selBeg.Y;
cnt := 0;
WHILE n >= 0 DO
INC(cnt, line.length + lenEOL);
NextLine(line);
DEC(n)
END;
 
buffer := CB.create(cnt);
 
n := selEnd.Y - selBeg.Y;
line := first;
IF n = 0 THEN
CB.append(buffer, line, selBeg.X, selEnd.X - 1)
ELSE
append(buffer, line, selBeg.X, line.length - 1);
REPEAT
DEC(n);
CB.eol(buffer);
NextLine(line);
IF n > 0 THEN
append(buffer, line, 0, line.length - 1)
END
UNTIL n = 0;
append(buffer, line, 0, selEnd.X - 1)
END;
CB.eot(buffer);
CB.put(buffer);
CB.destroy(buffer)
END copy;
 
 
PROCEDURE paste (text: tText);
VAR
line, newLine, curLine: tLine;
L: INTEGER;
cliptext: RW.tInput;
eol: BOOLEAN;
cursor: pPoint;
BEGIN
line := Lines.create(TRUE);
cliptext := RW.clipboard();
delSelect(text);
cursor := text.cursor;
WHILE (cliptext # NIL) & (RW.getString(cliptext, line, eol) >= 0) DO
L := line.length;
IF L > 0 THEN
Lines.insert2(text.curLine, cursor.X, line);
Lines.modify(text.curLine);
modify(text);
SetPos(text, cursor.X + L, cursor.Y);
resetSelect(text)
END;
IF eol THEN
newLine := Lines.create(FALSE);
Lines.modify(newLine);
modify(text);
curLine := text.curLine;
IF cursor.X < curLine.length THEN
Lines.modify(curLine);
Lines.wrap(curLine, newLine, cursor.X)
END;
List._insert(text, curLine, newLine);
SetPos(text, 0, cursor.Y + 1);
resetSelect(text)
END;
Lines.destroy(line);
line := Lines.create(TRUE)
END;
Lines.destroy(line);
RW.destroy(cliptext)
END paste;
 
 
PROCEDURE searchScroll (text: tText; n: INTEGER);
BEGIN
IF n - text.scroll.Y > textsize.Y - 1 THEN
text.scroll.Y := MAX(n - 2 * textsize.Y DIV 3, 0)
ELSIF n < text.scroll.Y THEN
text.scroll.Y := MAX(n - textsize.Y DIV 3, 0)
END
END searchScroll;
 
 
PROCEDURE goto* (text: tText; n: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
DEC(n);
IF (0 <= n) & (n < text.count) THEN
resetSelect(text);
searchScroll(text, n);
SetPos(text, 0, n);
res := TRUE
ELSE
res := FALSE
END
RETURN res
END goto;
 
 
PROCEDURE changeCase (text: tText; upper: BOOLEAN);
VAR
i: INTEGER;
line: tLine;
BEGIN
line := text.curLine;
i := text.cursor.X - 1;
 
WHILE (i >= 0) & U.isLetter(getChar(line, i)) DO
DEC(i)
END;
 
IF Lines.chCase(line, i + 1, text.cursor.X - 1, upper) THEN
modify(text)
END
END changeCase;
 
 
PROCEDURE chCase* (text: tText; upper: BOOLEAN);
VAR
selBeg, selEnd: tPoint;
first, line: Lines.tLine;
cnt: INTEGER;
modified: BOOLEAN;
BEGIN
modified := FALSE;
IF selected(text) THEN
getSelect(text, selBeg, selEnd);
first := getLine(text, selBeg.Y);
line := first;
cnt := selEnd.Y - selBeg.Y;
IF cnt = 0 THEN
IF Lines.chCase(line, selBeg.X, selEnd.X - 1, upper) THEN
modified := TRUE
END
ELSE
IF Lines.chCase(line, selBeg.X, line.length - 1, upper) THEN
modified := TRUE
END;
WHILE cnt > 1 DO
NextLine(line);
IF Lines.chCase(line, 0, line.length - 1, upper) THEN
modified := TRUE
END;
DEC(cnt)
END;
NextLine(line);
IF Lines.chCase(line, 0, selEnd.X - 1, upper) THEN
modified := TRUE
END
END
END;
IF modified THEN
modify(text)
END
END chCase;
 
 
PROCEDURE UpDown (text: tText; step: INTEGER);
VAR
temp: INTEGER;
BEGIN
IF text.CurX = -1 THEN
text.CurX := text.cursor.X
END;
temp := text.CurX;
SetPos(text, temp, text.cursor.Y + step);
text.CurX := temp
END UpDown;
 
 
PROCEDURE delLine* (text: tText);
BEGIN
resetSelect(text);
IF text.curLine.length > 0 THEN
Lines.delCharN(text.curLine, 0, text.curLine.length)
END;
SetPos(text, 0, text.cursor.Y);
IF text.cursor.Y = text.count - 1 THEN
BkSpace(text)
ELSE
delete(text)
END
END delLine;
 
 
PROCEDURE key* (text: tText; code: INTEGER; shift: SET);
BEGIN
IF SHIFT IN shift THEN
setSelect(text)
ELSE
IF (33 <= code) & (code <= 40) THEN
resetSelect(text)
END
END;
 
CASE code OF
|33:
IF CTRL IN shift THEN
UpDown(text, text.scroll.Y - text.cursor.Y)
ELSE
text.scroll.Y := MAX(text.scroll.Y - textsize.Y, 0);
UpDown(text, -textsize.Y)
END
|34:
IF CTRL IN shift THEN
UpDown(text, MIN(text.scroll.Y + textsize.Y - 1, text.count - 1) - text.cursor.Y)
ELSE
text.scroll.Y := MIN(text.scroll.Y + textsize.Y, text.count - 1);
UpDown(text, textsize.Y)
END
|35:
IF CTRL IN shift THEN
SetPos(text, text.last(tLine).length, text.count - 1)
ELSE
SetPos(text, text.curLine.length, text.cursor.Y)
END
|36:
IF CTRL IN shift THEN
SetPos(text, 0, 0)
ELSE
SetPos(text, 0, text.cursor.Y)
END
|37:
IF (text.cursor.X = 0) & (text.curLine.prev # NIL) THEN
SetPos(text, text.curLine.prev(tLine).length, text.cursor.Y - 1)
ELSE
SetPos(text, text.cursor.X - 1, text.cursor.Y)
END
|38:
UpDown(text, -1)
|39:
IF (text.cursor.X = text.curLine.length) & (text.curLine.next # NIL) THEN
SetPos(text, 0, text.cursor.Y + 1)
ELSE
SetPos(text, text.cursor.X + 1, text.cursor.Y)
END
|40:
UpDown(text, 1)
 
|46: delete(text); ShowCursor; drawCursor := TRUE
 
|ORD("C"):
IF CTRL IN shift THEN
IF selected(text) THEN
copy(text)
END
END
|ORD("X"):
IF CTRL IN shift THEN
IF selected(text) THEN
copy(text);
delSelect(text)
END
END
|ORD("V"):
IF CTRL IN shift THEN
IF CB.available() THEN
paste(text)
END
END
|ORD("A"):
IF CTRL IN shift THEN
text.select2.X := 0;
text.select2.Y := 0;
text.select := text.select2;
SetPos(text, text.last(tLine).length, text.count - 1)
END
|ORD("L"), ORD("U"):
IF CTRL IN shift THEN
changeCase(text, code = ORD("U"))
END
ELSE
END
END key;
 
 
PROCEDURE mouse* (text: tText; x, y: INTEGER);
VAR
cursorX: INTEGER;
BEGIN
DEC(x, padding.left);
DEC(y, padding.top);
cursorX := (x*2) DIV charWidth;
SetPos(text, cursorX DIV 2 + cursorX MOD 2 + text.scroll.X, y DIV charHeight + text.scroll.Y)
END mouse;
 
 
PROCEDURE selectWord* (text: tText);
VAR
cursorX, x1, x2: INTEGER;
line: tLine;
 
PROCEDURE isWordChar (c: WCHAR): BOOLEAN;
RETURN U.isLetter(c) OR U.isDigit(c) OR (c = "_")
END isWordChar;
 
BEGIN
resetSelect(text);
cursorX := text.cursor.X;
line := text.curLine;
x1 := cursorX - 1;
IF (cursorX < line.length) & isWordChar(getChar(line,cursorX)) THEN
x2 := cursorX;
WHILE (x2 < line.length) & isWordChar(getChar(line, x2)) DO
INC(x2)
END
ELSE
WHILE (x1 >= 0) & ~isWordChar(getChar(line, x1)) DO
DEC(x1)
END;
x2 := x1 + 1
END;
WHILE (x1 >= 0) & isWordChar(getChar(line, x1)) DO
DEC(x1)
END;
INC(x1);
IF x1 < x2 THEN
SetPos(text, x1, text.cursor.Y);
setSelect(text);
SetPos(text, x2, text.cursor.Y)
END
END selectWord;
 
 
PROCEDURE cursor (text: tText);
VAR
x, y, h: INTEGER;
cursor: pPoint;
BEGIN
cursor := text.cursor;
IF ~((text.scroll.Y > cursor.Y) OR (text.scroll.Y + textsize.Y <= cursor.Y) OR
(text.scroll.X > cursor.X) OR (text.scroll.X + textsize.X <= cursor.X)) THEN
x := (cursor.X - text.scroll.X)*charWidth + padding.left;
y := (cursor.Y - text.scroll.Y)*charHeight + 1 + padding.top;
h := charHeight - 2;
G.notVLine(canvas, x, y + inter DIV 2, y + h - inter DIV 2);
G.notVLine(canvas, x - 1, y + inter DIV 2, y + h - inter DIV 2)
END
END cursor;
 
 
PROCEDURE drawSelect (text: tText; line: tLine; selBeg, selEnd, y: INTEGER);
VAR
Len, pos, x, firstCharIdx: INTEGER;
BEGIN
firstCharIdx := MAX(text.scroll.X, selBeg);
Len := MAX(MIN(line.length - firstCharIdx, selEnd - firstCharIdx), 0);
Len := MIN(Len, textsize.X - pos + 1);
SetColor(colors.seltext, colors.selback);
pos := MAX((selBeg - text.scroll.X), 0);
x := pos*charWidth + padding.left;
G.SetColor(canvas, colors.selback);
G.FillRect(canvas, x - 2, y - inter DIV 2, x + 1 + Len*charWidth, y - inter DIV 2 + charHeight);
G.TextOut(canvas, pos*charWidth + padding.left, y, Lines.getPChar(line, firstCharIdx), Len)
END drawSelect;
 
 
PROCEDURE mark (line: tLine; y: INTEGER);
VAR
color, i: INTEGER;
BEGIN
IF line.modified THEN
color := colors.modified
ELSIF line.saved THEN
color := colors.saved
ELSE
color := colors.back
END;
G.SetColor(canvas, color);
 
FOR i := 3 TO mark_width + 2 DO
G.VLine(canvas, padding.left - i, y, y + charHeight)
END
END mark;
 
 
PROCEDURE setPadding (left, top: INTEGER);
BEGIN
padding.left := left;
padding.top := top;
textsize.X := (size.X - padding.left) DIV charWidth;
textsize.Y := (size.Y - padding.top) DIV charHeight;
END setPadding;
 
 
PROCEDURE draw* (text: tText);
VAR
y, n, Len, cnt, i, x: INTEGER;
line, firstLine, lastLine: tLine;
selBeg, selEnd: tPoint;
s: ARRAY 12 OF WCHAR;
backColor, numWidth, xNum, wNum: INTEGER;
p: Search.tPos;
guard: tGuard;
BEGIN
IF text.search & search(text, text.searchText, text.cs, text.whole) THEN END;
IF (text.lang # Lang.langNone) & text.comments THEN
Comments(text)
END;
IF text.guard THEN
NEW(guard);
List.append(ChangeLog.Log, guard);
text.edition := guard;
text.guard := FALSE;
ELSE
guard := text.edition
END;
 
guard.cursor := text.cursor^;
guard.select2 := text.select2^;
guard.scroll := text.scroll;
guard.CurX := text.CurX;
guard.selected := text.select = text.select2;
 
G.SetColor(canvas, colors.back);
G.clear(canvas);
IF text.numbers THEN
numWidth := U.lg10(text.count) + 2;
wNum := charWidth;
xNum := numWidth*wNum - wNum DIV 2;
setPadding(numWidth*wNum + pad_left, padding.top);
ELSE
setPadding(pad_left, padding.top)
END;
getSelect(text, selBeg, selEnd);
y := padding.top + inter DIV 2;
n := text.scroll.Y;
line := getLine(text, n);
firstLine := line;
cnt := 0;
WHILE (line # NIL) & (cnt <= textsize.Y) DO
backColor := colors.back;
IF (line = text.curLine) & ~selected(text) THEN
G.SetColor(canvas, colors.curline);
G.FillRect(canvas, padding.left - 2, y - inter DIV 2, size.X - 1, y - inter DIV 2 + charHeight);
backColor := colors.curline
END;
SetColor(colors.text, backColor);
Len := MAX(line.length - text.scroll.X, 0);
G.TextOut(canvas, padding.left, y, Lines.getPChar(line, text.scroll.X), MIN(Len, textsize.X + 1));
IF text.lang # Lang.langNone THEN
parse(text, line, y, backColor, text.lang)
END;
mark(line, y - inter DIV 2);
IF (selBeg.Y < n) & (n < selEnd.Y) THEN
drawSelect(text, line, 0, line.length, y)
ELSIF (selBeg.Y = n) & (selEnd.Y = n) & (selBeg.X # selEnd.X) THEN
drawSelect(text, line, selBeg.X, selEnd.X, y)
ELSIF (selBeg.Y = n) & (selEnd.Y # n) THEN
drawSelect(text, line, selBeg.X, line.length, y)
ELSIF (selBeg.Y # n) & (selEnd.Y = n) THEN
drawSelect(text, line, 0, selEnd.X, y)
END;
NextLine(line);
INC(y, charHeight);
INC(n);
INC(cnt)
END;
IF text.numbers THEN
G.SetColor(canvas, colors.numback);
G.FillRect(canvas, 0, 0, padding.left - pad_left (*+ 1*), size.Y - 1);
SetColor(colors.numtext, colors.numback);
y := padding.top + inter DIV 2;
n := MIN(text.scroll.Y + textsize.Y + 1, text.count);
FOR i := text.scroll.Y + 1 TO n DO
IF (i MOD 10 = 0) OR (i - 1 = text.cursor.Y) THEN
U.int2str(i, s);
G.TextOut2(canvas, (numWidth - U.lg10(i) - 1)*wNum - wNum DIV 2, y, s, LENGTH(s));
ELSIF i MOD 5 = 0 THEN
G.SetColor(canvas, colors.numtext);
G.HLine(canvas, y - inter DIV 2 + charHeight DIV 2, xNum - wNum, xNum)
ELSE
G.SetColor(canvas, colors.numtext);
G.HLine(canvas, y - inter DIV 2 + charHeight DIV 2, xNum - wNum DIV 2, xNum)
END;
INC(y, charHeight)
END
END;
 
IF text.searchText # "" THEN
cnt := 0;
line := firstLine;
lastLine := line;
WHILE (line # NIL) & (cnt <= textsize.Y) DO
lastLine := line;
NextLine(line);
INC(cnt)
END;
p := text.foundList.first(Search.tPos);
WHILE p # NIL DO
y := padding.top + inter DIV 2;
IF (firstLine.pos <= p.pos) & (p.pos <= lastLine.pos + lastLine.length) THEN
line := firstLine;
WHILE (line.pos <= p.pos) & (line # lastLine) DO
NextLine(line);
INC(y, charHeight)
END;
IF (line # lastLine) & (line # firstLine) OR (line = lastLine) & (line.pos > p.pos) THEN
PrevLine(line);
DEC(y, charHeight)
END;
x := (p.pos - line.pos - text.scroll.X)*charWidth + padding.left;
n := LENGTH(text.searchText)*charWidth;
WHILE n > 0 DO
IF x >= padding.left THEN
G.notVLine(canvas, x, y, y + charHeight - inter)
END;
INC(x);
DEC(n)
END;
END;
p := p.next(Search.tPos)
END
END;
 
IF text.foundSel > 0 THEN
x := (text.cursor.X - text.scroll.X)*charWidth + padding.left;
y := (text.cursor.Y - text.scroll.Y)*charHeight + padding.top + inter DIV 2;
n := text.foundSel*charWidth;
WHILE n > 0 DO
IF x >= padding.left THEN
G.xorVLine(canvas, x, y, y + charHeight - inter)
END;
INC(x);
DEC(n)
END
END;
 
IF drawCursor THEN
cursor(text)
END;
G.SetColor(canvas, colors.border);
G.Rect(canvas, 0, 0, size.X - 1, size.Y - 1);
END draw;
 
 
PROCEDURE create (fileName: RW.tFileName): tText;
VAR
text: tText;
BEGIN
NEW(text);
NEW(text.cursor);
NEW(text.select2);
text.cursor.X := 0;
text.cursor.Y := 0;
resetSelect(text);
text.scroll.X := 0;
text.scroll.Y := 0;
setPadding(padding.left, padding.top);
text.curLine := NIL;
text.modified := FALSE;
text.comments := TRUE;
text.search := TRUE;
text.cs := FALSE;
text.whole := FALSE;
text.numbers := TRUE;
text.guard := TRUE;
text.idxData := NIL;
text.edition := NIL;
text.foundList := List.create(NIL);
text.searchText := "";
text.foundSel := 0;
text.CurX := -1;
setName(text, fileName);
ASSERT(text = List.create(text))
RETURN text
END create;
 
 
PROCEDURE setColors* (text, back, seltext, selback, modified, saved, curline, numtext, numback,
comment, string, num, delim, key1, key2, key3, border: INTEGER);
BEGIN
colors.text := text;
colors.back := back;
colors.seltext := seltext;
colors.selback := selback;
colors.modified := modified;
colors.saved := saved;
colors.curline := curline;
colors.numtext := numtext;
colors.numback := numback;
colors.comment := comment;
colors.string := string;
colors.num := num;
colors.delim := delim;
colors.key1 := key1;
colors.key2 := key2;
colors.key3 := key3;
colors.border := border;
END setColors;
 
 
PROCEDURE setCanvas* (Canvas: G.tCanvas);
BEGIN
canvas := Canvas;
charWidth := canvas.font.width;
charHeight := canvas.font.height + inter
END setCanvas;
 
 
PROCEDURE resize* (width, height: INTEGER);
BEGIN
size.X := width;
size.Y := height;
setPadding(padding.left, padding.top)
END resize;
 
 
PROCEDURE destroy* (VAR text: tText);
BEGIN
IF search(text, "", FALSE, FALSE) THEN END;
WHILE text.last # NIL DO
DelLine(text, text.last(tLine))
END;
DISPOSE(text.foundList);
DISPOSE(text.cursor);
DISPOSE(text.select2);
DISPOSE(text)
END destroy;
 
 
PROCEDURE open* (name: RW.tFileName; VAR errno: INTEGER): tText;
VAR
text: tText;
file: RW.tInput;
n, enc: INTEGER;
eol: BOOLEAN;
line: tLine;
BEGIN
errno := 0;
text := NIL;
file := RW.load(name, enc);
IF file # NIL THEN
text := create(name);
text.enc := enc;
REPEAT
line := Lines.create(FALSE);
n := RW.getString(file, line, eol);
IF n >= 0 THEN
List._append(text, line)
ELSE
Lines.destroy(line)
END
UNTIL n < 0;
RW.destroy(file);
IF n = -1 THEN
IF text.count = 0 THEN
List._append(text, Lines.create(FALSE))
END;
text.curLine := text.first(tLine);
SetPos(text, 0, 0);
resetSelect(text)
END
ELSE
errno := 1
END;
IF (text # NIL) & (text.lang # Lang.langNone) THEN
Comments(text)
END
RETURN text
END open;
 
 
PROCEDURE findNext* (text: tText; prev: BOOLEAN): BOOLEAN;
VAR
cursorPos, x, y, X, Y, Len: INTEGER;
p: Search.tPos;
line: tLine;
res: BOOLEAN;
BEGIN
X := text.cursor.X;
Y := text.cursor.Y;
text.cursor.X := MIN(text.cursor.X, text.curLine.length);
cursorPos := text.curLine.pos + text.cursor.X - ORD(prev) - ORD(~prev & (text.foundSel = 0));
p := text.foundList.first(Search.tPos);
WHILE (p # NIL) & (p.pos <= cursorPos) DO
p := p.next(Search.tPos)
END;
IF prev THEN
IF p = NIL THEN
p := text.foundList.last(Search.tPos)
ELSE
p := p.prev(Search.tPos)
END
END;
res := p # NIL;
IF res THEN
y := 0;
line := text.first(tLine);
WHILE (line.pos <= p.pos) & (line.next # NIL) DO
NextLine(line);
INC(y)
END;
IF (line.next # NIL) OR (line.pos > p.pos) THEN
PrevLine(line);
DEC(y)
END;
resetSelect(text);
searchScroll(text, y);
x := p.pos - line.pos;
Len := LENGTH(text.searchText);
IF x + Len > text.scroll.X + textsize.X THEN
text.scroll.X := MAX(x + Len - textsize.X + 3, 0)
ELSIF x < text.scroll.X THEN
text.scroll.X := MAX(x - 3, 0)
END;
SetPos(text, x, y);
text.foundSel := Len
ELSE
SetPos(text, X, Y)
END
RETURN res
END findNext;
 
 
PROCEDURE rewrite (line: tLine; repl: ARRAY OF WCHAR; pos, n: INTEGER);
BEGIN
IF n > 0 THEN
Lines.copy(line)
END;
WHILE n > 0 DO
DEC(n);
Lines.setChar(line, pos + n, repl[n])
END
END rewrite;
 
 
PROCEDURE replace* (text: tText; s: ARRAY OF WCHAR; n: INTEGER);
VAR
line: tLine;
sLen, i: INTEGER;
BEGIN
IF text.foundSel > 0 THEN
line := text.curLine;
sLen := LENGTH(s);
i := text.cursor.X;
IF sLen > n THEN
Lines.insert3(line, i, sLen - n)
END;
SetPos(text, i + sLen, text.cursor.Y);
rewrite(line, s, i, sLen);
IF n > sLen THEN
Lines.delCharN(line, text.cursor.X, n - sLen)
END;
resetSelect(text);
Lines.modify(line);
modify(text)
END
END replace;
 
 
PROCEDURE replaceAll* (text: tText; s: ARRAY OF WCHAR; n: INTEGER): INTEGER;
VAR
p: Search.tPos;
line: tLine;
y, k, d, pos, y0: INTEGER;
BEGIN
resetSelect(text);
SetPos(text, 0, 0);
line := text.first(tLine);
y := 0;
y0 := -1;
k := 0;
d := LENGTH(s) - n;
p := text.foundList.first(Search.tPos);
WHILE p # NIL DO
pos := p.pos;
WHILE (line.pos <= pos) & (line.next # NIL) DO
NextLine(line);
INC(y)
END;
IF (line.next # NIL) OR (line.pos > pos) THEN
PrevLine(line);
DEC(y)
END;
IF y = y0 THEN
INC(k, d)
ELSE
k := 0;
y0 := y
END;
SetPos(text, pos - line.pos + k, y);
text.foundSel := n;
replace(text, s, n);
p := p.next(Search.tPos)
END
RETURN text.foundList.count
END replaceAll;
 
 
PROCEDURE New* (): tText;
VAR
text: tText;
BEGIN
text := create("");
List._append(text, Lines.create(FALSE));
text.curLine := text.first(tLine);
text.enc := E.CP866;
SetPos(text, 0, 0);
resetSelect(text)
RETURN text
END New;
 
 
PROCEDURE empty;
END empty;
 
 
PROCEDURE init* (pShowCursor: tProcedure);
BEGIN
ShowCursor := empty;
IF pShowCursor # NIL THEN
ShowCursor := pShowCursor
END;
pdelete := delete;
drawCursor := TRUE;
padding.left := pad_left;
padding.top := pad_top;
END init;
 
 
END Text.
/programs/develop/cedit/SRC/Utils.ob07
0,0 → 1,352
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Utils;
 
IMPORT SYSTEM;
 
CONST
 
SPACE* = 20X;
SLASH* = "/";
 
OS* = "KOS";
 
 
PROCEDURE streq* (s1, s2: INTEGER; n: INTEGER): BOOLEAN;
VAR
c1, c2: WCHAR;
BEGIN
WHILE n > 0 DO
SYSTEM.GET(s1, c1);
SYSTEM.GET(s2, c2);
INC(s1, 2);
INC(s2, 2);
IF c1 = c2 THEN
DEC(n)
ELSE
n := 0
END
END
RETURN c1 = c2
END streq;
 
 
PROCEDURE append* (VAR s1: ARRAY OF WCHAR; s2: ARRAY OF WCHAR);
VAR
n1, n2, i, j: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
 
ASSERT(n1 + n2 < LEN(s1));
 
i := 0;
j := n1;
WHILE i < n2 DO
s1[j] := s2[i];
INC(i);
INC(j)
END;
 
s1[j] := 0X
END append;
 
 
PROCEDURE append8* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2, i, j: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
 
ASSERT(n1 + n2 < LEN(s1));
 
i := 0;
j := n1;
WHILE i < n2 DO
s1[j] := s2[i];
INC(i);
INC(j)
END;
 
s1[j] := 0X
END append8;
 
 
PROCEDURE reverse* (VAR s: ARRAY OF WCHAR);
VAR
ch: WCHAR;
i, j: INTEGER;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
ch := s[i];
s[i] := s[j];
s[j] := ch;
INC(i);
DEC(j)
END
END reverse;
 
 
PROCEDURE reverse8* (VAR s: ARRAY OF CHAR);
VAR
ch: CHAR;
i, j: INTEGER;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
ch := s[i];
s[i] := s[j];
s[j] := ch;
INC(i);
DEC(j)
END
END reverse8;
 
 
PROCEDURE int2str* (val: INTEGER; VAR s: ARRAY OF WCHAR);
VAR
i: INTEGER;
BEGIN
i := 0;
REPEAT
s[i] := WCHR(ORD("0") + val MOD 10);
INC(i);
val := val DIV 10
UNTIL val = 0;
s[i] := 0X;
reverse(s)
END int2str;
 
 
PROCEDURE isDigit* (ch: WCHAR): BOOLEAN;
RETURN ("0" <= ch) & (ch <= "9")
END isDigit;
 
 
PROCEDURE isHex* (ch: WCHAR): BOOLEAN;
RETURN ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")
END isHex;
 
 
PROCEDURE isLetter* (ch: WCHAR): BOOLEAN;
RETURN ("a" <= ch) & (ch <= "z") OR ("A" <= ch) & (ch <= "Z")
END isLetter;
 
 
PROCEDURE cap* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("a" <= ch) & (ch <= "z") THEN
ch := WCHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (430H <= ORD(ch)) & (ORD(ch) <= 44FH) THEN
ch := WCHR(ORD(ch) - 20H);
res := TRUE
ELSIF (450H <= ORD(ch)) & (ORD(ch) <= 45FH) THEN
ch := WCHR(ORD(ch) - 50H);
res := TRUE
ELSIF ch = 491X THEN
ch := 490X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END cap;
 
 
PROCEDURE cap8 (VAR ch: CHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("a" <= ch) & (ch <= "z") THEN
ch := CHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSE
res := FALSE
END
RETURN res
END cap8;
 
 
PROCEDURE upcase* (VAR s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF cap8(s[i]) THEN
END;
DEC(i)
END;
END upcase;
 
 
PROCEDURE upcase16* (VAR s: ARRAY OF WCHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF cap(s[i]) THEN
END;
DEC(i)
END
END upcase16;
 
 
PROCEDURE low* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("A" <= ch) & (ch <= "Z") THEN
ch := WCHR(ORD(ch) + (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (410H <= ORD(ch)) & (ORD(ch) <= 42FH) THEN
ch := WCHR(ORD(ch) + 20H);
res := TRUE
ELSIF (400H <= ORD(ch)) & (ORD(ch) <= 40FH) THEN
ch := WCHR(ORD(ch) + 50H);
res := TRUE
ELSIF ch = 490X THEN
ch := 491X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END low;
 
 
PROCEDURE str2int* (s: ARRAY OF WCHAR; VAR val: INTEGER): BOOLEAN;
VAR
i, temp: INTEGER;
res, neg: BOOLEAN;
BEGIN
temp := 0;
res := TRUE;
neg := FALSE;
i := 0;
WHILE (s[i] # 0X) & (s[i] = SPACE) DO
INC(i)
END;
 
IF s[i] = "-" THEN
INC(i);
neg := TRUE
ELSIF s[i] = "+" THEN
INC(i)
END;
 
IF isDigit(s[i]) THEN
REPEAT
temp := temp * 10;
temp := temp + (ORD(s[i]) - ORD("0"));
INC(i)
UNTIL ~isDigit(s[i]);
IF neg THEN
temp := -temp
END;
val := temp
ELSE
res := FALSE
END
 
RETURN res
END str2int;
 
 
PROCEDURE getFileName* (path: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; ch: CHAR);
VAR
i, j: INTEGER;
BEGIN
j := 0;
i := LENGTH(path) - 1;
WHILE (i >= 0) & (path[i] # ch) DO
name[j] := path[i];
DEC(i);
INC(j)
END;
name[j] := 0X;
reverse8(name)
END getFileName;
 
 
PROCEDURE getPath* (fname: ARRAY OF CHAR; VAR path: ARRAY OF CHAR);
VAR
i, j: INTEGER;
BEGIN
j := 0;
i := LENGTH(fname) - 1;
WHILE (i >= 0) & (fname[i] # SLASH) DO
DEC(i)
END;
path := fname;
path[i] := 0X
END getPath;
 
 
PROCEDURE lg10* (n: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := 0;
WHILE n >= 10 DO
n := n DIV 10;
INC(res)
END
RETURN res
END lg10;
 
 
PROCEDURE sgn* (x: INTEGER): INTEGER;
BEGIN
IF x > 0 THEN
x := 1
ELSIF x < 0 THEN
x := -1
ELSE
x := 0
END
RETURN x
END sgn;
 
 
PROCEDURE ptr2str* (ptr: INTEGER; VAR s: ARRAY OF CHAR);
VAR
i, n: INTEGER;
BEGIN
i := -1;
n := LEN(s) - 1;
REPEAT
INC(i);
SYSTEM.GET(ptr, s[i]);
INC(ptr)
UNTIL (i = n) OR (s[i] = 0X);
s[i] := 0X
END ptr2str;
 
 
END Utils.
/programs/develop/cedit/SRC/box_lib.ob07
0,0 → 1,289
(*
Copyright 2016, 2017, 2020, 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. 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;
type: 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: edit_box;
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;
 
EditBoxKey = PROCEDURE (eb: edit_box);
 
 
VAR
 
check_box_draw2 *: PROCEDURE (cb: checkbox);
check_box_mouse2 *: PROCEDURE (cb: checkbox);
init_checkbox2 : PROCEDURE (cb: checkbox);
 
scrollbar_h_draw *: PROCEDURE (sb: scrollbar);
scrollbar_h_mouse *: PROCEDURE (sb: scrollbar);
scrollbar_v_draw *: PROCEDURE (sb: scrollbar);
scrollbar_v_mouse *: PROCEDURE (sb: scrollbar);
 
edit_box_draw *: PROCEDURE (eb: edit_box);
__edit_box_key : EditBoxKey;
edit_box_mouse *: PROCEDURE (eb: edit_box);
edit_box_set_text *: PROCEDURE (eb: edit_box; text: INTEGER);
 
 
PROCEDURE _edit_box_key (key: INTEGER; key_proc: EditBoxKey; text: edit_box);
BEGIN
sys.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 055H, 00CH, (* mov edx, dword [ebp + 12] *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
051H, (* push ecx *)
0FFH, 0D2H (* call edx *)
)
END _edit_box_key;
 
 
PROCEDURE edit_box_key* (text: edit_box; key: INTEGER);
BEGIN
_edit_box_key(key, __edit_box_key, text)
END edit_box_key;
 
 
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: INTEGER; label_text: ARRAY OF CHAR; 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 := KOSAPI.malloc(LENGTH(label_text) + 1);
sys.MOVE(sys.ADR(label_text[0]), new_checkbox.text, LENGTH(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: 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.type := 1;
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: 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)
END kolibri_new_scrollbar;
 
 
PROCEDURE kolibri_new_edit_box* (tlx, tly, width, max_chars: INTEGER; editbox_interlock: edit_box): 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 := 0;
new_textbox.max := max_chars;
new_textbox.text := KOSAPI.malloc(max_chars + 2);
ASSERT(new_textbox.text # 0);
new_textbox.mouse_variable := editbox_interlock;
new_textbox.flags := 0
 
RETURN new_textbox
END kolibri_new_edit_box;
 
 
PROCEDURE main;
VAR Lib: INTEGER;
 
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
sys.PUT(v, a)
END GetProc;
 
BEGIN
Lib := KOSAPI.LoadLib("/rd/1/lib/box_lib.obj");
ASSERT(Lib # 0);
GetProc(Lib, sys.ADR(check_box_draw2), "check_box_draw2");
GetProc(Lib, sys.ADR(check_box_mouse2), "check_box_mouse2");
GetProc(Lib, sys.ADR(init_checkbox2), "init_checkbox2");
GetProc(Lib, sys.ADR(scrollbar_h_draw), "scrollbar_h_draw");
GetProc(Lib, sys.ADR(scrollbar_h_mouse), "scrollbar_h_mouse");
GetProc(Lib, sys.ADR(scrollbar_v_draw), "scrollbar_v_draw");
GetProc(Lib, sys.ADR(scrollbar_v_mouse), "scrollbar_v_mouse");
GetProc(Lib, sys.ADR(edit_box_draw), "edit_box");
GetProc(Lib, sys.ADR(__edit_box_key), "edit_box_key");
GetProc(Lib, sys.ADR(edit_box_mouse), "edit_box_mouse");
GetProc(Lib, sys.ADR(edit_box_set_text), "edit_box_set_text");
END main;
 
 
BEGIN
main
END box_lib.
/programs/develop/cedit/SRC/libimg.ob07
0,0 → 1,120
(*
Copyright 2016, 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE LibImg;
 
IMPORT SYSTEM, KOSAPI, File;
 
 
VAR
 
file : INTEGER;
 
img_decode : PROCEDURE (data, size, options: INTEGER): INTEGER;
img_to_rgb2 : PROCEDURE (data, data_rgb: INTEGER);
img_scale : PROCEDURE (src, crop_x, crop_y, crop_width, crop_height, dst, scale, inter, param1, param2: INTEGER): INTEGER;
 
img_destroy* : PROCEDURE (img: INTEGER);
 
 
PROCEDURE GetInf*(img: INTEGER; VAR sizeX, sizeY, data: INTEGER);
BEGIN
SYSTEM.GET(img + 4, sizeX);
SYSTEM.GET(img + 8, sizeY);
SYSTEM.GET(img + 24, data);
END GetInf;
 
 
PROCEDURE GetImg*(ptr, n, Width: INTEGER; VAR sizeY: INTEGER): INTEGER;
VAR image_data, dst, x, y, type, rgb, data: INTEGER;
BEGIN
image_data := img_decode(ptr, n, 0);
IF image_data # 0 THEN
SYSTEM.GET(image_data + 4, x);
SYSTEM.GET(image_data + 8, y);
SYSTEM.GET(image_data + 20, type);
IF type # 2 THEN
rgb := KOSAPI.malloc(x * y * 3);
IF rgb # 0 THEN
img_to_rgb2(image_data, rgb);
SYSTEM.GET(image_data + 24, data);
data := KOSAPI.free(data);
SYSTEM.PUT(image_data + 24, rgb);
SYSTEM.PUT(image_data + 20, 2)
ELSE
img_destroy(image_data);
image_data := 0
END
END;
IF (x > Width) & (image_data # 0) THEN
dst := img_scale(image_data, 0, 0, x, y, dst, 3, 1, Width, (y * Width) DIV x);
img_destroy(image_data);
image_data := dst
END;
IF image_data # 0 THEN
SYSTEM.GET(image_data + 8, sizeY)
END
END
RETURN image_data
END GetImg;
 
 
PROCEDURE LoadFromFile* (FName: ARRAY OF CHAR; Width: INTEGER; VAR sizeY: INTEGER): INTEGER;
VAR F: File.FS; n, size, res: INTEGER;
BEGIN
res := 0;
F := File.Open(FName);
IF F # NIL THEN
size := File.Seek(F, 0, File.SEEK_END);
n := File.Seek(F, 0, File.SEEK_BEG);
file := KOSAPI.malloc(size + 1024);
IF file # 0 THEN
n := File.Read(F, file, size);
res := GetImg(file, n, Width, sizeY);
n := KOSAPI.free(file)
END;
File.Close(F)
END
RETURN res
END LoadFromFile;
 
 
PROCEDURE load;
VAR Lib: INTEGER;
 
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
SYSTEM.PUT(v, a)
END GetProc;
 
BEGIN
Lib := KOSAPI.LoadLib("/rd/1/Lib/Libimg.obj");
GetProc(Lib, SYSTEM.ADR(img_decode), "img_decode");
GetProc(Lib, SYSTEM.ADR(img_destroy), "img_destroy");
GetProc(Lib, SYSTEM.ADR(img_to_rgb2), "img_to_rgb2");
GetProc(Lib, SYSTEM.ADR(img_scale), "img_scale");
END load;
 
 
BEGIN
load
END LibImg.
/programs/develop/cedit/SRC/scroll.ob07
0,0 → 1,143
(*
Copyright 2021 Anton Krotov
 
This file is part of CEdit.
 
CEdit 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.
 
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE Scroll;
 
IMPORT G := Graph;
 
TYPE
 
tScroll* = POINTER TO RECORD
vertical, mouse: BOOLEAN;
canvas: G.tCanvas;
xSize*, ySize*, pos, mousePos: INTEGER;
color, bkColor: INTEGER;
value*, maxVal*: INTEGER
END;
 
 
PROCEDURE draw* (scroll: tScroll; x, y: INTEGER);
VAR
pos, a, b: INTEGER;
canvas: G.tCanvas;
BEGIN
IF scroll.vertical THEN
a := scroll.ySize;
b := scroll.xSize
ELSE
a := scroll.xSize;
b := scroll.ySize
END;
IF scroll.maxVal > 0 THEN
pos := (a - b)*scroll.value DIV scroll.maxVal
ELSE
pos := 0
END;
canvas := scroll.canvas;
G.SetColor(canvas, scroll.bkColor);
G.clear(canvas);
G.SetColor(canvas, 0808080H);
G.Rect(canvas, 0, 0, scroll.xSize - 1, scroll.ySize - 1);
G.SetColor(canvas, scroll.color);
DEC(b, 2);
IF scroll.vertical THEN
G.FillRect(canvas, 1, pos + 1, b, pos + b);
G.SetColor(canvas, 0404040H);
G.HLine(canvas, pos + 1 + b DIV 2, 4, b - 4);
G.HLine(canvas, pos + 1 + b DIV 2 - 3, 6, b - 6);
G.HLine(canvas, pos + 1 + b DIV 2 + 3, 6, b - 6);
ELSE
G.FillRect(canvas, pos + 1, 1, pos + b, b);
G.SetColor(canvas, 0404040H);
G.VLine(canvas, pos + b DIV 2, 4, b - 4);
G.VLine(canvas, pos + b DIV 2 - 3, 6, b - 6);
G.VLine(canvas, pos + b DIV 2 + 3, 6, b - 6);
END;
scroll.pos := pos;
G.DrawCanvas(canvas, x, y);
END draw;
 
 
PROCEDURE create* (xSize, ySize: INTEGER; color, bkColor: INTEGER): tScroll;
VAR
scroll: tScroll;
BEGIN
NEW(scroll);
scroll.xSize := xSize;
scroll.ySize := ySize;
scroll.vertical := xSize < ySize;
scroll.maxVal := 30;
scroll.value := 0;
scroll.mouse := FALSE;
scroll.bkColor := bkColor;
scroll.color := color;
scroll.canvas := G.CreateCanvas(xSize, ySize)
RETURN scroll
END create;
 
 
PROCEDURE resize* (scroll: tScroll; xSize, ySize: INTEGER);
BEGIN
scroll.xSize := xSize;
scroll.ySize := ySize;
scroll.vertical := xSize < ySize;
G.destroy(scroll.canvas);
scroll.canvas := G.CreateCanvas(xSize, ySize);
END resize;
 
 
PROCEDURE mouse* (scroll: tScroll; x, y: INTEGER);
VAR
pos, b: INTEGER;
BEGIN
IF scroll.vertical THEN
pos := y - 1;
b := scroll.xSize - 2
ELSE
pos := x - 1;
b := scroll.ySize - 2
END;
IF ~scroll.mouse THEN
scroll.mouse := TRUE;
IF (scroll.pos <= pos) & (pos <= scroll.pos + b - 1) THEN
scroll.mousePos := pos - scroll.pos
ELSE
scroll.mousePos := b DIV 2;
scroll.value := (pos - scroll.mousePos)*scroll.maxVal DIV ABS(scroll.xSize - scroll.ySize)
END
ELSE
scroll.value := (pos - scroll.mousePos)*scroll.maxVal DIV ABS(scroll.xSize - scroll.ySize)
END;
IF scroll.value < 0 THEN
scroll.value := 0
ELSIF scroll.value > scroll.maxVal THEN
scroll.value := scroll.maxVal
END
END mouse;
 
 
PROCEDURE MouseUp* (scroll: tScroll);
BEGIN
IF scroll # NIL THEN
scroll.mouse := FALSE
END
END MouseUp;
 
 
END Scroll.