aabc2/KOS_qrcodes
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

cedit: brand new Code Editor by akron1, upload version 20-may-2021 http://board.kolibrios.org/viewtopic.php?f=46&t=4420

Browse Source 
git-svn-id: svn://kolibrios.org@8728 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Kiril Lipatov
2021-05-23 09:43:28 +00:00
parent 7e4af1f028
commit ffc66daaff
26 changed files with 9866 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
programs/develop/cedit/CEDIT Normal file
View File

Binary file not shown.

67
programs/develop/cedit/CEDIT.INI Normal file
View File

@@ -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 =

23
programs/develop/cedit/README.TXT Normal file
View File

@@ -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

332
programs/develop/cedit/SRC/API.ob07 Normal file
View File

@@ -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.

1658
programs/develop/cedit/SRC/CEdit.ob07 Normal file
View File

File diff suppressed because it is too large Load Diff

188
programs/develop/cedit/SRC/ChangeLog.ob07 Normal file
View File

@@ -0,0 +1,188 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE ChangeLog;
IMPORT List, Lines, (*API,*) SYSTEM;
TYPE
tIntItem = POINTER TO RECORD (List.tItem)
adr, val: INTEGER
END;
tBoolItem = POINTER TO RECORD (List.tItem)
adr: INTEGER; val: BOOLEAN
END;
(*
tUntypedPtr = POINTER TO RECORD (List.tItem)
p: INTEGER
END;
tTypedPtr = POINTER TO RECORD (List.tItem)
p: List.tItem
END;
*)
tGuard* = POINTER TO RECORD (List.tItem)
END;
VAR
Log*: List.tList;
guard: tGuard;
isLast: BOOLEAN;
PROCEDURE isLastGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
res: BOOLEAN;
BEGIN
IF guard # NIL THEN
item := Log.last;
WHILE ~(item IS tGuard) DO
item := item.prev
END;
res := guard = item
ELSE
res := TRUE
END
RETURN res
END isLastGuard;
PROCEDURE isFirstGuard* (guard: tGuard): BOOLEAN;
VAR
item: List.tItem;
BEGIN
ASSERT(guard # NIL);
item := Log.first;
WHILE ~(item IS tGuard) DO
item := item.next
END
RETURN guard = item
END isFirstGuard;
PROCEDURE setGuard* (_guard: tGuard);
BEGIN
guard := _guard;
isLast := isLastGuard(_guard)
END setGuard;
PROCEDURE redo* (item: List.tItem);
BEGIN
IF item IS tIntItem THEN
SYSTEM.PUT(item(tIntItem).adr, item(tIntItem).val)
ELSIF item IS tBoolItem THEN
SYSTEM.PUT(item(tBoolItem).adr, item(tBoolItem).val)
END
END redo;
PROCEDURE clear (guard: tGuard);
VAR
item: List.tItem;
(*res: INTEGER;*)
BEGIN
isLast := TRUE;
REPEAT
item := List.pop(Log);
IF item # guard THEN
(*
IF item IS tUntypedPtr THEN
res := API._DISPOSE(item(tUntypedPtr).p)
ELSIF item IS tTypedPtr THEN
DISPOSE(item(tTypedPtr).p)
END;*)
DISPOSE(item)
END
UNTIL item = guard;
List.append(Log, item)
END clear;
PROCEDURE changeWord (adrV, adrX: INTEGER);
VAR
item: tIntItem;
BEGIN
NEW(item);
item.adr := adrV;
SYSTEM.GET(adrX, item.val);
IF ~isLast THEN
clear(guard)
END;
List.append(Log, item)
END changeWord;
PROCEDURE changeBool (VAR v: BOOLEAN; x: BOOLEAN);
VAR
item: tBoolItem;
BEGIN
NEW(item);
item.adr := SYSTEM.ADR(v);
item.val := x;
IF ~isLast THEN
clear(guard)
END;
List.append(Log, item)
END changeBool;
PROCEDURE changeInt (VAR v: INTEGER; x: INTEGER);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changeInt;
PROCEDURE changePtr (VAR v: List.tItem; x: List.tItem);
BEGIN
changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changePtr;
(*
PROCEDURE typedPtr (p: List.tItem);
VAR
item: tTypedPtr;
BEGIN
NEW(item);
item.p := p;
List.append(Log, item)
END typedPtr;
PROCEDURE untypedPtr (p: INTEGER);
VAR
item: tUntypedPtr;
BEGIN
NEW(item);
item.p := p;
List.append(Log, item)
END untypedPtr;
*)
BEGIN
guard := NIL;
isLast := TRUE;
List.init(changeInt, changePtr);
Lines.init(changeInt, changePtr, changeBool(*, typedPtr, untypedPtr*));
Log := List.create(NIL)
END ChangeLog.

169
programs/develop/cedit/SRC/Clipboard.ob07 Normal file
View File

@@ -0,0 +1,169 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Clipboard;
IMPORT SYSTEM, K := KOSAPI, E := Encodings, Lines;
CONST
TTEXT = 0;
lenEOL* = 2;
TYPE
tBuffer* = POINTER TO RECORD
dataPtr*: INTEGER;
pos: INTEGER
END;
PROCEDURE free (ptr: INTEGER);
BEGIN
ptr := K.free(ptr)
END free;
PROCEDURE bufSize* (buffer: tBuffer): INTEGER;
RETURN buffer.pos - buffer.dataPtr
END bufSize;
PROCEDURE put* (buffer: tBuffer);
VAR
a, cnt, size: INTEGER;
ptr, pchar: INTEGER;
wch: WCHAR;
BEGIN
cnt := bufSize(buffer) DIV 2;
size := cnt + 12;
a := K.malloc(size);
ASSERT(a # 0);
SYSTEM.PUT32(a, size);
SYSTEM.PUT32(a + 4, TTEXT);
SYSTEM.PUT32(a + 8, 1);
pchar := a + 12;
ptr := buffer.dataPtr;
WHILE cnt > 0 DO
SYSTEM.GET(ptr, wch);
SYSTEM.PUT(pchar, CHR(E.UNI[ORD(wch), E.CP866] MOD 256));
INC(pchar);
INC(ptr, 2);
DEC(cnt)
END;
K.sysfunc2(54, 3);
K.sysfunc4(54, 2, size, a)
END put;
PROCEDURE create* (bufSize: INTEGER): tBuffer;
VAR
res: tBuffer;
BEGIN
NEW(res);
res.dataPtr := K.malloc(bufSize*SYSTEM.SIZE(WCHAR) + 4096);
ASSERT(res.dataPtr # 0);
res.pos := res.dataPtr
RETURN res
END create;
PROCEDURE destroy* (VAR buffer: tBuffer);
BEGIN
IF buffer # NIL THEN
IF buffer.dataPtr # 0 THEN
free(buffer.dataPtr)
END;
DISPOSE(buffer)
END
END destroy;
PROCEDURE append* (buffer: tBuffer; line: Lines.tLine; first, last: INTEGER);
VAR
strSize: INTEGER;
BEGIN
strSize := (last - first + 1)*SYSTEM.SIZE(WCHAR);
IF strSize > 0 THEN
SYSTEM.MOVE(Lines.getPChar(line, first), buffer.pos, strSize);
INC(buffer.pos, strSize)
END
END append;
PROCEDURE appends* (buffer: tBuffer; s: ARRAY OF WCHAR; first, last: INTEGER);
VAR
strSize: INTEGER;
BEGIN
strSize := (last - first + 1)*SYSTEM.SIZE(WCHAR);
IF strSize > 0 THEN
SYSTEM.MOVE(SYSTEM.ADR(s[first]), buffer.pos, strSize);
INC(buffer.pos, strSize)
END
END appends;
PROCEDURE eol* (buffer: tBuffer);
VAR
s: ARRAY 2 OF WCHAR;
BEGIN
s[0] := 0DX; s[1] := 0AX;
appends(buffer, s, 0, 1)
END eol;
PROCEDURE eot* (buffer: tBuffer);
END eot;
PROCEDURE available* (): BOOLEAN;
VAR
ptr: INTEGER;
n, size, typ, x: INTEGER;
res: BOOLEAN;
BEGIN
res := FALSE;
n := K.sysfunc2(54, 0);
IF n > 0 THEN
ptr := K.sysfunc3(54, 1, n - 1);
SYSTEM.GET32(ptr, size);
SYSTEM.GET32(ptr + 4, typ);
SYSTEM.GET(ptr + 8, x);
res := (typ = TTEXT) & (x = 1);
free(ptr)
END
RETURN res
END available;
PROCEDURE get* (VAR cnt: INTEGER): INTEGER;
VAR
ptr: INTEGER;
BEGIN
ptr := 0;
cnt := 0;
IF available() THEN
ptr := K.sysfunc3(54, 1, K.sysfunc2(54, 0) - 1);
SYSTEM.GET32(ptr, cnt);
DEC(cnt, 12);
INC(ptr, 12)
END
RETURN ptr
END get;
END Clipboard.

127
programs/develop/cedit/SRC/Encodings.ob07 Normal file
View File

@@ -0,0 +1,127 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Encodings;
CONST
CP866* = 0; W1251* = 1; UTF8* = 2; UTF8BOM* = 3; UTF16LE* = 4;
UNDEF* = -1;
TYPE
CP = ARRAY 256 OF INTEGER;
VAR
cpW1251*, cp866*: CP;
UNI*: ARRAY 65536, 2 OF INTEGER;
PROCEDURE InitCP (VAR cp: CP);
VAR
i: INTEGER;
BEGIN
FOR i := 0H TO 7FH DO
cp[i] := i
END
END InitCP;
PROCEDURE Init8 (VAR cp: CP; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER);
BEGIN
cp[n] := a; INC(n);
cp[n] := b; INC(n);
cp[n] := c; INC(n);
cp[n] := d; INC(n);
cp[n] := e; INC(n);
cp[n] := f; INC(n);
cp[n] := g; INC(n);
cp[n] := h; INC(n);
END Init8;
PROCEDURE InitW1251 (VAR cp: CP);
VAR
n, i: INTEGER;
BEGIN
n := 80H;
Init8(cp, n, 0402H, 0403H, 201AH, 0453H, 201EH, 2026H, 2020H, 2021H);
Init8(cp, n, 20ACH, 2030H, 0409H, 2039H, 040AH, 040CH, 040BH, 040FH);
Init8(cp, n, 0452H, 2018H, 2019H, 201CH, 201DH, 2022H, 2013H, 2014H);
Init8(cp, n, UNDEF, 2122H, 0459H, 203AH, 045AH, 045CH, 045BH, 045FH);
Init8(cp, n, 00A0H, 040EH, 045EH, 0408H, 00A4H, 0490H, 00A6H, 00A7H);
Init8(cp, n, 0401H, 00A9H, 0404H, 00ABH, 00ACH, 00ADH, 00AEH, 0407H);
Init8(cp, n, 00B0H, 00B1H, 0406H, 0456H, 0491H, 00B5H, 00B6H, 00B7H);
Init8(cp, n, 0451H, 2116H, 0454H, 00BBH, 0458H, 0405H, 0455H, 0457H);
FOR i := 0410H TO 044FH DO
cp[i - 350H] := i
END;
InitCP(cp)
END InitW1251;
PROCEDURE InitCP866 (VAR cp: CP);
VAR
n, i: INTEGER;
BEGIN
FOR i := 0410H TO 043FH DO
cp[i - 0410H + 80H] := i
END;
FOR i := 0440H TO 044FH DO
cp[i - 0440H + 0E0H] := i
END;
n := 0B0H;
Init8(cp, n, 2591H, 2592H, 2593H, 2502H, 2524H, 2561H, 2562H, 2556H);
Init8(cp, n, 2555H, 2563H, 2551H, 2557H, 255DH, 255CH, 255BH, 2510H);
Init8(cp, n, 2514H, 2534H, 252CH, 251CH, 2500H, 253CH, 255EH, 255FH);
Init8(cp, n, 255AH, 2554H, 2569H, 2566H, 2560H, 2550H, 256CH, 2567H);
Init8(cp, n, 2568H, 2564H, 2565H, 2559H, 2558H, 2552H, 2553H, 256BH);
Init8(cp, n, 256AH, 2518H, 250CH, 2588H, 2584H, 258CH, 2590H, 2580H);
n := 0F0H;
Init8(cp, n, 0401H, 0451H, 0404H, 0454H, 0407H, 0457H, 040EH, 045EH);
Init8(cp, n, 00B0H, 2219H, 00B7H, 221AH, 2116H, 00A4H, 25A0H, 00A0H);
InitCP(cp)
END InitCP866;
PROCEDURE setUNI;
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 65535 DO
UNI[i, CP866] := UNDEF;
UNI[i, W1251] := UNDEF;
END;
FOR i := 0 TO 255 DO
IF cpW1251[i] # UNDEF THEN
UNI[cpW1251[i], W1251] := i
END;
IF cp866[i] # UNDEF THEN
UNI[cp866[i], CP866] := i
END
END
END setUNI;
BEGIN
InitW1251(cpW1251);
InitCP866(cp866);
setUNI
END Encodings.

330
programs/develop/cedit/SRC/File.ob07 Normal file
View File

@@ -0,0 +1,330 @@
(*
Copyright 2016, 2018, 2021 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE File;
IMPORT sys := SYSTEM, KOSAPI;
CONST
SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
TYPE
FNAME* = ARRAY 520 OF CHAR;
FS* = POINTER TO rFS;
rFS* = RECORD
subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER;
name*: FNAME
END;
FD* = POINTER TO rFD;
rFD* = RECORD
attr*: INTEGER;
ntyp*: CHAR;
reserved: ARRAY 3 OF CHAR;
time_create*, date_create*,
time_access*, date_access*,
time_modif*, date_modif*,
size*, hsize*: INTEGER;
name*: FNAME
END;
PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
BEGIN
sys.CODE(
053H, (* push ebx *)
06AH, 044H, (* push 68 *)
058H, (* pop eax *)
06AH, 01BH, (* push 27 *)
05BH, (* pop ebx *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *)
0CDH, 040H, (* int 64 *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
089H, 011H, (* mov dword [ecx], edx *)
05BH, (* pop ebx *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 8 *)
)
RETURN 0
END f_68_27;
PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
RETURN f_68_27(sys.ADR(FName[0]), size)
END Load;
PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
VAR
res2: INTEGER; fs: rFS;
BEGIN
fs.subfunc := 5;
fs.pos := 0;
fs.hpos := 0;
fs.bytes := 0;
fs.buffer := sys.ADR(Info);
COPY(FName, fs.name)
RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
END GetFileInfo;
PROCEDURE FileSize* (FName: ARRAY OF CHAR): INTEGER;
VAR
Info: rFD;
res: INTEGER;
BEGIN
IF GetFileInfo(FName, Info) THEN
res := Info.size
ELSE
res := -1
END
RETURN res
END FileSize;
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
VAR
fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists;
PROCEDURE Close* (VAR F: FS);
BEGIN
IF F # NIL THEN
DISPOSE(F)
END
END Close;
PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
VAR
F: FS;
BEGIN
IF Exists(FName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 0;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name)
END
ELSE
F := NIL
END
RETURN F
END Open;
PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
VAR
F: FS;
res, res2: INTEGER;
BEGIN
IF Exists(FName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 8;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
ELSE
res := -1
END
RETURN res = 0
END Delete;
PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
VAR
res: INTEGER;
fd: rFD;
BEGIN
IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN
CASE Origin OF
|SEEK_BEG: F.pos := Offset
|SEEK_CUR: F.pos := F.pos + Offset
|SEEK_END: F.pos := fd.size + Offset
ELSE
END;
res := F.pos
ELSE
res := -1
END
RETURN res
END Seek;
PROCEDURE Read* (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 0;
F.bytes := Count;
F.buffer := Buffer;
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
IF res2 > 0 THEN
F.pos := F.pos + res2
END
ELSE
res2 := 0
END
RETURN res2
END Read;
PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
res, res2: INTEGER;
BEGIN
IF F # NIL THEN
F.subfunc := 3;
F.bytes := Count;
F.buffer := Buffer;
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
IF res2 > 0 THEN
F.pos := F.pos + res2
END
ELSE
res2 := 0
END
RETURN res2
END Write;
PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
VAR
F: FS;
res2: INTEGER;
BEGIN
NEW(F);
IF F # NIL THEN
F.subfunc := 2;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(FName, F.name);
IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN
DISPOSE(F)
END
END
RETURN F
END Create;
PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN;
VAR
fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
END DirExists;
PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
VAR
F: FS;
res, res2: INTEGER;
BEGIN
NEW(F);
IF F # NIL THEN
F.subfunc := 9;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(DirName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
RETURN res = 0
END CreateDir;
PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
VAR
F: FS;
res, res2: INTEGER;
BEGIN
IF DirExists(DirName) THEN
NEW(F);
IF F # NIL THEN
F.subfunc := 8;
F.pos := 0;
F.hpos := 0;
F.bytes := 0;
F.buffer := 0;
COPY(DirName, F.name);
res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
DISPOSE(F)
ELSE
res := -1
END
ELSE
res := -1
END
RETURN res = 0
END DeleteDir;
END File.

280
programs/develop/cedit/SRC/Graph.ob07 Normal file
View File

@@ -0,0 +1,280 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Graph;
IMPORT SYSTEM, K := KOSAPI;
CONST
modeCOPY = 0;
modeNOT = 1;
modeXOR = 2;
TYPE
tFont* = POINTER TO RECORD
handle*: INTEGER;
height*: INTEGER;
width*: INTEGER;
size: INTEGER;
name*: ARRAY 256 OF WCHAR
END;
tCanvas* = POINTER TO RECORD
bitmap: INTEGER;
width*, height*: INTEGER;
color, backColor, textColor: INTEGER;
font*: tFont;
mode: INTEGER
END;
PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER);
BEGIN
K.sysfunc7(65, canvas.bitmap, canvas.width*65536 + canvas.height, x*65536 + y, 32, 0, 0);
END DrawCanvas;
PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.color := color
END SetColor;
PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.textColor := color
END SetTextColor;
PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.backColor := color
END SetBkColor;
PROCEDURE CreateFont* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;
VAR
font: tFont;
BEGIN
NEW(font);
font.size := MAX(MIN(height, 8), 1);
font.width := font.size*8;
font.height := font.size*16;
DEC(font.size);
font.name := name
RETURN font
END CreateFont;
PROCEDURE SetFont* (canvas: tCanvas; font: tFont);
BEGIN
canvas.font := font
END SetFont;
PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);
VAR
X1, X2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
X1 := MAX(MIN(x1, x2), 0);
X2 := MIN(MAX(x1, x2), canvas.width - 1);
IF (0 <= y) & (y < canvas.height) THEN
color := canvas.color;
ptr := canvas.bitmap + y*canvas.width*4 + X1*4;
FOR i := X1 TO X2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, 4)
END
END
END HLine;
PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);
VAR
Y1, Y2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
Y1 := MAX(MIN(y1, y2), 0);
Y2 := MIN(MAX(y1, y2), canvas.height - 1);
IF (0 <= x) & (x < canvas.width) THEN
color := canvas.color;
ptr := canvas.bitmap + Y1*canvas.width*4 + x*4;
FOR i := Y1 TO Y2 DO
IF canvas.mode = modeNOT THEN
SYSTEM.GET32(ptr, color);
color := ORD(-BITS(color)*{0..23})
ELSIF canvas.mode = modeXOR THEN
SYSTEM.GET32(ptr, color);
color := ORD((BITS(color)/BITS(canvas.color))*{0..23})
END;
SYSTEM.PUT32(ptr, color);
INC(ptr, canvas.width*4)
END
END
END VLine;
PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeNOT;
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END notVLine;
PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeXOR;
SetColor(canvas, 0FF0000H);
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END xorVLine;
PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);
VAR
ptr: INTEGER;
color: INTEGER;
d: INTEGER;
BEGIN
color := canvas.color;
ptr := canvas.bitmap + y*canvas.width*4 + x1*4;
IF k = -1 THEN
d := canvas.width*4 + 4
ELSIF k = 1 THEN
d := 4 - canvas.width*4
END;
WHILE x1 <= x2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, d);
INC(x1)
END
END DLine;
PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
VAR
y: INTEGER;
BEGIN
FOR y := top TO bottom DO
HLine(canvas, y, left, right)
END
END FillRect;
PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
BEGIN
HLine(canvas, top, left, right);
HLine(canvas, bottom, left, right);
VLine(canvas, left, top, bottom);
VLine(canvas, right, top, bottom)
END Rect;
PROCEDURE clear* (canvas: tCanvas);
VAR
ptr, ptr2, w, i: INTEGER;
BEGIN
HLine(canvas, 0, 0, canvas.width - 1);
w := canvas.width*4;
ptr := canvas.bitmap;
ptr2 := ptr;
i := canvas.height - 1;
WHILE i > 0 DO
INC(ptr2, w);
SYSTEM.MOVE(ptr, ptr2, w);
DEC(i)
END
END clear;
PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER);
CONST
WCHAR_SIZE = 2;
VAR
color, i: INTEGER;
BEGIN
IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN
IF x < 0 THEN
i := -(x DIV canvas.font.width);
INC(x, i*canvas.font.width);
DEC(n, i)
ELSE
i := 0
END;
IF n > 0 THEN
n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0);
color := canvas.color;
canvas.color := canvas.backColor;
FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height);
canvas.color := color;
(* WHILE n > 0 DO
K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, 1, canvas.bitmap - 8);
INC(x, canvas.font.width);
INC(i);
DEC(n)
END*)
K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, n, canvas.bitmap - 8)
END
END
END TextOut;
PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);
BEGIN
TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n)
END TextOut2;
PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;
VAR
canvas: tCanvas;
BEGIN
NEW(canvas);
canvas.bitmap := K.malloc(width*height*4 + 8);
ASSERT(canvas.bitmap # 0);
SYSTEM.PUT32(canvas.bitmap, width);
SYSTEM.PUT32(canvas.bitmap + 4, height);
INC(canvas.bitmap, 8);
canvas.width := width;
canvas.height := height;
canvas.mode := modeCOPY
RETURN canvas
END CreateCanvas;
PROCEDURE destroy* (VAR canvas: tCanvas);
BEGIN
IF canvas # NIL THEN
canvas.bitmap := K.free(canvas.bitmap);
DISPOSE(canvas)
END
END destroy;
END Graph.

182
programs/develop/cedit/SRC/Ini.ob07 Normal file
View File

@@ -0,0 +1,182 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Ini;
IMPORT
KOSAPI, SYSTEM, RW, Text, Utils, File, List, Languages;
CONST
fileName = "cedit.ini";
MAX_LEN = 32;
MAX_SECTIONS* = 10;
TYPE
tString = ARRAY 128 OF CHAR;
tSectionName = ARRAY MAX_LEN OF WCHAR;
tASCIISectionName = ARRAY MAX_LEN OF CHAR;
tSection* = POINTER TO RECORD (List.tItem)
name*: tSectionName
END;
VAR
get_color: PROCEDURE [stdcall] (f_name: RW.tFileName; sec_name: tASCIISectionName; key_name: tString; def_val: INTEGER): INTEGER;
get_str: PROCEDURE [stdcall] (f_name, sec_name, key_name, buffer, buf_len, def_val: INTEGER): INTEGER;
enum_sections: PROCEDURE [stdcall] (f_name: RW.tFileName; callback: INTEGER);
IniFileName: RW.tFileName;
sections*: List.tList;
curSection*: tASCIISectionName;
curSectionNum*: INTEGER;
PROCEDURE getColor (key: tString; def: INTEGER): INTEGER;
RETURN get_color(IniFileName, curSection, key, def)
END getColor;
PROCEDURE getStr* (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
BEGIN
IF get_str(SYSTEM.ADR(IniFileName[0]), SYSTEM.ADR(secName[0]), SYSTEM.ADR(keyName[0]), SYSTEM.ADR(s[0]), LEN(s) - 1, SYSTEM.SADR("")) = -1 THEN
s[0] := 0X
END
END getStr;
PROCEDURE [stdcall] section_callback (fileName, sectionName: RW.tFileName): INTEGER;
VAR
section: tSection;
name: tSectionName;
i: INTEGER;
BEGIN
IF sections.count < MAX_SECTIONS THEN
i := 0;
WHILE (i < MAX_LEN - 1) & (sectionName[i] # 0X) DO
name[i] := WCHR(ORD(sectionName[i]));
INC(i)
END;
name[i] := 0X
END;
IF Utils.streq(SYSTEM.ADR(name[0]), SYSTEM.WSADR("color_"), 6) THEN
Utils.reverse(name);
name[LENGTH(name) - 6] := 0X;
Utils.reverse(name);
NEW(section);
section.name := name;
List.append(sections, section)
END
RETURN 1
END section_callback;
PROCEDURE selectSection* (idx: INTEGER);
VAR
i: INTEGER;
item: List.tItem;
section: tSection;
text, back, seltext, selback, modified, saved, curline, numtext, numback,
comment, string, num, delim, key1, key2, key3: INTEGER;
BEGIN
IF (0 <= idx) & (idx < sections.count) THEN
curSectionNum := idx;
item := List.getItem(sections, idx);
section := item(tSection);
i := 0;
WHILE section.name[i] # 0X DO
curSection[i] := CHR(ORD(section.name[i]));
INC(i)
END;
curSection[i] := 0X;
Utils.reverse8(curSection);
Utils.append8(curSection, "_roloc");
Utils.reverse8(curSection)
ELSE
curSection := ""
END;
text := getColor("text", 0000000H);
back := getColor("back", 0FFFFFFH);
seltext := getColor("seltext", 0FFFFFFH);
selback := getColor("selback", 00000FFH);
modified := getColor("modified", 0E8E800H);
saved := getColor("saved", 000D000H);
curline := getColor("curline", 0FFFFC8H);
numtext := getColor("numtext", 0000000H);
numback := getColor("numback", 0E6E6E6H);
comment := getColor("comment", 0800080H);
string := getColor("string", 0008000H);
num := getColor("num", 0800000H);
delim := getColor("delim", 0000080H);
key1 := getColor("key1", 0000080H);
key2 := getColor("key2", 0008080H);
key3 := getColor("key3", 0008080H);
Text.setColors(text, back, seltext, selback, modified, saved, curline, numtext, numback,
comment, string, num, delim, key1, key2, key3, 808080H);
END selectSection;
PROCEDURE load* (path: RW.tFileName);
VAR
Lib: INTEGER;
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR
a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
SYSTEM.PUT(v, a)
END GetProc;
BEGIN
sections := List.create(NIL);
IF File.Exists("/rd/1/settings/cedit.ini") THEN
IniFileName := "/rd/1/settings/cedit.ini"
ELSE
Utils.getPath(path, IniFileName);
Utils.append8(IniFileName, Utils.SLASH);
Utils.append8(IniFileName, fileName);
END;
Lib := KOSAPI.LoadLib("/rd/1/Lib/Libini.obj");
GetProc(Lib, SYSTEM.ADR(get_color), "ini_get_color");
GetProc(Lib, SYSTEM.ADR(get_str), "ini_get_str");
GetProc(Lib, SYSTEM.ADR(enum_sections), "ini_enum_sections");
enum_sections(IniFileName, SYSTEM.ADR(section_callback));
Languages.init(getStr);
selectSection(0);
END load;
END Ini.

430
programs/develop/cedit/SRC/KOSAPI.ob07 Normal file
View File

@@ -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.

301
programs/develop/cedit/SRC/KolibriOS.ob07 Normal file
View File

@@ -0,0 +1,301 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE KolibriOS;
IMPORT
KOSAPI, SYSTEM;
CONST
winColor* = 0EEEEEEH;
fontWidth* = 8;
fontHeight* = 16;
PROCEDURE GetCommandLine* (): INTEGER;
RETURN KOSAPI.GetCommandLine()
END GetCommandLine;
PROCEDURE GetName* (): INTEGER;
RETURN KOSAPI.GetName()
END GetName;
PROCEDURE CreateWindow* (x, y, w, h, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(htext[0]))
END CreateWindow;
PROCEDURE BeginDraw*;
BEGIN
KOSAPI.sysfunc2(12, 1)
END BeginDraw;
PROCEDURE EndDraw*;
BEGIN
KOSAPI.sysfunc2(12, 2)
END EndDraw;
PROCEDURE WaitForEvent* (): INTEGER;
RETURN KOSAPI.sysfunc1(10)
END WaitForEvent;
PROCEDURE ThreadInfo (offsa, offsb: INTEGER; VAR a, b: INTEGER);
VAR
buffer: ARRAY 1024 OF BYTE;
BEGIN
KOSAPI.sysfunc3(9, SYSTEM.ADR(buffer[0]), -1);
SYSTEM.GET32(SYSTEM.ADR(buffer[0]) + offsa, a);
SYSTEM.GET32(SYSTEM.ADR(buffer[0]) + offsb, b);
END ThreadInfo;
PROCEDURE WinSize* (VAR width, height: INTEGER);
BEGIN
ThreadInfo(42, 46, width, height)
END WinSize;
PROCEDURE WinPos* (VAR x, y: INTEGER);
BEGIN
ThreadInfo(34, 38, x, y)
END WinPos;
PROCEDURE ClientSize* (VAR width, height: INTEGER);
BEGIN
ThreadInfo(62, 66, width, height)
END ClientSize;
PROCEDURE ClientPos* (VAR x, y: INTEGER);
BEGIN
ThreadInfo(54, 58, x, y)
END ClientPos;
PROCEDURE ThreadID* (): INTEGER;
VAR
id: INTEGER;
BEGIN
ThreadInfo(30, 30, id, id)
RETURN id
END ThreadID;
PROCEDURE RolledUp* (): BOOLEAN;
VAR
buffer: ARRAY 1024 OF BYTE;
BEGIN
KOSAPI.sysfunc3(9, SYSTEM.ADR(buffer[0]), -1)
RETURN ODD(LSR(buffer[70], 2))
END RolledUp;
PROCEDURE SetWinSize* (width, height: INTEGER);
BEGIN
KOSAPI.sysfunc5(67, -1, -1, width, height)
END SetWinSize;
PROCEDURE DrawText* (x, y, color: INTEGER; text: ARRAY OF WCHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(0A0H, 24), SYSTEM.ADR(text[0]), 0, 0)
END DrawText;
PROCEDURE DrawText69* (x, y, color: INTEGER; text: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(080H, 24), SYSTEM.ADR(text[0]), 0, 0)
END DrawText69;
PROCEDURE DrawText866* (x, y, color: INTEGER; text: ARRAY OF CHAR);
BEGIN
KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(0D0H, 24), SYSTEM.ADR(text[0]), 0, winColor)
END DrawText866;
PROCEDURE MousePos* (VAR x, y: INTEGER);
VAR
res: INTEGER;
BEGIN
res := KOSAPI.sysfunc2(37, 0);
y := res MOD 65536;
x := res DIV 65536
END MousePos;
PROCEDURE CreateButton* (id, Left, Top, Width, Height, Color: INTEGER; Caption: ARRAY OF WCHAR);
VAR
x, y: INTEGER;
BEGIN
KOSAPI.sysfunc5(8, LSL(Left, 16) + Width, LSL(Top, 16) + Height, id, Color);
x := Left + (Width - fontWidth * LENGTH(Caption)) DIV 2;
y := Top + (Height - fontHeight) DIV 2 + 1;
DrawText(x, y, 0, Caption)
END CreateButton;
PROCEDURE DeleteButton* (id: INTEGER);
BEGIN
KOSAPI.sysfunc5(8, 0, 0, id + 80000000H, 0)
END DeleteButton;
PROCEDURE GetTickCount* (): INTEGER;
RETURN KOSAPI.sysfunc2(26, 9)
END GetTickCount;
PROCEDURE Pause* (time: INTEGER);
BEGIN
KOSAPI.sysfunc2(5, time)
END Pause;
PROCEDURE ButtonCode* (): INTEGER;
VAR
res: INTEGER;
BEGIN
res := KOSAPI.sysfunc1(17);
IF res MOD 256 = 0 THEN
res := LSR(res, 8)
ELSE
res := 0
END
RETURN res
END ButtonCode;
PROCEDURE Exit*;
BEGIN
KOSAPI.sysfunc1(-1)
END Exit;
PROCEDURE ExitID* (tid: INTEGER);
BEGIN
KOSAPI.sysfunc3(18, 18, tid)
END ExitID;
PROCEDURE CreateThread* (proc: INTEGER; stack: ARRAY OF INTEGER): INTEGER;
RETURN KOSAPI.sysfunc4(51, 1, proc, SYSTEM.ADR(stack[LEN(stack) - 2]))
END CreateThread;
PROCEDURE Run* (program, param: ARRAY OF CHAR);
TYPE
info_struct = RECORD
subfunc : INTEGER;
flags : INTEGER;
param : INTEGER;
rsrvd1 : INTEGER;
rsrvd2 : INTEGER;
fname : ARRAY 1024 OF CHAR
END;
VAR
info: info_struct;
BEGIN
info.subfunc := 7;
info.flags := 0;
info.param := SYSTEM.ADR(param[0]);
info.rsrvd1 := 0;
info.rsrvd2 := 0;
COPY(program, info.fname);
KOSAPI.sysfunc2(70, SYSTEM.ADR(info))
END Run;
PROCEDURE DrawRect* (x, y, width, height, color: INTEGER);
BEGIN
KOSAPI.sysfunc4(13, x*65536 + width, y*65536 + height, color)
END DrawRect;
PROCEDURE DrawLine* (x1, y1, x2, y2: INTEGER; color: INTEGER);
BEGIN
KOSAPI.sysfunc4(38, x1*65536 + x2, y1*65536 + y2, color)
END DrawLine;
PROCEDURE DrawImage* (data, sizeX, sizeY, x, y: INTEGER);
BEGIN
KOSAPI.sysfunc4(7, data, sizeX*65536 + sizeY, x*65536 + y)
END DrawImage;
PROCEDURE SetEventsMask* (mask: SET);
BEGIN
KOSAPI.sysfunc2(40, ORD(mask))
END SetEventsMask;
PROCEDURE SkinHeight* (): INTEGER;
RETURN KOSAPI.sysfunc2(48, 4)
END SkinHeight;
PROCEDURE GetKey* (): INTEGER;
RETURN KOSAPI.sysfunc1(2)
END GetKey;
PROCEDURE MouseState* (): SET;
RETURN BITS(KOSAPI.sysfunc2(37, 3))
END MouseState;
PROCEDURE Scroll* (): INTEGER;
RETURN ASR(LSL(KOSAPI.sysfunc2(37, 7), 16), 16)
END Scroll;
PROCEDURE GetControlKeys* (): SET;
RETURN BITS(KOSAPI.sysfunc2(66, 3))
END GetControlKeys;
PROCEDURE malloc* (size: INTEGER): INTEGER;
RETURN KOSAPI.malloc(size)
END malloc;
PROCEDURE SetIPC* (buffer: ARRAY OF INTEGER);
BEGIN
KOSAPI.sysfunc4(60, 1, SYSTEM.ADR(buffer[0]), LEN(buffer)*SYSTEM.SIZE(INTEGER));
END SetIPC;
PROCEDURE SendIPC* (tid, msg: INTEGER);
BEGIN
KOSAPI.sysfunc5(60, 2, tid, SYSTEM.ADR(msg), SYSTEM.SIZE(INTEGER))
END SendIPC;
END KolibriOS.

379
programs/develop/cedit/SRC/Languages.ob07 Normal file
View File

@@ -0,0 +1,379 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Languages;
IMPORT Lines;
CONST
langNone* = 0; langC* = 1; langOberon* = 2; langPascal* = 3;
langFasm* = 4; langLua* = 5; langIni* = 6;
TYPE
tLine = Lines.tLine;
tKeyWords = RECORD
words: ARRAY 200, 32 OF WCHAR; cnt: INTEGER
END;
procGetStr = PROCEDURE (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
VAR
oberonKW, cKW, pascalKW, luaKW, iniKW, fasmKW: ARRAY 3 OF tKeyWords;
PROCEDURE checkKW (s: ARRAY OF WCHAR; KW: tKeyWords): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := KW.cnt - 1;
WHILE (i >= 0) & (s # KW.words[i]) DO
DEC(i)
END
RETURN i >= 0
END checkKW;
PROCEDURE isKey* (s: ARRAY OF WCHAR; lang, kwSet: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := FALSE;
CASE lang OF
|langC: res := checkKW(s, cKW[kwSet - 1])
|langOberon: res := checkKW(s, oberonKW[kwSet - 1])
|langPascal: res := checkKW(s, pascalKW[kwSet - 1])
|langLua: res := checkKW(s, luaKW[kwSet - 1])
|langIni: res := checkKW(s, iniKW[kwSet - 1])
|langFasm: res := checkKW(s, fasmKW[kwSet - 1])
END
RETURN res
END isKey;
PROCEDURE SkipString* (line: tLine; VAR pos: INTEGER; n: INTEGER);
VAR
quot: WCHAR;
BEGIN
quot := Lines.getChar(line, pos);
REPEAT
INC(pos)
UNTIL (pos > n) OR (Lines.getChar(line, pos) = quot)
END SkipString;
PROCEDURE C (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "/" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
pos := n
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 1;
cond := 0
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth = 1 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = "/") & (cond = 1) THEN
cond := 0;
depth := 0
ELSE
cond := 0
END
END
END C;
PROCEDURE getChar (line: tLine; i: INTEGER): WCHAR;
VAR
res: WCHAR;
BEGIN
IF i >= line.length THEN
res := 0X
ELSE
res := Lines.getChar(line, i)
END
RETURN res
END getChar;
PROCEDURE LuaLong* (line: tLine; pos: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := -1;
IF getChar(line, pos) = "[" THEN
INC(pos);
WHILE getChar(line, pos) = "=" DO
INC(res);
INC(pos)
END;
IF getChar(line, pos) = "[" THEN
INC(res)
ELSE
res := -1
END
END
RETURN res
END LuaLong;
PROCEDURE Lua (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
k: INTEGER;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "-" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
k := LuaLong(line, pos + 1);
IF k >= 0 THEN
depth := k*2 + 1
ELSE
pos := n
END
END
ELSIF c = "[" THEN
cond := 0;
k := LuaLong(line, pos);
IF k >= 0 THEN
depth := (k + 1)*2
END
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth > 0 THEN
IF (cond = 0) & (c = "]") THEN
cond := 1
ELSIF (cond >= 1) & (c = "=") THEN
INC(cond)
ELSIF (cond >= 1) & (c = "]") & (cond*2 - depth MOD 2 = depth) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Lua;
PROCEDURE Pascal (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "(" THEN
cond := 1
ELSIF c = "/" THEN
IF cond = 2 THEN
cond := 0;
pos := n
ELSE
cond := 2
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 2;
cond := 0
ELSIF c = "'" THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "{" THEN
IF Lines.getChar(line, pos + 1) = "$" THEN
depth := 3
ELSE
depth := 1
END;
cond := 0
ELSE
cond := 0
END
ELSIF depth IN {1, 3} THEN
IF c = "}" THEN
depth := 0
END
ELSIF depth = 2 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = ")") & (cond = 1) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Pascal;
PROCEDURE Oberon (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF (depth = 0) & (c = "/") THEN
IF cond = 3 THEN
cond := 0;
pos := n
ELSE
cond := 3
END
ELSIF (depth = 0) & ((c = "'") OR (c = '"')) THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "(" THEN
cond := 1
ELSIF c = "*" THEN
IF cond = 1 THEN
INC(depth);
cond := 0
ELSE
cond := 2
END
ELSIF c = ")" THEN
IF cond = 2 THEN
IF depth > 0 THEN
DEC(depth)
END
END;
cond := 0
ELSE
cond := 0
END;
END Oberon;
PROCEDURE Ini (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
cond := 0;
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = ";" THEN
pos := n
ELSIF c = '"' THEN
SkipString(line, pos, n)
ELSIF c = "[" THEN
depth := 1
END
ELSIF depth = 1 THEN
IF c = "]" THEN
depth := 0
END
END
END Ini;
PROCEDURE comments* (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER; lang: INTEGER);
BEGIN
CASE lang OF
|langNone:
|langFasm:
|langC: C(line, depth, cond, pos, n)
|langOberon: Oberon(line, depth, cond, pos, n)
|langPascal: Pascal(line, depth, cond, pos, n)
|langLua: Lua(line, depth, cond, pos, n)
|langIni: Ini(line, depth, cond, pos, n)
END
END comments;
PROCEDURE EnterKW (s: ARRAY OF CHAR; VAR KW: tKeyWords);
CONST
SPACE = 20X; CR = 0DX; LF = 0AX; TAB = 9X; COMMA = ",";
VAR
i, j, k: INTEGER;
PROCEDURE delim (c: CHAR): BOOLEAN;
RETURN (c = COMMA) OR (c = SPACE) OR (c = CR) OR (c = LF) OR (c = TAB)
END delim;
BEGIN
k := KW.cnt;
i := 0;
REPEAT
j := 0;
WHILE (s[i] # 0X) & ~delim(s[i]) DO
KW.words[k, j] := WCHR(ORD(s[i]));
INC(i);
INC(j)
END;
KW.words[k, j] := 0X;
INC(k);
WHILE delim(s[i]) DO
INC(i)
END
UNTIL s[i] = 0X;
KW.cnt := k
END EnterKW;
PROCEDURE loadKW (VAR KW: ARRAY OF tKeyWords; getStr: procGetStr; lang: ARRAY OF CHAR);
VAR
s: ARRAY 16*1024 OF CHAR;
key: ARRAY 4 OF CHAR;
i: INTEGER;
BEGIN
key := "KW1";
FOR i := 0 TO 2 DO
KW[i].cnt := 0;
key[2] := CHR(ORD("1") + i);
getStr(lang, key, s);
EnterKW(s, KW[i])
END;
END loadKW;
PROCEDURE init* (getStr: procGetStr);
BEGIN
loadKW(oberonKW, getStr, "lang_Oberon");
loadKW(cKW, getStr, "lang_C");
loadKW(pascalKW, getStr, "lang_Pascal");
loadKW(luaKW, getStr, "lang_Lua");
loadKW(iniKW, getStr, "lang_Ini");
loadKW(fasmKW, getStr, "lang_Fasm");
END init;
END Languages.

421
programs/develop/cedit/SRC/Lines.ob07 Normal file
View File

@@ -0,0 +1,421 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Lines;
IMPORT
List, SYSTEM, API, Utils;
CONST
WCHAR_SIZE = 2;
SPACE = 20X;
TYPE
tLine* = POINTER TO RECORD (List.tItem)
ptr: INTEGER;
length*: INTEGER;
modified*, saved*, temp: BOOLEAN;
cin*, cout*, pos*: INTEGER
END;
PmovInt = PROCEDURE (VAR v: INTEGER; x: INTEGER);
PmovBool = PROCEDURE (VAR v: BOOLEAN; x: BOOLEAN);
PmovPtr = PROCEDURE (VAR v: List.tItem; x: List.tItem);
(*
PTypedPtr = PROCEDURE (p: List.tItem);
PUntypedPtr = PROCEDURE (p: INTEGER);
*)
VAR
_movInt: PmovInt;
_movBool: PmovBool;
_movPtr: PmovPtr;
(* _typedPtr: PTypedPtr;
_untypedPtr: PUntypedPtr;*)
maxLength*: INTEGER;
PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
BEGIN
_movInt(v, x)
END movInt;
PROCEDURE movBool (VAR v: BOOLEAN; x: BOOLEAN);
BEGIN
_movBool(v, x)
END movBool;
PROCEDURE movPtr (VAR v: List.tItem; x: List.tItem);
BEGIN
_movPtr(v, x)
END movPtr;
PROCEDURE malloc (size: INTEGER): INTEGER;
VAR
ptr: INTEGER;
BEGIN
IF size > maxLength THEN
maxLength := size
END;
size := size*WCHAR_SIZE + 4;
INC(size, (-size) MOD 32);
ptr := API._NEW(size)
RETURN ptr
END malloc;
PROCEDURE free (line: tLine; newPtr: INTEGER);
BEGIN
IF line.ptr # 0 THEN
IF line.temp THEN
line.ptr := API._DISPOSE(line.ptr)
ELSE
line.ptr := 0
END
END;
IF ~line.temp THEN
movInt(line.ptr, newPtr);
(* IF newPtr # 0 THEN
_untypedPtr(newPtr)
END*)
END;
line.ptr := newPtr
END free;
PROCEDURE create* (temp: BOOLEAN): tLine;
VAR
line: tLine;
BEGIN
NEW(line);
ASSERT(line # NIL);
(* IF ~temp THEN
_typedPtr(line)
END;*)
line.next := NIL;
line.prev := NIL;
IF ~temp THEN
movPtr(line.next, NIL);
movPtr(line.prev, NIL)
END;
line.ptr := malloc(1);
ASSERT(line.ptr # 0);
IF ~temp THEN
(*_untypedPtr(line.ptr);*)
movInt(line.ptr, line.ptr)
END;
SYSTEM.PUT16(line.ptr, 0);
line.length := 0;
IF ~temp THEN
movInt(line.length, 0)
END;
line.temp := temp;
line.modified := FALSE;
line.saved := FALSE;
IF ~temp THEN
movBool(line.modified, FALSE);
movBool(line.saved, FALSE)
END;
line.cin := 0;
line.cout := 0;
line.pos := 0
RETURN line
END create;
PROCEDURE destroy* (VAR line: tLine);
BEGIN
IF line.temp THEN
free(line, 0);
DISPOSE(line)
ELSE
line := NIL
END
END destroy;
PROCEDURE modify* (line: tLine);
BEGIN
IF ~line.temp THEN
movBool(line.modified, TRUE);
movBool(line.saved, FALSE)
END;
line.modified := TRUE;
line.saved := FALSE
END modify;
PROCEDURE save* (line: tLine);
BEGIN
IF ~line.temp THEN
movBool(line.saved, TRUE);
movBool(line.modified, FALSE)
END;
line.modified := FALSE;
line.saved := TRUE
END save;
PROCEDURE getChar* (line: tLine; i: INTEGER): WCHAR;
VAR
c: WCHAR;
BEGIN
SYSTEM.GET(line.ptr + i*WCHAR_SIZE, c)
RETURN c
END getChar;
PROCEDURE trimLength* (line: tLine): INTEGER;
VAR
i: INTEGER;
BEGIN
i := line.length - 1;
WHILE (i >= 0) & (getChar(line, i) = SPACE) DO
DEC(i)
END
RETURN i + 1
END trimLength;
PROCEDURE getPChar* (line: tLine; i: INTEGER): INTEGER;
RETURN line.ptr + i*WCHAR_SIZE
END getPChar;
PROCEDURE setChar* (line: tLine; i: INTEGER; c: WCHAR);
BEGIN
SYSTEM.PUT(line.ptr + i*WCHAR_SIZE, c)
END setChar;
PROCEDURE concat* (line: tLine; s: ARRAY OF WCHAR);
VAR
Len: INTEGER;
ptr: INTEGER;
BEGIN
Len := LENGTH(s);
ptr := malloc(line.length + Len + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, line.length*WCHAR_SIZE);
SYSTEM.MOVE(SYSTEM.ADR(s[0]), ptr + line.length*WCHAR_SIZE, Len*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length + Len)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length + Len)
END;
INC(line.length, Len);
free(line, ptr)
END concat;
PROCEDURE delChar* (line: tLine; pos: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF pos < line.length THEN
ptr := malloc(line.length);
ASSERT(ptr # 0);
IF ~line.temp THEN
movInt(line.length, line.length - 1)
END;
DEC(line.length);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE + WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END
END delChar;
PROCEDURE insert* (line: tLine; pos: INTEGER; c: WCHAR);
VAR
ptr: INTEGER;
BEGIN
ptr := malloc(line.length + 2);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.PUT(ptr + pos*WCHAR_SIZE, c);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + pos*WCHAR_SIZE + WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
IF ~line.temp THEN
movInt(line.length, line.length + 1)
END;
INC(line.length);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END insert;
PROCEDURE insert2* (line1: tLine; pos: INTEGER; line2: tLine);
VAR
ptr: INTEGER;
BEGIN
IF line2.length > 0 THEN
ptr := malloc(line1.length + line2.length + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line1.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line2.ptr, ptr + pos*WCHAR_SIZE, line2.length*WCHAR_SIZE);
SYSTEM.MOVE(line1.ptr + pos*WCHAR_SIZE, ptr + (pos + line2.length)*WCHAR_SIZE, (line1.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line1.length + line2.length)*WCHAR_SIZE, 0);
IF ~line1.temp THEN
movInt(line1.length, line1.length + line2.length)
END;
IF ~line2.temp THEN
movInt(line2.length, 0)
END;
INC(line1.length, line2.length);
line2.length := 0;
free(line1, ptr);
free(line2, 0)
END
END insert2;
PROCEDURE insert3* (line: tLine; pos, n: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF n > 0 THEN
ptr := malloc(line.length + n + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + (pos + n)*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length + n)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length + n)
END;
INC(line.length, n);
free(line, ptr)
END
END insert3;
PROCEDURE delCharN* (line: tLine; pos, n: INTEGER);
VAR
ptr: INTEGER;
BEGIN
IF n > 0 THEN
ptr := malloc(line.length - n + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
SYSTEM.MOVE(line.ptr + (pos + n)*WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos - n)*WCHAR_SIZE);
SYSTEM.PUT16(ptr + (line.length - n)*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, line.length - n)
END;
DEC(line.length, n);
free(line, ptr)
END
END delCharN;
PROCEDURE wrap* (line, nextLine: tLine; pos: INTEGER);
VAR
ptr1, ptr2: INTEGER;
n: INTEGER;
BEGIN
ptr1 := malloc(pos + 1);
ASSERT(ptr1 # 0);
n := line.length - pos;
ptr2 := malloc(n + 1);
ASSERT(ptr2 # 0);
SYSTEM.MOVE(line.ptr, ptr1, pos*WCHAR_SIZE);
SYSTEM.PUT16(ptr1 + pos*WCHAR_SIZE, 0);
SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr2, n*WCHAR_SIZE);
SYSTEM.PUT16(ptr2 + n*WCHAR_SIZE, 0);
IF ~line.temp THEN
movInt(line.length, pos)
END;
IF ~nextLine.temp THEN
movInt(nextLine.length, n)
END;
line.length := pos;
nextLine.length := n;
free(line, ptr1);
free(nextLine, ptr2)
END wrap;
PROCEDURE copy* (line: tLine);
VAR
ptr: INTEGER;
BEGIN
ptr := malloc(line.length + 1);
ASSERT(ptr # 0);
SYSTEM.MOVE(line.ptr, ptr, line.length*WCHAR_SIZE);
SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
free(line, ptr)
END copy;
PROCEDURE chCase* (line: tLine; pos1, pos2: INTEGER; upper: BOOLEAN): BOOLEAN;
VAR
i: INTEGER;
modified: BOOLEAN;
c: WCHAR;
func: PROCEDURE (VAR c: WCHAR): BOOLEAN;
BEGIN
modified := FALSE;
IF upper THEN
func := Utils.cap
ELSE
func := Utils.low
END;
i := pos2;
WHILE i >= pos1 DO
c := getChar(line, i);
IF func(c) THEN
modified := TRUE
END;
DEC(i)
END;
IF modified THEN
copy(line);
i := pos2;
WHILE i >= pos1 DO
c := getChar(line, i);
IF func(c) THEN
setChar(line, i, c)
END;
DEC(i)
END;
modify(line)
END
RETURN modified
END chCase;
PROCEDURE init* (movInt: PmovInt; movPtr: PmovPtr; movBool: PmovBool(*; typedPtr: PTypedPtr; untypedPtr: PUntypedPtr*));
BEGIN
_movInt := movInt;
_movPtr := movPtr;
_movBool := movBool;
(* _typedPtr := typedPtr;
_untypedPtr := untypedPtr;*)
END init;
BEGIN
maxLength := 64
END Lines.

227
programs/develop/cedit/SRC/List.ob07 Normal file
View File

@@ -0,0 +1,227 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE List;
TYPE
tItem* = POINTER TO RECORD
prev*, next*: tItem
END;
tList* = POINTER TO RECORD
first*, last*: tItem;
count*: INTEGER
END;
PmovInt = PROCEDURE (VAR v: INTEGER; x: INTEGER);
PmovPtr = PROCEDURE (VAR v: tItem; x: tItem);
VAR
_movInt: PmovInt;
_movPtr: PmovPtr;
PROCEDURE create* (list: tList): tList;
BEGIN
IF list = NIL THEN
NEW(list)
END;
list.first := NIL;
list.last := NIL;
list.count := 0
RETURN list
END create;
PROCEDURE getItem* (list: tList; idx: INTEGER): tItem;
VAR
item: tItem;
BEGIN
IF idx < 0 THEN
item := NIL
ELSE
item := list.first;
WHILE (idx > 0) & (item # NIL) DO
item := item.next;
DEC(idx)
END
END
RETURN item
END getItem;
PROCEDURE delete* (list: tList; item: tItem);
VAR
prev, next: tItem;
BEGIN
prev := item.prev;
next := item.next;
IF prev # NIL THEN
prev.next := next;
IF next # NIL THEN
next.prev := prev
ELSE
list.last := prev
END
ELSE
list.first := next;
IF next # NIL THEN
next.prev := NIL
ELSE
list.last := NIL
END
END;
DEC(list.count)
END delete;
PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
BEGIN
_movInt(v, x);
v := x
END movInt;
PROCEDURE movPtr (VAR v: tItem; x: tItem);
BEGIN
_movPtr(v, x);
v := x
END movPtr;
PROCEDURE _delete* (list: tList; item: tItem);
VAR
prev, next: tItem;
BEGIN
prev := item.prev;
next := item.next;
IF prev # NIL THEN
movPtr(prev.next, next);
IF next # NIL THEN
movPtr(next.prev, prev)
ELSE
movPtr(list.last, prev)
END
ELSE
movPtr(list.first, next);
IF next # NIL THEN
movPtr(next.prev, NIL)
ELSE
movPtr(list.last, NIL)
END
END;
movInt(list.count, list.count - 1)
END _delete;
PROCEDURE _append* (list: tList; item: tItem);
BEGIN
movPtr(item.prev, list.last);
IF list.last # NIL THEN
movPtr(list.last.next, item)
ELSE
movPtr(list.first, item)
END;
movPtr(list.last, item);
movPtr(item.next, NIL);
movInt(list.count, list.count + 1)
END _append;
PROCEDURE _insert* (list: tList; item, newItem: tItem);
VAR
next: tItem;
BEGIN
next := item.next;
IF next # NIL THEN
movPtr(next.prev, newItem);
movPtr(newItem.next, next);
movPtr(item.next, newItem);
movPtr(newItem.prev, item);
movInt(list.count, list.count + 1)
ELSE
_append(list, newItem)
END
END _insert;
PROCEDURE append* (list: tList; item: tItem);
BEGIN
item.prev := list.last;
IF list.last # NIL THEN
list.last.next := item
ELSE
list.first := item
END;
list.last := item;
item.next := NIL;
INC(list.count)
END append;
PROCEDURE insert* (list: tList; item, newItem: tItem);
VAR
next: tItem;
BEGIN
next := item.next;
IF next # NIL THEN
next.prev := newItem;
newItem.next := next;
item.next := newItem;
newItem.prev := item;
INC(list.count)
ELSE
append(list, newItem)
END
END insert;
PROCEDURE pop* (list: tList): tItem;
VAR
res: tItem;
BEGIN
IF list.count # 0 THEN
res := list.last;
list.last := res.prev;
DEC(list.count);
IF list.count # 0 THEN
list.last.next := NIL
ELSE
list.first := NIL
END;
res.prev := NIL;
res.next := NIL
ELSE
res := NIL
END
RETURN res
END pop;
PROCEDURE init* (movInt: PmovInt; movPtr: PmovPtr);
BEGIN
_movInt := movInt;
_movPtr := movPtr
END init;
END List.

357
programs/develop/cedit/SRC/Menu.ob07 Normal file
View File

@@ -0,0 +1,357 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Menu;
IMPORT
SYSTEM, G := Graph, List, K := KolibriOS;
CONST
fontHeight = 20;
fontWidth = 8;
RIGHT = 16;
LEFT = 16;
TOP = 1;
backColor = 0F0F0F0H;
foreColor = 0;
selBackColor = 091C9F7H;
selForeColor = 0;
disBackColor = backColor;
disForeColor = 808080H;
disSelBackColor = 0E4E4E4H;
disSelForeColor = disForeColor;
TYPE
tItem* = POINTER TO RECORD (List.tItem)
id*, check: INTEGER;
text: ARRAY 32 OF WCHAR;
enabled, delim: BOOLEAN
END;
tMenu* = POINTER TO RECORD
(*stack: POINTER TO RECORD stk: ARRAY 250000 OF INTEGER END;*)
tid*: INTEGER;
winX, winY, width*, height*: INTEGER;
selItem, cliItem: INTEGER;
font: G.tFont;
canvas: G.tCanvas;
items: List.tList;
click: PROCEDURE (menu: tMenu; id: INTEGER);
key: PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN
END;
tClick = PROCEDURE (menu: tMenu; id: INTEGER);
tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
VAR
lastTID*: INTEGER;
stack: ARRAY 250000 OF INTEGER;
PROCEDURE exit (m: tMenu);
BEGIN
m.tid := 0;
K.Exit
END exit;
PROCEDURE repaint (m: tMenu);
VAR
y, i: INTEGER;
item: tItem;
BkColor, TextColor: INTEGER;
canvas: G.tCanvas;
BEGIN
canvas := m.canvas;
G.SetColor(canvas, backColor);
G.clear(canvas);
G.SetColor(canvas, ORD((-BITS(backColor))*{0..23}) );
G.Rect(canvas, 0, 0, m.width, m.height);
y := TOP;
i := 0;
item := m.items.first(tItem);
WHILE item # NIL DO
IF item.enabled THEN
IF i # m.selItem THEN
BkColor := backColor;
TextColor := foreColor
ELSE
BkColor := selBackColor;
TextColor := selForeColor
END
ELSE
IF i # m.selItem THEN
BkColor := disBackColor;
TextColor := disForeColor
ELSE
BkColor := disSelBackColor;
TextColor := disSelForeColor
END
END;
G.SetColor(canvas, BkColor);
G.FillRect(canvas, 1, y, m.width - 1, y + fontHeight - 4);
G.SetTextColor(canvas, TextColor);
G.SetBkColor(canvas, BkColor);
G.TextOut2(canvas, LEFT, y + (fontHeight - 16) DIV 2 - 2, item.text, LENGTH(item.text));
IF item.check = 1 THEN
G.SetColor(canvas, TextColor);
G.DLine(canvas, 4, 7, y + (fontHeight - 16) DIV 2 + 5, -1);
G.DLine(canvas, 4, 7, y + (fontHeight - 16) DIV 2 + 6, -1);
G.DLine(canvas, 7, 12, y + (fontHeight - 16) DIV 2 + 8, 1);
G.DLine(canvas, 7, 12, y + (fontHeight - 16) DIV 2 + 9, 1);
ELSIF item.check = 2 THEN
G.SetColor(canvas, TextColor);
G.FillRect(canvas, 6, y + fontHeight DIV 2 - 4, 10, y + fontHeight DIV 2)
END;
INC(y, fontHeight);
IF item.delim THEN
G.SetColor(canvas, ORD((-BITS(backColor))*{0..23}));
G.HLine(canvas, y - 2, 1, m.width - 1)
END;
INC(i);
item := item.next(tItem)
END;
G.DrawCanvas(canvas, 0, 0)
END repaint;
PROCEDURE draw_window (m: tMenu);
BEGIN
K.BeginDraw;
K.CreateWindow(m.winX, m.winY, m.width, m.height, 0, 61H, 0, 1, "");
repaint(m);
K.EndDraw
END draw_window;
PROCEDURE mouse (m: tMenu; VAR x, y: INTEGER);
VAR
mouseX, mouseY: INTEGER;
BEGIN
K.MousePos(mouseX, mouseY);
x := mouseX - m.winX;
y := mouseY - m.winY;
END mouse;
PROCEDURE click (m: tMenu; i: INTEGER);
VAR
item: List.tItem;
BEGIN
item := List.getItem(m.items, i);
IF item(tItem).enabled THEN
m.click(m, item(tItem).id);
exit(m)
END
END click;
PROCEDURE [stdcall] window (m: tMenu);
VAR
x, y: INTEGER;
key: INTEGER;
msState: SET;
BEGIN
m.selItem := -1;
m.cliItem := -1;
K.SetEventsMask({0, 1, 5});
WHILE TRUE DO
CASE K.WaitForEvent() OF
|1:
draw_window(m)
|2:
key := K.GetKey();
IF key DIV 65536 = 72 THEN
DEC(m.selItem);
IF m.selItem < 0 THEN
m.selItem := 0
END
ELSIF key DIV 65536 = 80 THEN
INC(m.selItem);
IF m.selItem >= m.items.count THEN
m.selItem := m.items.count - 1
END
ELSIF key DIV 65536 = 28 THEN
IF m.selItem >= 0 THEN
click(m, m.selItem)
END;
m.cliItem := -1
ELSE
IF m.key(m, key) THEN
exit(m)
END
END;
repaint(m)
|6:
msState := K.MouseState();
mouse(m, x, y);
IF (0 <= x) & (x < m.width) & (0 <= y) & (y < m.height) THEN
m.selItem := (y - TOP) DIV fontHeight;
IF 8 IN msState THEN
m.cliItem := (y - TOP) DIV fontHeight
END;
IF 16 IN msState THEN
IF m.cliItem = m.selItem THEN
click(m, m.cliItem)
END;
m.cliItem := -1
END
ELSE
m.cliItem := -1;
IF {8, 9, 10} * msState # {} THEN
exit(m)
END
END;
repaint(m)
END
END
END window;
PROCEDURE AddMenuItem* (items: List.tList; id: INTEGER; s: ARRAY OF WCHAR);
VAR
item: tItem;
BEGIN
NEW(item);
item.id := id;
item.text := s;
item.enabled := TRUE;
item.delim := FALSE;
List.append(items, item);
END AddMenuItem;
PROCEDURE delimiter* (items: List.tList);
BEGIN
items.last(tItem).delim := TRUE
END delimiter;
PROCEDURE getItem (m: tMenu; id: INTEGER): tItem;
VAR
item: tItem;
BEGIN
item := m.items.first(tItem);
WHILE (item # NIL) & (item.id # id) DO
item := item.next(tItem)
END
RETURN item
END getItem;
PROCEDURE setEnabled* (m: tMenu; id: INTEGER; value: BOOLEAN);
VAR
item: tItem;
BEGIN
item := getItem(m, id);
IF item # NIL THEN
item.enabled := value
END
END setEnabled;
PROCEDURE setCheck* (m: tMenu; id: INTEGER; value: INTEGER);
VAR
item: tItem;
BEGIN
item := getItem(m, id);
IF item # NIL THEN
item.check := value
END
END setCheck;
PROCEDURE isEnabled* (m: tMenu; id: INTEGER): BOOLEAN;
VAR
item: tItem;
BEGIN
item := getItem(m, id)
RETURN (item # NIL) & item.enabled
END isEnabled;
PROCEDURE opened* (m: tMenu): BOOLEAN;
RETURN m.tid # 0
END opened;
PROCEDURE open* (m: tMenu; x, y: INTEGER);
BEGIN
IF m.tid = 0 THEN
m.winX := x;
m.winY := y;
(* DISPOSE(m.stack);
NEW(m.stack);
SYSTEM.PUT(SYSTEM.ADR(m.stack.stk[LEN(m.stack.stk) - 1]), m);
lastTID := K.CreateThread(SYSTEM.ADR(window), m.stack.stk);*)
SYSTEM.PUT(SYSTEM.ADR(stack[LEN(stack) - 1]), m);
lastTID := K.CreateThread(SYSTEM.ADR(window), stack);
m.tid := lastTID
END
END open;
PROCEDURE close* (m: tMenu);
BEGIN
IF m.tid # 0 THEN
K.ExitID(m.tid);
(*DISPOSE(m.stack);*)
m.tid := 0
END
END close;
PROCEDURE create* (items: List.tList; click: tClick; key: tKey): tMenu;
VAR
m: tMenu;
maxLength: INTEGER;
item: tItem;
BEGIN
NEW(m);
m.tid := 0;
m.items := items;
m.click := click;
m.key := key;
maxLength := 0;
item := items.first(tItem);
WHILE item # NIL DO
maxLength := MAX(maxLength, LENGTH(item.text));
item := item.next(tItem)
END;
m.width := maxLength*fontWidth + LEFT + RIGHT;
m.height := items.count*fontHeight - 2;
m.font := G.CreateFont(1, "", {});
m.canvas := G.CreateCanvas(m.width + 1, m.height + 1);
(*m.stack := NIL;*)
G.SetFont(m.canvas, m.font);
RETURN m
END create;
BEGIN
lastTID := 0
END Menu.

173
programs/develop/cedit/SRC/OpenDlg.ob07 Normal file
View File

@@ -0,0 +1,173 @@
(*
Copyright 2016, 2018, 2020, 2021 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE OpenDlg;
IMPORT sys := SYSTEM, KOSAPI;
CONST
topen* = 0;
tsave* = 1;
tdir* = 2;
TYPE
DRAW_WINDOW = PROCEDURE;
tFilterArea = POINTER TO RECORD
size: INTEGER;
filter: ARRAY 4096 OF CHAR
END;
TDialog = RECORD
_type*,
procinfo,
com_area_name,
com_area,
opendir_path,
dir_default_path,
start_path: INTEGER;
draw_window: DRAW_WINDOW;
status*,
openfile_path,
filename_area: INTEGER;
filter_area: tFilterArea;
X, Y: INTEGER;
procinf: ARRAY 1024 OF CHAR;
s_com_area_name: ARRAY 32 OF CHAR;
s_opendir_path,
s_dir_default_path,
FilePath*,
FileName*: ARRAY 4096 OF CHAR
END;
Dialog* = POINTER TO TDialog;
VAR
Dialog_start, Dialog_init: PROCEDURE [stdcall] (od: Dialog);
filter_area: tFilterArea;
PROCEDURE Show*(od: Dialog; Width, Height: INTEGER);
BEGIN
IF od # NIL THEN
od.X := Width;
od.Y := Height;
Dialog_start(od)
END
END Show;
PROCEDURE replace (VAR str: ARRAY OF CHAR; c1, c2: CHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(str) - 1;
WHILE i >= 0 DO
IF str[i] = c1 THEN
str[i] := c2
END;
DEC(i)
END
END replace;
PROCEDURE SetFilter* (dlg: Dialog; filter: ARRAY OF CHAR);
VAR
n, i: INTEGER;
BEGIN
IF filter = "" THEN
dlg.filter_area := NIL
ELSE
dlg.filter_area := filter_area;
filter_area.filter := filter;
n := LENGTH(filter_area.filter);
FOR i := 0 TO 3 DO
filter_area.filter[n + i] := "|"
END;
filter_area.filter[n + 4] := 0X;
filter_area.size := LENGTH(filter_area.filter);
replace(filter_area.filter, "|", 0X)
END
END SetFilter;
PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
VAR res: Dialog;
BEGIN
NEW(res);
IF res # NIL THEN
NEW(filter_area);
IF filter_area # NIL THEN
res.filter_area := filter_area;
res.s_com_area_name := "FFFFFFFF_open_dialog";
res.com_area := 0;
res._type := _type;
res.draw_window := draw_window;
COPY(def_path, res.s_dir_default_path);
SetFilter(res, filter);
res.X := 0;
res.Y := 0;
res.s_opendir_path := res.s_dir_default_path;
res.FilePath := "";
res.FileName := "";
res.status := 0;
res.procinfo := sys.ADR(res.procinf[0]);
res.com_area_name := sys.ADR(res.s_com_area_name[0]);
res.start_path := sys.SADR("/rd/1/File managers/opendial");
res.opendir_path := sys.ADR(res.s_opendir_path[0]);
res.dir_default_path := sys.ADR(res.s_dir_default_path[0]);
res.openfile_path := sys.ADR(res.FilePath[0]);
res.filename_area := sys.ADR(res.FileName[0]);
Dialog_init(res)
ELSE
DISPOSE(res)
END
END
RETURN res
END Create;
PROCEDURE Destroy*(VAR od: Dialog);
BEGIN
IF od # NIL THEN
DISPOSE(od.filter_area);
DISPOSE(od)
END
END Destroy;
PROCEDURE Load;
VAR Lib: INTEGER;
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
sys.PUT(v, a)
END GetProc;
BEGIN
Lib := KOSAPI.LoadLib("/rd/1/Lib/Proc_lib.obj");
GetProc(Lib, sys.ADR(Dialog_init), "OpenDialog_init");
GetProc(Lib, sys.ADR(Dialog_start), "OpenDialog_start");
END Load;
BEGIN
Load
END OpenDlg.

543
programs/develop/cedit/SRC/RTL.ob07 Normal file
View File

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

508
programs/develop/cedit/SRC/RW.ob07 Normal file
View File

@@ -0,0 +1,508 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE RW;
IMPORT
File, SYSTEM, KOSAPI, E := Encodings,
CB := Clipboard, Lines;
CONST
CR = 0DX; LF = 0AX; TAB = 9X; SPACE = 20X;
BOM = 0FEFFX;
TAB_SIZE* = 4;
BUF_SIZE = 65536;
NAME_LEN = 1024;
EOL_LF* = 0; EOL_CRLF* = 1; EOL_CR* = 2;
TYPE
tFileName* = ARRAY NAME_LEN OF CHAR;
tEOL = ARRAY 3 OF WCHAR;
tInput* = POINTER TO RECORD
buffer: INTEGER;
pos, cnt: INTEGER;
enc: INTEGER;
CR: BOOLEAN;
clipbrd: BOOLEAN;
getChar: PROCEDURE (file: tInput): INTEGER
END;
tOutput* = POINTER TO RECORD
handle: File.FS;
buffer: ARRAY BUF_SIZE OF BYTE;
pos: INTEGER;
eol: tEOL;
putChar: PROCEDURE (file: tOutput; code: INTEGER): BOOLEAN
END;
VAR
eol*: ARRAY 3 OF tEOL;
PROCEDURE getByte (file: tInput): BYTE;
VAR
res: BYTE;
BEGIN
IF file.cnt > 0 THEN
SYSTEM.GET8(file.buffer + file.pos, res);
INC(file.pos);
DEC(file.cnt)
ELSE
res := 0
END
RETURN res
END getByte;
PROCEDURE peakByte (file: tInput): BYTE;
VAR
res: BYTE;
BEGIN
IF file.cnt > 0 THEN
SYSTEM.GET8(file.buffer + file.pos, res)
ELSE
res := 0
END
RETURN res
END peakByte;
PROCEDURE getCharUTF8 (file: tInput): INTEGER;
VAR
code, n: INTEGER;
b: BYTE;
BEGIN
b := getByte(file);
IF b <= 07FH THEN
n := 0
ELSIF (0C0H <= b) & (b <= 0DFH) THEN
DEC(b, 0C0H);
n := 1
ELSIF (0E0H <= b) & (b <= 0EFH) THEN
DEC(b, 0E0H);
n := 2
ELSIF (0F0H <= b) & (b <= 0F7H) THEN
DEC(b, 0F0H);
n := 3
ELSIF (0F8H <= b) & (b <= 0FBH) THEN
DEC(b, 0F8H);
n := 4
ELSIF (0FCH <= b) & (b <= 0FDH) THEN
DEC(b, 0FCH);
n := 5
ELSIF b = 0FEH THEN
b := 0;
n := 6
ELSIF b = 0FFH THEN
n := -1
ELSIF (080H <= b) & (b <= 0BFH) THEN
n := -1
END;
code := b;
IF n > 2 THEN
n := -1
END;
WHILE n > 0 DO
DEC(n);
b := peakByte(file);
IF (080H <= b) & (b <= 0BFH) THEN
code := code*64 + getByte(file) - 080H
ELSE
n := -1
END
END;
IF n = -1 THEN
code := E.UNDEF
END
RETURN code
END getCharUTF8;
PROCEDURE getCharW1251 (file: tInput): INTEGER;
RETURN E.cpW1251[getByte(file)]
END getCharW1251;
PROCEDURE getCharCP866 (file: tInput): INTEGER;
RETURN E.cp866[getByte(file)]
END getCharCP866;
PROCEDURE getCharUTF16LE (file: tInput): INTEGER;
RETURN getByte(file) + getByte(file) * 256
END getCharUTF16LE;
PROCEDURE getString* (file: tInput; line: Lines.tLine; VAR eol: BOOLEAN): INTEGER;
VAR
c: WCHAR;
i, L, k, n: INTEGER;
s: ARRAY 1000 OF WCHAR;
BEGIN
L := LEN(s);
eol := FALSE;
n := 0;
i := ORD(file.cnt > 0) - 1;
WHILE (file.cnt > 0) & ~eol DO
c := WCHR(file.getChar(file) MOD 65536);
IF c = CR THEN
eol := TRUE;
file.CR := TRUE
ELSIF (c = LF) OR (c = 0X) THEN
IF ~file.CR THEN
eol := TRUE
END;
file.CR := FALSE
ELSIF c = TAB THEN
k := TAB_SIZE - i MOD TAB_SIZE;
WHILE k > 0 DO
s[i] := SPACE;
INC(i);
IF i = L THEN
Lines.concat(line, s);
INC(n, i);
i := 0
END;
DEC(k)
END;
file.CR := FALSE
ELSIF c = BOM THEN
file.CR := FALSE
ELSE
s[i] := c;
INC(i);
IF i = L THEN
Lines.concat(line, s);
INC(n, i);
i := 0
END;
file.CR := FALSE
END
END;
IF i >= 0 THEN
s[i] := 0X;
Lines.concat(line, s);
END;
INC(n, i)
RETURN n
END getString;
PROCEDURE detectEncoding (text: tInput): INTEGER;
VAR
pos, cnt, res: INTEGER;
continue, bom: BOOLEAN;
b: BYTE;
cp866, w1251: INTEGER;
BEGIN
pos := text.pos;
cnt := text.cnt;
continue := TRUE;
WHILE (text.cnt > 0) & continue DO
IF getByte(text) > 127 THEN
continue := FALSE
END
END;
text.cnt := cnt;
text.pos := pos;
IF continue THEN
res := E.CP866
ELSE
bom := getCharUTF8(text) = ORD(BOM);
continue := TRUE;
text.cnt := cnt;
text.pos := pos;
WHILE (text.cnt > 0) & continue DO
IF getCharUTF8(text) = E.UNDEF THEN
continue := FALSE
END
END;
IF continue THEN
IF bom THEN
res := E.UTF8BOM
ELSE
res := E.UTF8
END
ELSE
text.cnt := cnt;
text.pos := pos;
cp866 := 0;
w1251 := 0;
WHILE text.cnt > 0 DO
b := getByte(text);
IF b > 127 THEN
IF b >= 192 THEN
INC(w1251)
ELSE
INC(cp866)
END
END
END;
IF w1251 > cp866 THEN
res := E.W1251
ELSE
res := E.CP866
END
END;
text.cnt := cnt;
text.pos := pos
END
RETURN res
END detectEncoding;
PROCEDURE load* (name: tFileName; VAR enc: INTEGER): tInput;
VAR
res: tInput;
fsize: INTEGER;
BEGIN
NEW(res);
res.pos := 0;
res.CR := FALSE;
res.getChar := NIL;
res.clipbrd := FALSE;
fsize := File.FileSize(name);
IF fsize = 0 THEN
res.buffer := KOSAPI.malloc(4096);
ASSERT(res.buffer # 0);
res.cnt := 0
ELSE
res.buffer := File.Load(name, res.cnt)
END;
IF res.buffer = 0 THEN
DISPOSE(res)
ELSE
enc := detectEncoding(res);
IF (enc = E.UTF8BOM) OR (enc = E.UTF8) THEN
res.getChar := getCharUTF8
ELSIF enc = E.CP866 THEN
res.getChar := getCharCP866
ELSIF enc = E.W1251 THEN
res.getChar := getCharW1251
END;
res.enc := enc
END
RETURN res
END load;
PROCEDURE clipboard* (): tInput;
VAR
res: tInput;
BEGIN
NEW(res);
res.pos := 0;
res.CR := FALSE;
res.clipbrd := TRUE;
res.getChar := NIL;
res.enc := E.CP866;
res.getChar := getCharCP866;
res.buffer := CB.get(res.cnt);
IF res.buffer = 0 THEN
DISPOSE(res)
END
RETURN res
END clipboard;
PROCEDURE putByte (file: tOutput; b: BYTE);
VAR
c: INTEGER;
BEGIN
IF file.pos = BUF_SIZE THEN
c := File.Write(file.handle, SYSTEM.ADR(file.buffer[0]), BUF_SIZE);
file.pos := 0
END;
file.buffer[file.pos] := b;
INC(file.pos)
END putByte;
PROCEDURE putString* (file: tOutput; line: Lines.tLine; n: INTEGER): INTEGER;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < n) & file.putChar(file, ORD(Lines.getChar(line, i))) DO
INC(i)
END
RETURN i
END putString;
PROCEDURE newLine* (file: tOutput): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (file.eol[i] # 0X) & file.putChar(file, ORD(file.eol[i])) DO
INC(i)
END
RETURN i = LENGTH(file.eol)
END newLine;
PROCEDURE putCharUTF8 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := TRUE;
IF code <= 7FH THEN
putByte(file, code)
ELSIF (80H <= code) & (code <= 7FFH) THEN
putByte(file, code DIV 64 + 0C0H);
putByte(file, code MOD 64 + 080H)
ELSIF (800H <= code) & (code <= 0FFFFH) THEN
putByte(file, code DIV 4096 + 0E0H);
putByte(file, (code DIV 64) MOD 64 + 080H);
putByte(file, code MOD 64 + 080H)
ELSE
res := FALSE
END
RETURN res
END putCharUTF8;
PROCEDURE putCharW1251 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
n: INTEGER;
res: BOOLEAN;
BEGIN
res := TRUE;
n := E.UNI[code, E.W1251];
IF n # E.UNDEF THEN
putByte(file, n)
ELSE
res := FALSE
END
RETURN res
END putCharW1251;
PROCEDURE putCharCP866 (file: tOutput; code: INTEGER): BOOLEAN;
VAR
n: INTEGER;
res: BOOLEAN;
BEGIN
res := TRUE;
n := E.UNI[code, E.CP866];
IF n # E.UNDEF THEN
putByte(file, n)
ELSE
res := FALSE
END
RETURN res
END putCharCP866;
PROCEDURE putCharUTF16LE (file: tOutput; code: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF (0 <= code) & (code <= 65535) THEN
res := TRUE;
putByte(file, code MOD 256);
putByte(file, code DIV 256)
ELSE
res := FALSE
END
RETURN res
END putCharUTF16LE;
PROCEDURE close* (VAR file: tOutput): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := TRUE;
IF file # NIL THEN
IF file.handle # NIL THEN
IF file.pos > 0 THEN
res := File.Write(file.handle, SYSTEM.ADR(file.buffer[0]), file.pos) = file.pos
END;
File.Close(file.handle)
END;
DISPOSE(file)
END
RETURN res
END close;
PROCEDURE create* (name: tFileName; enc, nl: INTEGER): tOutput;
VAR
res: tOutput;
BEGIN
NEW(res);
res.pos := 0;
res.eol := eol[nl];
res.putChar := NIL;
IF (enc = E.UTF8) OR (enc = E.UTF8BOM) THEN
res.putChar := putCharUTF8;
IF enc = E.UTF8BOM THEN
ASSERT(res.putChar(res, ORD(BOM)))
END
ELSIF enc = E.UTF16LE THEN
res.putChar := putCharUTF16LE;
ELSIF enc = E.W1251 THEN
res.putChar := putCharW1251
ELSIF enc = E.CP866 THEN
res.putChar := putCharCP866
END;
ASSERT(res.putChar # NIL);
res.handle := File.Create(name);
IF res.handle = NIL THEN
DISPOSE(res)
END
RETURN res
END create;
PROCEDURE destroy* (VAR file: tInput);
BEGIN
IF file # NIL THEN
IF file.buffer # 0 THEN
file.buffer := KOSAPI.free(file.buffer - 12*ORD(file.clipbrd))
END;
DISPOSE(file)
END
END destroy;
BEGIN
eol[EOL_LF] := LF;
eol[EOL_CRLF] := CR + LF;
eol[EOL_CR] := CR
END RW.

123
programs/develop/cedit/SRC/Search.ob07 Normal file
View File

@@ -0,0 +1,123 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Search;
IMPORT
CB := Clipboard, List, Utils, SYSTEM;
TYPE
tBuffer* = CB.tBuffer;
IdxTable* = ARRAY 65536, 2 OF INTEGER;
tPos* = POINTER TO RECORD (List.tItem)
pos*: INTEGER
END;
PROCEDURE index* (text: tBuffer; VAR table: IdxTable; cs: BOOLEAN): tBuffer;
VAR
pChar, cnt, i: INTEGER;
c: WCHAR;
res: tBuffer;
BEGIN
pChar := text.dataPtr;
cnt := CB.bufSize(text) DIV 2;
FOR i := 0 TO 65535 DO
table[i, 1] := 0
END;
i := cnt;
WHILE i > 0 DO
SYSTEM.GET(pChar, c);
IF ~cs & Utils.cap(c) THEN
SYSTEM.PUT(pChar, c)
END;
INC(table[ORD(c), 1]);
INC(pChar, 2);
DEC(i)
END;
res := CB.create(cnt * SYSTEM.SIZE(INTEGER));
table[0, 0] := res.dataPtr;
FOR i := 1 TO 65535 DO
table[i, 0] := table[i - 1, 0] + table[i - 1, 1] * SYSTEM.SIZE(INTEGER)
END;
pChar := text.dataPtr;
i := 0;
WHILE i < cnt DO
SYSTEM.GET(pChar, c);
SYSTEM.PUT(table[ORD(c), 0], i);
INC(table[ORD(c), 0], SYSTEM.SIZE(INTEGER));
INC(pChar, 2);
INC(i)
END;
FOR i := 0 TO 65535 DO
DEC(table[i, 0], table[i, 1] * SYSTEM.SIZE(INTEGER))
END
RETURN res
END index;
PROCEDURE find* (text: tBuffer; table: IdxTable; s: ARRAY OF WCHAR; whole: BOOLEAN; list: List.tList);
VAR
k, pos, n, x, prev_item_pos: INTEGER;
item: tPos;
c1, c2: WCHAR;
flag: BOOLEAN;
BEGIN
n := LENGTH(s);
k := table[ORD(s[0]), 1];
pos := table[ORD(s[0]), 0];
prev_item_pos := 0;
WHILE k > 0 DO
SYSTEM.GET(pos, x);
IF Utils.streq(text.dataPtr + x*2, SYSTEM.ADR(s[0]), n) THEN
flag := whole;
IF flag THEN
IF x > 0 THEN
SYSTEM.GET(text.dataPtr + (x - 1)*2, c1);
ELSE
c1 := 0X
END;
SYSTEM.GET(text.dataPtr + (x + n)*2, c2);
flag := Utils.isLetter(c1) OR Utils.isLetter(c2) OR Utils.isDigit(c1) OR Utils.isDigit(c2) OR (c1 = "_") OR (c2 = "_")
END;
IF ~flag & (x >= prev_item_pos) THEN
prev_item_pos := x + n;
NEW(item);
item.pos := x;
List.append(list, item)
END
END;
INC(pos, SYSTEM.SIZE(INTEGER));
DEC(k)
END
END find;
END Search.

2144
programs/develop/cedit/SRC/Text.ob07 Normal file
View File

File diff suppressed because it is too large Load Diff

352
programs/develop/cedit/SRC/Utils.ob07 Normal file
View File

@@ -0,0 +1,352 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Utils;
IMPORT SYSTEM;
CONST
SPACE* = 20X;
SLASH* = "/";
OS* = "KOS";
PROCEDURE streq* (s1, s2: INTEGER; n: INTEGER): BOOLEAN;
VAR
c1, c2: WCHAR;
BEGIN
WHILE n > 0 DO
SYSTEM.GET(s1, c1);
SYSTEM.GET(s2, c2);
INC(s1, 2);
INC(s2, 2);
IF c1 = c2 THEN
DEC(n)
ELSE
n := 0
END
END
RETURN c1 = c2
END streq;
PROCEDURE append* (VAR s1: ARRAY OF WCHAR; s2: ARRAY OF WCHAR);
VAR
n1, n2, i, j: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
ASSERT(n1 + n2 < LEN(s1));
i := 0;
j := n1;
WHILE i < n2 DO
s1[j] := s2[i];
INC(i);
INC(j)
END;
s1[j] := 0X
END append;
PROCEDURE append8* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2, i, j: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
ASSERT(n1 + n2 < LEN(s1));
i := 0;
j := n1;
WHILE i < n2 DO
s1[j] := s2[i];
INC(i);
INC(j)
END;
s1[j] := 0X
END append8;
PROCEDURE reverse* (VAR s: ARRAY OF WCHAR);
VAR
ch: WCHAR;
i, j: INTEGER;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
ch := s[i];
s[i] := s[j];
s[j] := ch;
INC(i);
DEC(j)
END
END reverse;
PROCEDURE reverse8* (VAR s: ARRAY OF CHAR);
VAR
ch: CHAR;
i, j: INTEGER;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
ch := s[i];
s[i] := s[j];
s[j] := ch;
INC(i);
DEC(j)
END
END reverse8;
PROCEDURE int2str* (val: INTEGER; VAR s: ARRAY OF WCHAR);
VAR
i: INTEGER;
BEGIN
i := 0;
REPEAT
s[i] := WCHR(ORD("0") + val MOD 10);
INC(i);
val := val DIV 10
UNTIL val = 0;
s[i] := 0X;
reverse(s)
END int2str;
PROCEDURE isDigit* (ch: WCHAR): BOOLEAN;
RETURN ("0" <= ch) & (ch <= "9")
END isDigit;
PROCEDURE isHex* (ch: WCHAR): BOOLEAN;
RETURN ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")
END isHex;
PROCEDURE isLetter* (ch: WCHAR): BOOLEAN;
RETURN ("a" <= ch) & (ch <= "z") OR ("A" <= ch) & (ch <= "Z")
END isLetter;
PROCEDURE cap* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("a" <= ch) & (ch <= "z") THEN
ch := WCHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (430H <= ORD(ch)) & (ORD(ch) <= 44FH) THEN
ch := WCHR(ORD(ch) - 20H);
res := TRUE
ELSIF (450H <= ORD(ch)) & (ORD(ch) <= 45FH) THEN
ch := WCHR(ORD(ch) - 50H);
res := TRUE
ELSIF ch = 491X THEN
ch := 490X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END cap;
PROCEDURE cap8 (VAR ch: CHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("a" <= ch) & (ch <= "z") THEN
ch := CHR(ORD(ch) - (ORD("z") - ORD("Z")));
res := TRUE
ELSE
res := FALSE
END
RETURN res
END cap8;
PROCEDURE upcase* (VAR s: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF cap8(s[i]) THEN
END;
DEC(i)
END;
END upcase;
PROCEDURE upcase16* (VAR s: ARRAY OF WCHAR);
VAR
i: INTEGER;
BEGIN
i := LENGTH(s) - 1;
WHILE i >= 0 DO
IF cap(s[i]) THEN
END;
DEC(i)
END
END upcase16;
PROCEDURE low* (VAR ch: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF ("A" <= ch) & (ch <= "Z") THEN
ch := WCHR(ORD(ch) + (ORD("z") - ORD("Z")));
res := TRUE
ELSIF (410H <= ORD(ch)) & (ORD(ch) <= 42FH) THEN
ch := WCHR(ORD(ch) + 20H);
res := TRUE
ELSIF (400H <= ORD(ch)) & (ORD(ch) <= 40FH) THEN
ch := WCHR(ORD(ch) + 50H);
res := TRUE
ELSIF ch = 490X THEN
ch := 491X;
res := TRUE
ELSE
res := FALSE
END
RETURN res
END low;
PROCEDURE str2int* (s: ARRAY OF WCHAR; VAR val: INTEGER): BOOLEAN;
VAR
i, temp: INTEGER;
res, neg: BOOLEAN;
BEGIN
temp := 0;
res := TRUE;
neg := FALSE;
i := 0;
WHILE (s[i] # 0X) & (s[i] = SPACE) DO
INC(i)
END;
IF s[i] = "-" THEN
INC(i);
neg := TRUE
ELSIF s[i] = "+" THEN
INC(i)
END;
IF isDigit(s[i]) THEN
REPEAT
temp := temp * 10;
temp := temp + (ORD(s[i]) - ORD("0"));
INC(i)
UNTIL ~isDigit(s[i]);
IF neg THEN
temp := -temp
END;
val := temp
ELSE
res := FALSE
END
RETURN res
END str2int;
PROCEDURE getFileName* (path: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; ch: CHAR);
VAR
i, j: INTEGER;
BEGIN
j := 0;
i := LENGTH(path) - 1;
WHILE (i >= 0) & (path[i] # ch) DO
name[j] := path[i];
DEC(i);
INC(j)
END;
name[j] := 0X;
reverse8(name)
END getFileName;
PROCEDURE getPath* (fname: ARRAY OF CHAR; VAR path: ARRAY OF CHAR);
VAR
i, j: INTEGER;
BEGIN
j := 0;
i := LENGTH(fname) - 1;
WHILE (i >= 0) & (fname[i] # SLASH) DO
DEC(i)
END;
path := fname;
path[i] := 0X
END getPath;
PROCEDURE lg10* (n: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := 0;
WHILE n >= 10 DO
n := n DIV 10;
INC(res)
END
RETURN res
END lg10;
PROCEDURE sgn* (x: INTEGER): INTEGER;
BEGIN
IF x > 0 THEN
x := 1
ELSIF x < 0 THEN
x := -1
ELSE
x := 0
END
RETURN x
END sgn;
PROCEDURE ptr2str* (ptr: INTEGER; VAR s: ARRAY OF CHAR);
VAR
i, n: INTEGER;
BEGIN
i := -1;
n := LEN(s) - 1;
REPEAT
INC(i);
SYSTEM.GET(ptr, s[i]);
INC(ptr)
UNTIL (i = n) OR (s[i] = 0X);
s[i] := 0X
END ptr2str;
END Utils.

289
programs/develop/cedit/SRC/box_lib.ob07 Normal file
View File

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

120
programs/develop/cedit/SRC/libimg.ob07 Normal file
View File

@@ -0,0 +1,120 @@
(*
Copyright 2016, 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE LibImg;
IMPORT SYSTEM, KOSAPI, File;
VAR
file : INTEGER;
img_decode : PROCEDURE (data, size, options: INTEGER): INTEGER;
img_to_rgb2 : PROCEDURE (data, data_rgb: INTEGER);
img_scale : PROCEDURE (src, crop_x, crop_y, crop_width, crop_height, dst, scale, inter, param1, param2: INTEGER): INTEGER;
img_destroy* : PROCEDURE (img: INTEGER);
PROCEDURE GetInf*(img: INTEGER; VAR sizeX, sizeY, data: INTEGER);
BEGIN
SYSTEM.GET(img + 4, sizeX);
SYSTEM.GET(img + 8, sizeY);
SYSTEM.GET(img + 24, data);
END GetInf;
PROCEDURE GetImg*(ptr, n, Width: INTEGER; VAR sizeY: INTEGER): INTEGER;
VAR image_data, dst, x, y, type, rgb, data: INTEGER;
BEGIN
image_data := img_decode(ptr, n, 0);
IF image_data # 0 THEN
SYSTEM.GET(image_data + 4, x);
SYSTEM.GET(image_data + 8, y);
SYSTEM.GET(image_data + 20, type);
IF type # 2 THEN
rgb := KOSAPI.malloc(x * y * 3);
IF rgb # 0 THEN
img_to_rgb2(image_data, rgb);
SYSTEM.GET(image_data + 24, data);
data := KOSAPI.free(data);
SYSTEM.PUT(image_data + 24, rgb);
SYSTEM.PUT(image_data + 20, 2)
ELSE
img_destroy(image_data);
image_data := 0
END
END;
IF (x > Width) & (image_data # 0) THEN
dst := img_scale(image_data, 0, 0, x, y, dst, 3, 1, Width, (y * Width) DIV x);
img_destroy(image_data);
image_data := dst
END;
IF image_data # 0 THEN
SYSTEM.GET(image_data + 8, sizeY)
END
END
RETURN image_data
END GetImg;
PROCEDURE LoadFromFile* (FName: ARRAY OF CHAR; Width: INTEGER; VAR sizeY: INTEGER): INTEGER;
VAR F: File.FS; n, size, res: INTEGER;
BEGIN
res := 0;
F := File.Open(FName);
IF F # NIL THEN
size := File.Seek(F, 0, File.SEEK_END);
n := File.Seek(F, 0, File.SEEK_BEG);
file := KOSAPI.malloc(size + 1024);
IF file # 0 THEN
n := File.Read(F, file, size);
res := GetImg(file, n, Width, sizeY);
n := KOSAPI.free(file)
END;
File.Close(F)
END
RETURN res
END LoadFromFile;
PROCEDURE load;
VAR Lib: INTEGER;
PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
VAR a: INTEGER;
BEGIN
a := KOSAPI.GetProcAdr(name, Lib);
ASSERT(a # 0);
SYSTEM.PUT(v, a)
END GetProc;
BEGIN
Lib := KOSAPI.LoadLib("/rd/1/Lib/Libimg.obj");
GetProc(Lib, SYSTEM.ADR(img_decode), "img_decode");
GetProc(Lib, SYSTEM.ADR(img_destroy), "img_destroy");
GetProc(Lib, SYSTEM.ADR(img_to_rgb2), "img_to_rgb2");
GetProc(Lib, SYSTEM.ADR(img_scale), "img_scale");
END load;
BEGIN
load
END LibImg.

143
programs/develop/cedit/SRC/scroll.ob07 Normal file
View File

@@ -0,0 +1,143 @@
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Scroll;
IMPORT G := Graph;
TYPE
tScroll* = POINTER TO RECORD
vertical, mouse: BOOLEAN;
canvas: G.tCanvas;
xSize*, ySize*, pos, mousePos: INTEGER;
color, bkColor: INTEGER;
value*, maxVal*: INTEGER
END;
PROCEDURE draw* (scroll: tScroll; x, y: INTEGER);
VAR
pos, a, b: INTEGER;
canvas: G.tCanvas;
BEGIN
IF scroll.vertical THEN
a := scroll.ySize;
b := scroll.xSize
ELSE
a := scroll.xSize;
b := scroll.ySize
END;
IF scroll.maxVal > 0 THEN
pos := (a - b)*scroll.value DIV scroll.maxVal
ELSE
pos := 0
END;
canvas := scroll.canvas;
G.SetColor(canvas, scroll.bkColor);
G.clear(canvas);
G.SetColor(canvas, 0808080H);
G.Rect(canvas, 0, 0, scroll.xSize - 1, scroll.ySize - 1);
G.SetColor(canvas, scroll.color);
DEC(b, 2);
IF scroll.vertical THEN
G.FillRect(canvas, 1, pos + 1, b, pos + b);
G.SetColor(canvas, 0404040H);
G.HLine(canvas, pos + 1 + b DIV 2, 4, b - 4);
G.HLine(canvas, pos + 1 + b DIV 2 - 3, 6, b - 6);
G.HLine(canvas, pos + 1 + b DIV 2 + 3, 6, b - 6);
ELSE
G.FillRect(canvas, pos + 1, 1, pos + b, b);
G.SetColor(canvas, 0404040H);
G.VLine(canvas, pos + b DIV 2, 4, b - 4);
G.VLine(canvas, pos + b DIV 2 - 3, 6, b - 6);
G.VLine(canvas, pos + b DIV 2 + 3, 6, b - 6);
END;
scroll.pos := pos;
G.DrawCanvas(canvas, x, y);
END draw;
PROCEDURE create* (xSize, ySize: INTEGER; color, bkColor: INTEGER): tScroll;
VAR
scroll: tScroll;
BEGIN
NEW(scroll);
scroll.xSize := xSize;
scroll.ySize := ySize;
scroll.vertical := xSize < ySize;
scroll.maxVal := 30;
scroll.value := 0;
scroll.mouse := FALSE;
scroll.bkColor := bkColor;
scroll.color := color;
scroll.canvas := G.CreateCanvas(xSize, ySize)
RETURN scroll
END create;
PROCEDURE resize* (scroll: tScroll; xSize, ySize: INTEGER);
BEGIN
scroll.xSize := xSize;
scroll.ySize := ySize;
scroll.vertical := xSize < ySize;
G.destroy(scroll.canvas);
scroll.canvas := G.CreateCanvas(xSize, ySize);
END resize;
PROCEDURE mouse* (scroll: tScroll; x, y: INTEGER);
VAR
pos, b: INTEGER;
BEGIN
IF scroll.vertical THEN
pos := y - 1;
b := scroll.xSize - 2
ELSE
pos := x - 1;
b := scroll.ySize - 2
END;
IF ~scroll.mouse THEN
scroll.mouse := TRUE;
IF (scroll.pos <= pos) & (pos <= scroll.pos + b - 1) THEN
scroll.mousePos := pos - scroll.pos
ELSE
scroll.mousePos := b DIV 2;
scroll.value := (pos - scroll.mousePos)*scroll.maxVal DIV ABS(scroll.xSize - scroll.ySize)
END
ELSE
scroll.value := (pos - scroll.mousePos)*scroll.maxVal DIV ABS(scroll.xSize - scroll.ySize)
END;
IF scroll.value < 0 THEN
scroll.value := 0
ELSIF scroll.value > scroll.maxVal THEN
scroll.value := scroll.maxVal
END
END mouse;
PROCEDURE MouseUp* (scroll: tScroll);
BEGIN
IF scroll # NIL THEN
scroll.mouse := FALSE
END
END MouseUp;
END Scroll.