diff --git a/programs/develop/cedit/CEDIT b/programs/develop/cedit/CEDIT new file mode 100644 index 0000000000..e82ee7fff3 Binary files /dev/null and b/programs/develop/cedit/CEDIT differ diff --git a/programs/develop/cedit/CEDIT.INI b/programs/develop/cedit/CEDIT.INI new file mode 100644 index 0000000000..99e98479ea --- /dev/null +++ b/programs/develop/cedit/CEDIT.INI @@ -0,0 +1,67 @@ +[color_Dark] +text=207,208,209 +back=31,34,39 +seltext=255,255,255 +selback=64,67,71 +modified=232,232,0 +saved=0,208,0 +curline=37,40,45 +numtext=75,77,81 +numback=230,230,230 + +comment=78,106,135 +string=245,238,162 +num=237,110,85 +delim=255,79,104 +key1=255,79,104 +key2=188,112,253 +key3=188,112,253 + +[color_Light] +text=0,0,0 +back=255,255,255 +seltext=255,255,255 +selback=0,0,255 +modified=232,232,0 +saved=0,208,0 +curline=255,255,200 +numtext=0,0,0 +numback=230,230,230 + +comment=128,0,128 +string=0,128,0 +num=128,0,0 +delim=0,0,128 +key1=0,0,128 +key2=0,128,128 +key3=0,128,128 + +[lang_Oberon] +KW1 = ARRAY,BEGIN,BY,CASE,CONST,DIV,DO,ELSE,ELSIF,END,FALSE,FOR,IF,IMPORT,IN,IS,MOD,MODULE,NIL,OF,OR,POINTER,PROCEDURE,RECORD,REPEAT,RETURN,THEN,TO,TRUE,TYPE,UNTIL,VAR,WHILE +KW2 = ABS,ASR,ASSERT,BITS,BOOLEAN,BYTE,CHAR,CHR,COPY,DEC,DISPOSE,EXCL,FLOOR,FLT,INC,INCL,INTEGER,LEN,LENGTH,LSL,LSR,MAX,MIN,NEW,ODD,ORD,PACK,REAL,ROR,SET,UNPK,WCHAR,WCHR +KW3 = + +[lang_Pascal] +KW1 = AND,ARRAY,BEGIN,CASE,CONST,DIV,DO,DOWNTO,ELSE,END,FILE,FOR,FUNCTION,GOTO,IF,IMPLEMENTATION,IN,INTERFACE,LABEL,MOD,NIL,NOT,OF,OR,PACKED,PROCEDURE,PROGRAM,RECORD,REPEAT,SET,SHL,SHR,STRING,THEN,TO,TYPE,UNIT,UNTIL,USES,VAR,WHILE,WITH,XOR +KW2 = +KW3 = + +[lang_C] +KW1 = auto,break,case,char,const,continue,default,do,double,else,enum,extern,float,for,goto,if,int,long,register,return,short,signed,sizeof,static,struct,switch,typedef,union,unsigned,void,volatile,while +KW2 = #define,#error,#include,#elif,#if,#line,#else,#ifdef,#pragma,#endif,#ifndef,#undef +KW3 = + +[lang_Lua] +KW1 = and,break,do,else,elseif,end,false,goto,for,function,if,in,local,nil,not,or,repeat,return,then,true,until,while +KW2 = +KW3 = + +[lang_Ini] +KW1 = auto,default,disabled,false,none,true +KW2 = +KW3 = + +[lang_Fasm] +KW1 = +KW2 = +KW3 = diff --git a/programs/develop/cedit/README.TXT b/programs/develop/cedit/README.TXT new file mode 100644 index 0000000000..442e68f400 --- /dev/null +++ b/programs/develop/cedit/README.TXT @@ -0,0 +1,23 @@ +Горячие клавиши: + + ctrl+A выделить всё + ctrl+C копировать + ctrl+V вставить + ctrl+X вырезать + ctrl+L преобразовать буквы A..Z слева от курсора в a..z + ctrl+U преобразовать буквы a..z слева от курсора в A..Z + ctrl+F поиск/замена + F3 найти следующий + ctrl+Z отменить + ctrl+Y вернуть + ctrl+G перейти на строку... + + ctrl+S сохранить + ctrl+O открыть + ctrl+N создать новый + + ctrl+F9 компилировать + F9 выполнить + + перемещение по тексту: + (ctrl+)Home, (ctrl+)End, (ctrl+)PageUp, (ctrl+)PageDown diff --git a/programs/develop/cedit/SRC/API.ob07 b/programs/develop/cedit/SRC/API.ob07 new file mode 100644 index 0000000000..c740a95f36 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/CEdit.ob07 b/programs/develop/cedit/SRC/CEdit.ob07 new file mode 100644 index 0000000000..611d8bdeba --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/ChangeLog.ob07 b/programs/develop/cedit/SRC/ChangeLog.ob07 new file mode 100644 index 0000000000..20e1b7344f --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Clipboard.ob07 b/programs/develop/cedit/SRC/Clipboard.ob07 new file mode 100644 index 0000000000..bd615c6ed6 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Encodings.ob07 b/programs/develop/cedit/SRC/Encodings.ob07 new file mode 100644 index 0000000000..0007b452c7 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/File.ob07 b/programs/develop/cedit/SRC/File.ob07 new file mode 100644 index 0000000000..dc99a0c680 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Graph.ob07 b/programs/develop/cedit/SRC/Graph.ob07 new file mode 100644 index 0000000000..d9fc8f3c1e --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Ini.ob07 b/programs/develop/cedit/SRC/Ini.ob07 new file mode 100644 index 0000000000..ecf1622b03 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/KOSAPI.ob07 b/programs/develop/cedit/SRC/KOSAPI.ob07 new file mode 100644 index 0000000000..84a881bbaf --- /dev/null +++ b/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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/KolibriOS.ob07 b/programs/develop/cedit/SRC/KolibriOS.ob07 new file mode 100644 index 0000000000..adb5114ea8 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Languages.ob07 b/programs/develop/cedit/SRC/Languages.ob07 new file mode 100644 index 0000000000..d949d51fcc --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Lines.ob07 b/programs/develop/cedit/SRC/Lines.ob07 new file mode 100644 index 0000000000..e1338e2c1c --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/List.ob07 b/programs/develop/cedit/SRC/List.ob07 new file mode 100644 index 0000000000..c93b8434c7 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Menu.ob07 b/programs/develop/cedit/SRC/Menu.ob07 new file mode 100644 index 0000000000..e19942bf0d --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/OpenDlg.ob07 b/programs/develop/cedit/SRC/OpenDlg.ob07 new file mode 100644 index 0000000000..36acbf3d51 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/RTL.ob07 b/programs/develop/cedit/SRC/RTL.ob07 new file mode 100644 index 0000000000..0818bca97d --- /dev/null +++ b/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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/RW.ob07 b/programs/develop/cedit/SRC/RW.ob07 new file mode 100644 index 0000000000..8ed45d7ba8 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Search.ob07 b/programs/develop/cedit/SRC/Search.ob07 new file mode 100644 index 0000000000..6b94569818 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Text.ob07 b/programs/develop/cedit/SRC/Text.ob07 new file mode 100644 index 0000000000..06608de3ee --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/Utils.ob07 b/programs/develop/cedit/SRC/Utils.ob07 new file mode 100644 index 0000000000..33bf4115ab --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file diff --git a/programs/develop/cedit/SRC/box_lib.ob07 b/programs/develop/cedit/SRC/box_lib.ob07 new file mode 100644 index 0000000000..b78a2e6aa3 --- /dev/null +++ b/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 . +*) + +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. diff --git a/programs/develop/cedit/SRC/libimg.ob07 b/programs/develop/cedit/SRC/libimg.ob07 new file mode 100644 index 0000000000..14784d20dc --- /dev/null +++ b/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 . +*) + +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. diff --git a/programs/develop/cedit/SRC/scroll.ob07 b/programs/develop/cedit/SRC/scroll.ob07 new file mode 100644 index 0000000000..9cb778dfc1 --- /dev/null +++ b/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 . +*) + +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. \ No newline at end of file