CEDIT: new version

git-svn-id: svn://kolibrios.org@9174 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2021-09-02 23:15:33 +00:00
parent 1a5f178264
commit e85879654e
19 changed files with 1547 additions and 492 deletions

Binary file not shown.

View File

@ -1,4 +1,6 @@
[paths]
[settings]
tab=4
blink=70
build=
run=
debug=
@ -70,3 +72,8 @@ KW3 =
KW1 =
KW2 =
KW3 =
[lang_JSON]
KW1 =
KW2 = true,false,null
KW3 =

View File

@ -0,0 +1,39 @@
Горячие клавиши:
ctrl+A выделить всё
ctrl+C копировать
ctrl+V вставить
ctrl+X вырезать
ctrl+L преобразовать в нижний регистр
ctrl+U преобразовать в верхний регистр
ctrl+F показать панель поиска
Esc закрыть панель поиска
F3 найти следующий
shift+F3 найти предыдущий
ctrl+Z отменить
ctrl+Y вернуть
ctrl+G перейти на строку...
ctrl+Del удалить строку
ctrl+D дублировать строку
ctrl+Up переместить строку вверх
ctrl+Down переместить строку вниз
Tab увеличить отступ для выделенного текста
shift+
Backspace уменьшить отступ для выделенного текста
ctrl+F2 установить/снять метку
F2 перейти к метке ниже
shift+F2 перейти к метке выше
ctrl+S сохранить
ctrl+O открыть
ctrl+N создать новый
ctrl+W закрыть файл
ctrl+Tab переключиться на следующую вкладку
ctrl+F9 компилировать
F9 выполнить
перемещение по тексту:
(ctrl+)Home, (ctrl+)End, (ctrl+)PageUp, (ctrl+)PageDown

File diff suppressed because it is too large Load Diff

View File

@ -24,6 +24,7 @@ IMPORT SYSTEM, K := KOSAPI, E := Encodings, Lines;
CONST
TTEXT = 0;
lenEOL* = 2;
TAB = 9X;
TYPE
tBuffer* = POINTER TO RECORD
@ -53,18 +54,22 @@ BEGIN
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);
IF wch # Lines.TAB1 THEN
SYSTEM.PUT(pchar, CHR(E.UNI[ORD(wch), E.CP866] MOD 256));
INC(pchar)
ELSE
DEC(size);
END;
INC(ptr, 2);
DEC(cnt)
END;
SYSTEM.PUT32(a, size);
K.sysfunc2(54, 3);
K.sysfunc4(54, 2, size, a)
END put;

View File

@ -284,6 +284,8 @@ BEGIN
IF outFile # NIL THEN
IF size # 0 THEN
res := Write(outFile, buf, size) = size
ELSE
res := TRUE
END;
Close(outFile)
END;

View File

@ -19,7 +19,7 @@
MODULE Graph;
IMPORT SYSTEM, K := KOSAPI;
IMPORT SYSTEM, K := KOSAPI, Lines;
CONST
@ -27,6 +27,11 @@ CONST
modeNOT = 1;
modeXOR = 2;
triUp* = FALSE;
triDown* = TRUE;
triLeft* = FALSE;
triRight* = TRUE;
TYPE
tFont* = POINTER TO RECORD
@ -177,6 +182,35 @@ BEGIN
END DLine;
PROCEDURE Triangle* (canvas: tCanvas; x1, y1, x2, y2: INTEGER; orientation: BOOLEAN);
VAR
i, a, b, d: INTEGER;
BEGIN
d := ORD(orientation)*2 - 1;
IF y1 = y2 THEN
i := y1;
a := MIN(x1, x2);
b := MAX(x1, x2);
WHILE a <= b DO
HLine(canvas, i, a, b);
INC(i, d);
INC(a);
DEC(b)
END
ELSIF x1 = x2 THEN
i := x1;
a := MIN(y1, y2);
b := MAX(y1, y2);
WHILE a <= b DO
VLine(canvas, i, a, b);
INC(i, d);
INC(a);
DEC(b)
END
END
END Triangle;
PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
VAR
y: INTEGER;
@ -218,6 +252,7 @@ CONST
WCHAR_SIZE = 2;
VAR
color, i: INTEGER;
c: WCHAR;
BEGIN
IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN
IF x < 0 THEN
@ -233,13 +268,16 @@ BEGIN
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);
WHILE n > 0 DO
SYSTEM.GET(text + i*WCHAR_SIZE, c);
IF ~Lines.isSpace(c) THEN
K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, SYSTEM.ADR(c), 1, canvas.bitmap - 8)
END;
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
(*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;

View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2021 Anton Krotov
This file is part of CEdit.

View File

@ -21,7 +21,7 @@ MODULE Ini;
IMPORT
KOSAPI, SYSTEM, RW, Text, Utils, File, List, Languages, KolibriOS;
KOSAPI, SYSTEM, RW, Text, Utils, File, List, Languages, KolibriOS, Lines;
CONST
@ -46,7 +46,7 @@ TYPE
VAR
get_color: PROCEDURE [stdcall] (f_name: RW.tFileName; sec_name: tASCIISectionName; key_name: tString; def_val: INTEGER): INTEGER;
get_color, get_int: 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);
@ -55,6 +55,7 @@ VAR
curSection*: tASCIISectionName;
curSectionNum*: INTEGER;
blink*: INTEGER;
PROCEDURE getColor (key: tString; def: INTEGER): INTEGER;
@ -145,6 +146,21 @@ BEGIN
END selectSection;
PROCEDURE getSettings* (VAR build, run, debug: RW.tFileName);
BEGIN
Lines.setTabs(get_int(IniFileName, "settings", "tab", 4));
blink := get_int(IniFileName, "settings", "blink", 70);
IF blink = 0 THEN
blink := -1
ELSE
blink := MIN(MAX(blink, 1), 1000)
END;
getStr("settings", "build", build);
getStr("settings", "run", run);
getStr("settings", "debug", debug)
END getSettings;
PROCEDURE load* (path: RW.tFileName);
VAR
Lib: INTEGER;
@ -160,16 +176,18 @@ VAR
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);
Utils.getPath(path, IniFileName);
Utils.append8(IniFileName, Utils.SLASH);
Utils.append8(IniFileName, fileName);
IF ~File.Exists(IniFileName) THEN
IniFileName := "/rd/1/settings/cedit.ini"
END;
Lib := KOSAPI.LoadLib("/rd/1/Lib/Libini.obj");
GetProc(Lib, SYSTEM.ADR(get_color), "ini_get_color");
GetProc(Lib, SYSTEM.ADR(get_int), "ini_get_int");
GetProc(Lib, SYSTEM.ADR(get_str), "ini_get_str");
GetProc(Lib, SYSTEM.ADR(enum_sections), "ini_enum_sections");

View File

@ -319,13 +319,13 @@ END malloc;
PROCEDURE SetIPC* (buffer: ARRAY OF INTEGER);
BEGIN
KOSAPI.sysfunc4(60, 1, SYSTEM.ADR(buffer[0]), LEN(buffer)*SYSTEM.SIZE(INTEGER));
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))
KOSAPI.sysfunc5(60, 2, tid, SYSTEM.ADR(msg), SYSTEM.SIZE(INTEGER))
END SendIPC;

View File

@ -25,9 +25,9 @@ IMPORT Lines;
CONST
langNone* = 0; langC* = 1; langOberon* = 2; langPascal* = 3;
langFasm* = 4; langLua* = 5; langIni* = 6;
langFasm* = 4; langLua* = 5; langIni* = 6; langJSON* = 7;
csLang = {langC, langOberon, langLua, langIni};
csLang = {langC, langOberon, langLua, langIni, langJSON};
TYPE
@ -42,7 +42,7 @@ TYPE
VAR
oberonKW, cKW, pascalKW, luaKW, iniKW, fasmKW: ARRAY 3 OF tKeyWords;
oberonKW, cKW, pascalKW, luaKW, iniKW, fasmKW, jsonKW: ARRAY 3 OF tKeyWords;
PROCEDURE isCS* (lang: INTEGER): BOOLEAN;
@ -66,14 +66,16 @@ PROCEDURE isKey* (s: ARRAY OF WCHAR; lang, kwSet: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
DEC(kwSet);
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])
|langC: res := checkKW(s, cKW[kwSet])
|langOberon: res := checkKW(s, oberonKW[kwSet])
|langPascal: res := checkKW(s, pascalKW[kwSet])
|langLua: res := checkKW(s, luaKW[kwSet])
|langIni: res := checkKW(s, iniKW[kwSet])
|langFasm: res := checkKW(s, fasmKW[kwSet])
|langJSON: res := checkKW(s, jsonKW[kwSet])
END
RETURN res
END isKey;
@ -317,7 +319,8 @@ BEGIN
CASE lang OF
|langNone:
|langFasm:
|langC: C(line, depth, cond, pos, n)
|langC,
langJSON: 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)
@ -381,6 +384,7 @@ BEGIN
loadKW(luaKW, getStr, "lang_Lua");
loadKW(iniKW, getStr, "lang_Ini");
loadKW(fasmKW, getStr, "lang_Fasm");
loadKW(jsonKW, getStr, "lang_JSON");
END init;

View File

@ -24,7 +24,9 @@ IMPORT
CONST
WCHAR_SIZE = 2;
SPACE = 20X;
SPACE* = 20X;
TAB* = 9X;
TAB1* = 0FFFEX;
TYPE
@ -51,7 +53,8 @@ VAR
(* _typedPtr: PTypedPtr;
_untypedPtr: PUntypedPtr;*)
pMaxLength: INTEGER;
pMaxLength, tab*: INTEGER;
tabs*: BOOLEAN;
PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
@ -166,15 +169,28 @@ BEGIN
END destroy;
PROCEDURE modify* (line: tLine);
PROCEDURE getChar* (line: tLine; i: INTEGER): WCHAR;
VAR
c: WCHAR;
BEGIN
IF ~line.temp THEN
movBool(line.modified, TRUE);
movBool(line.saved, FALSE)
END;
line.modified := TRUE;
line.saved := FALSE
END modify;
SYSTEM.GET(line.ptr + i*WCHAR_SIZE, c)
RETURN c
END getChar;
PROCEDURE tabWidth (line: tLine; pos: INTEGER): INTEGER;
VAR
n: INTEGER;
BEGIN
n := pos;
IF getChar(line, pos) = TAB THEN
INC(pos);
WHILE getChar(line, pos) = TAB1 DO
INC(pos)
END
END
RETURN pos - n
END tabWidth;
PROCEDURE save* (line: tLine);
@ -188,13 +204,9 @@ BEGIN
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 isSpace* (c: WCHAR): BOOLEAN;
RETURN (c = SPACE) OR (c = TAB) OR (c = TAB1)
END isSpace;
PROCEDURE trimLength* (line: tLine): INTEGER;
@ -202,7 +214,7 @@ VAR
i: INTEGER;
BEGIN
i := line.length - 1;
WHILE (i >= 0) & (getChar(line, i) = SPACE) DO
WHILE (i >= 0) & isSpace(getChar(line, i)) DO
DEC(i)
END
RETURN i + 1
@ -345,6 +357,44 @@ BEGIN
END delCharN;
PROCEDURE fixTabs (line: tLine);
VAR
i, n, k: INTEGER;
BEGIN
i := 0;
WHILE i < line.length DO
n := tabWidth(line, i);
IF n # 0 THEN
k := tab - i MOD tab;
IF n > k THEN
delCharN(line, i + 1, n - k)
ELSIF n < k THEN
DEC(k, n);
insert3(line, i + 1, k);
WHILE k > 0 DO
setChar(line, i + 1, TAB1);
INC(i);
DEC(k)
END
END
END;
INC(i)
END
END fixTabs;
PROCEDURE modify* (line: tLine);
BEGIN
IF ~line.temp THEN
movBool(line.modified, TRUE);
movBool(line.saved, FALSE)
END;
line.modified := TRUE;
line.saved := FALSE;
fixTabs(line)
END modify;
PROCEDURE wrap* (line, nextLine: tLine; pos: INTEGER);
VAR
ptr1, ptr2: INTEGER;
@ -439,6 +489,16 @@ BEGIN
END setMaxLength;
PROCEDURE setTabs* (_tab: INTEGER);
BEGIN
IF _tab = 0 THEN
_tab := 4
END;
tabs := _tab > 0;
tab := ABS(_tab)
END setTabs;
BEGIN
pMaxLength := 0
END Lines.

View File

@ -23,13 +23,15 @@ IMPORT
SYSTEM, G := Graph, List, K := KolibriOS;
CONST
fontHeight = 20;
fontHeight = 22;
fontWidth = 8;
RIGHT = 16;
LEFT = 16;
TOP = 1;
maxLEVEL = 1;
backColor = 0F0F0F0H;
foreColor = 0;
selBackColor = 091C9F7H;
@ -41,14 +43,11 @@ CONST
TYPE
tItem* = POINTER TO RECORD (List.tItem)
id*, check: INTEGER;
text: ARRAY 32 OF WCHAR;
enabled, delim: BOOLEAN
END;
tMenu* = POINTER TO RECORD
tid*: INTEGER;
active*: BOOLEAN;
parent*, child: tMenu;
winX, winY, width*, height*: INTEGER;
selItem, cliItem: INTEGER;
@ -60,24 +59,49 @@ TYPE
key: PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN
END;
tItem* = POINTER TO RECORD (List.tItem)
id*, check: INTEGER;
text: ARRAY 32 OF WCHAR;
enabled, delim: BOOLEAN;
child: tMenu
END;
tClick = PROCEDURE (menu: tMenu; id: INTEGER);
tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
tProc = PROCEDURE;
VAR
lastTID*: INTEGER;
stack: ARRAY 250000 OF INTEGER;
stack: ARRAY maxLEVEL + 1, 250000 OF INTEGER;
TIDs: ARRAY maxLEVEL + 1 OF INTEGER;
resetTimer: tProc;
_open: PROCEDURE (m: tMenu; x, y: INTEGER);
redraw*: BOOLEAN;
PROCEDURE isSender* (tid: INTEGER): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i <= maxLEVEL) & (TIDs[i] # tid) DO
INC(i)
END
RETURN i <= maxLEVEL
END isSender;
PROCEDURE exit (m: tMenu);
BEGIN
m.tid := 0;
m.active := FALSE;
resetTimer;
K.Exit
END exit;
PROCEDURE repaint (m: tMenu);
VAR
y, i: INTEGER;
y, i, X, Y1, Y2: INTEGER;
item: tItem;
BkColor, TextColor: INTEGER;
canvas: G.tCanvas;
@ -115,17 +139,23 @@ BEGIN
G.SetBkColor(canvas, BkColor);
G.TextOut2(canvas, LEFT, y + (fontHeight - 16) DIV 2 - 2, item.text, LENGTH(item.text));
G.SetColor(canvas, TextColor);
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;
IF item.child # NIL THEN
X := m.width - 9;
Y1 := y + (fontHeight - 16) DIV 2 + 2;
Y2 := Y1 + 8;
G.Triangle(canvas, X, Y1, X, Y2, G.triRight)
END;
INC(y, fontHeight);
IF item.delim THEN
G.SetColor(canvas, ORD((-BITS(backColor))*{0..23}));
@ -157,18 +187,77 @@ BEGIN
END mouse;
PROCEDURE close* (m: tMenu);
BEGIN
IF (m # NIL) & (m.tid # 0) THEN
IF m.child # NIL THEN
close(m.child);
m.child := NIL
END;
K.ExitID(m.tid);
m.tid := 0;
m.active := FALSE
END
END close;
PROCEDURE click (m: tMenu; i: INTEGER);
VAR
item: List.tItem;
p: tMenu;
BEGIN
item := List.getItem(m.items, i);
IF (item # NIL) & item(tItem).enabled THEN
IF (item # NIL) & item(tItem).enabled & (item(tItem).child = NIL) THEN
m.click(m, item(tItem).id);
exit(m)
p := m.parent;
WHILE p # NIL DO
p.child := NIL;
close(p);
p := p.parent
END;
redraw := TRUE;
exit(m)
END
END click;
PROCEDURE opened* (m: tMenu): BOOLEAN;
RETURN m.tid # 0
END opened;
PROCEDURE isActive (m: tMenu): BOOLEAN;
RETURN (m # NIL) & ((m.tid # 0) & m.active OR isActive(m.child))
END isActive;
PROCEDURE closeChild (m: tMenu);
BEGIN
IF m.child # NIL THEN
redraw := FALSE;
close(m.child);
m.child := NIL
END
END closeChild;
PROCEDURE submenu (m: tMenu);
VAR
item: List.tItem;
BEGIN
item := List.getItem(m.items, m.selItem);
IF (item # NIL) & item(tItem).enabled & (item(tItem).child # NIL) THEN
IF ~opened(item(tItem).child) THEN
closeChild(m);
_open(item(tItem).child, m.winX + m.width - 2, m.winY + m.selItem*fontHeight);
m.child := item(tItem).child
END
ELSE
closeChild(m)
END
END submenu;
PROCEDURE [stdcall] window (m: tMenu);
VAR
x, y: INTEGER;
@ -199,6 +288,12 @@ BEGIN
click(m, m.selItem)
END;
m.cliItem := -1
ELSIF key DIV 65536 = 77 THEN
submenu(m)
ELSIF key DIV 65536 = 75 THEN
IF m.parent # NIL THEN
exit(m)
END
ELSE
IF m.key(m, key) THEN
exit(m)
@ -209,6 +304,7 @@ BEGIN
msState := K.MouseState();
mouse(m, x, y);
IF (0 <= x) & (x < m.width) & (0 <= y) & (y < m.height) THEN
m.active := TRUE;
m.selItem := (y - TOP) DIV fontHeight;
IF 8 IN msState THEN
m.cliItem := (y - TOP) DIV fontHeight
@ -220,17 +316,47 @@ BEGIN
m.cliItem := -1
END
ELSE
m.active := FALSE;
m.cliItem := -1;
IF {8, 9, 10} * msState # {} THEN
IF ({8, 9, 10, 16} * msState # {}) & ~isActive(m.child) THEN
exit(m)
END
END;
repaint(m)
repaint(m);
submenu(m)
END
END
END window;
PROCEDURE level (m: tMenu): INTEGER;
VAR
res: INTEGER;
BEGIN
res := 0;
WHILE m.parent # NIL DO
INC(res);
m := m.parent
END
RETURN res
END level;
PROCEDURE open* (m: tMenu; x, y: INTEGER);
VAR
L: INTEGER;
BEGIN
IF m.tid = 0 THEN
m.winX := x;
m.winY := y;
L := level(m);
SYSTEM.PUT(SYSTEM.ADR(stack[L][LEN(stack[0]) - 1]), m);
m.tid := K.CreateThread(SYSTEM.ADR(window), stack[L]);
TIDs[L] := m.tid
END
END open;
PROCEDURE AddMenuItem* (items: List.tList; id: INTEGER; s: ARRAY OF WCHAR);
VAR
item: tItem;
@ -240,6 +366,7 @@ BEGIN
item.text := s;
item.enabled := TRUE;
item.delim := FALSE;
item.child := NIL;
List.append(items, item);
END AddMenuItem;
@ -250,6 +377,12 @@ BEGIN
END delimiter;
PROCEDURE child* (items: List.tList; menu: tMenu);
BEGIN
items.last(tItem).child := menu
END child;
PROCEDURE getItem (m: tMenu; id: INTEGER): tItem;
VAR
item: tItem;
@ -293,32 +426,6 @@ BEGIN
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;
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);
m.tid := 0
END
END close;
PROCEDURE create* (items: List.tList; click: tClick; key: tKey): tMenu;
VAR
m: tMenu;
@ -327,6 +434,9 @@ VAR
BEGIN
NEW(m);
m.tid := 0;
m.active := FALSE;
m.parent := NIL;
m.child := NIL;
m.items := items;
m.click := click;
m.key := key;
@ -345,6 +455,23 @@ BEGIN
END create;
PROCEDURE Redraw*;
BEGIN
lastTID := 0
redraw := TRUE
END Redraw;
PROCEDURE init* (_resetTimer: tProc);
VAR
i: INTEGER;
BEGIN
Redraw;
resetTimer := _resetTimer;
_open := open;
FOR i := 0 TO maxLEVEL DO
TIDs[i] := 0
END
END init;
END Menu.

View File

@ -29,8 +29,6 @@ CONST
CR = 0DX; LF = 0AX; TAB = 9X; SPACE = 20X;
BOM = 0FEFFX;
TAB_SIZE* = 4;
BUF_SIZE = 65536;
NAME_LEN = 1024;
@ -166,7 +164,7 @@ PROCEDURE getCharUTF16LE (file: tInput): INTEGER;
END getCharUTF16LE;
PROCEDURE getString* (file: tInput; line: Lines.tLine; VAR eol: BOOLEAN): INTEGER;
PROCEDURE getString* (file: tInput; line: Lines.tLine; tabs: BOOLEAN; VAR eol: BOOLEAN): INTEGER;
VAR
c: WCHAR;
i, L, k, n: INTEGER;
@ -178,6 +176,9 @@ BEGIN
i := ORD(file.cnt > 0) - 1;
WHILE (file.cnt > 0) & ~eol DO
c := WCHR(file.getChar(file) MOD 65536);
IF c = Lines.TAB1 THEN
c := SPACE
END;
IF c = CR THEN
eol := TRUE;
file.CR := TRUE
@ -187,9 +188,20 @@ BEGIN
END;
file.CR := FALSE
ELSIF c = TAB THEN
k := TAB_SIZE - i MOD TAB_SIZE;
k := Lines.tab - i MOD Lines.tab;
IF tabs THEN
s[i] := TAB
ELSE
s[i] := SPACE
END;
INC(i);
DEC(k);
WHILE k > 0 DO
s[i] := SPACE;
IF tabs THEN
s[i] := Lines.TAB1
ELSE
s[i] := SPACE
END;
INC(i);
IF i = L THEN
Lines.concat(line, s);
@ -354,9 +366,19 @@ END putByte;
PROCEDURE putString* (file: tOutput; line: Lines.tLine; n: INTEGER): INTEGER;
VAR
i: INTEGER;
c: WCHAR;
err: BOOLEAN;
BEGIN
i := 0;
WHILE (i < n) & file.putChar(file, ORD(Lines.getChar(line, i))) DO
err := FALSE;
WHILE (i < n) & ~err DO
c := Lines.getChar(line, i);
IF c # Lines.TAB1 THEN
IF ~file.putChar(file, ORD(c)) THEN
err := TRUE;
DEC(i)
END
END;
INC(i)
END
RETURN i

View File

@ -26,8 +26,7 @@ CONST
btnID* = 100;
tabHeight* = 22;
curTabHeight = 26;
scrWidth = 10;
scrWidth = 15;
TYPE
@ -105,7 +104,7 @@ VAR
BEGIN
y := t.y;
x := t.x;
K.DrawRect(x, y - (curTabHeight - tabHeight), t.width + 2*scrWidth, t.height + (curTabHeight - tabHeight) - 1, K.winColor);
K.DrawRect(x, y - (curTabHeight - tabHeight), t.width + (2*scrWidth + 2), t.height + (curTabHeight - tabHeight) - 1, K.winColor);
IF Width(t, 0, t.strings.count - 1) > t.width THEN
INC(x, 2*scrWidth);
K.CreateButton(btnID - 1, t.x, t.y, scrWidth, t.height - 1, K.btnColor, "<");

View File

@ -33,8 +33,9 @@ IMPORT
CONST
SPACE = 20X;
TAB = RW.TAB_SIZE;
SPACE = Lines.SPACE;
TAB = Lines.TAB;
TAB1 = Lines.TAB1;
lenEOL = CB.lenEOL;
mark_width = 2;
@ -96,7 +97,7 @@ VAR
comment, string, num, delim, key1, key2, key3: INTEGER
END;
canvas: G.tCanvas;
drawCursor*: BOOLEAN;
drawCursor: BOOLEAN;
padding: RECORD left, top: INTEGER END;
size, textsize: tPoint;
charWidth, charHeight: INTEGER;
@ -121,6 +122,8 @@ BEGIN
text.lang := Lang.langLua
ELSIF ext = "INI" THEN
text.lang := Lang.langIni
ELSIF ext = "JSON" THEN
text.lang := Lang.langJSON
ELSE
text.lang := Lang.langNone
END
@ -176,6 +179,18 @@ BEGIN
END toggleCursor;
PROCEDURE showCursor*;
BEGIN
drawCursor := TRUE
END showCursor;
PROCEDURE hideCursor*;
BEGIN
drawCursor := FALSE
END hideCursor;
PROCEDURE getChar (line: tLine; i: INTEGER): WCHAR;
VAR
res: WCHAR;
@ -418,7 +433,7 @@ BEGIN
PrintLex(text, line, k, i, y, colors.num, backColor)
END
ELSIF lang = Lang.langC THEN
ELSIF (lang = Lang.langC) OR (lang = Lang.langJSON) THEN
IF depth = 0 THEN
IF c = "/" THEN
@ -434,11 +449,21 @@ BEGIN
INC(i);
PrintComment(text, line, depth, i, y, backColor);
cond := 0
ELSIF (c = "'") OR (c = '"') THEN
String(text, line, i, y, backColor);
cond := 0
ELSIF (U.isLetter(c) OR (c = "_")) THEN
ident(text, i, i - ORD((i > 0) & (getChar(line, i - 1) = "#")), y, line, backColor, Lang.isCS(lang));
ELSIF U.isLetter(c) OR (c = "_") OR (c = "'") OR (c = '"') THEN
k := i;
IF (c = "'") OR (c = '"') THEN
String(text, line, i, y, backColor);
ELSE
ident(text, i, i - ORD((lang = Lang.langC) & (i > 0) & (getChar(line, i - 1) = "#")), y, line, backColor, Lang.isCS(lang))
END;
IF lang = Lang.langJSON THEN
WHILE Lines.isSpace(getChar(line, i + 1)) DO
INC(i)
END;
IF getChar(line, i + 1) = ":" THEN
PrintLex(text, line, k, i, y, colors.key1, backColor)
END
END;
cond := 0
ELSIF U.isDigit(c) THEN
k := i;
@ -805,7 +830,7 @@ VAR
i: INTEGER;
BEGIN
i := 0;
WHILE getChar(line, i) = SPACE DO
WHILE Lines.isSpace(getChar(line, i)) DO
INC(i)
END
RETURN i
@ -926,8 +951,9 @@ END getLine;
PROCEDURE SetPos* (text: tText; x, y: INTEGER);
VAR
deltaY: INTEGER;
deltaY, n, L, R: INTEGER;
cursor: pPoint;
c: WCHAR;
(* trimLength: INTEGER; *)
BEGIN
cursor := text.cursor;
@ -949,6 +975,24 @@ BEGIN
END
END;
cursor.X := MIN(MAX(x, 0), text.curLine.length);
c := getChar(text.curLine, cursor.X);
IF c = TAB1 THEN
n := cursor.X;
WHILE getChar(text.curLine, n) = TAB1 DO
INC(n)
END;
R := n - cursor.X;
n := cursor.X;
WHILE getChar(text.curLine, n) # TAB DO
DEC(n)
END;
L := cursor.X - n;
IF L < R THEN
DEC(cursor.X, L)
ELSE
INC(cursor.X, R)
END
END;
IF text.scroll.Y > cursor.Y THEN
text.scroll.Y := cursor.Y
ELSIF text.scroll.Y + textsize.Y <= cursor.Y THEN
@ -965,7 +1009,6 @@ BEGIN
setSelect(text);
text.foundSel := 0;
ShowCursor;
drawCursor := TRUE;
text.CurX := -1
END SetPos;
@ -1022,7 +1065,7 @@ END delSelect;
PROCEDURE delete (text: tText);
VAR
i: INTEGER;
i, n: INTEGER;
nextLine, curLine: tLine;
BEGIN
IF selected(text) THEN
@ -1031,16 +1074,23 @@ BEGIN
i := text.cursor.X;
curLine := text.curLine;
IF i < curLine.length THEN
Lines.delChar(curLine, i);
n := i;
INC(i);
IF getChar(curLine, i - 1) = TAB THEN
WHILE getChar(curLine, i) = TAB1 DO
INC(i)
END
END;
Lines.delCharN(curLine, n, i - n);
Lines.modify(curLine);
modify(text)
ELSE
nextLine := curLine.next(tLine);
IF nextLine # NIL THEN
Lines.modify(curLine);
modify(text);
Lines.insert2(curLine, i, nextLine);
DelLine(text, nextLine)
DelLine(text, nextLine);
Lines.modify(curLine);
modify(text)
END
END
END;
@ -1048,43 +1098,60 @@ BEGIN
END delete;
PROCEDURE move (text: tText; d: INTEGER);
VAR
pos: INTEGER;
BEGIN
pos := text.cursor.X + d;
WHILE getChar(text.curLine, pos) = TAB1 DO
INC(pos, d)
END;
SetPos(text, pos, text.cursor.Y)
END move;
PROCEDURE BkSpace (text: tText);
VAR
i, n, k: INTEGER;
curLine, line: tLine;
i, k, n: INTEGER;
curLine, line, line2: tLine;
BEGIN
IF selected(text) THEN
delSelect(text)
ELSE
resetSelect(text);
i := text.cursor.X;
curLine := text.curLine;
IF i > 0 THEN
modify(text);
IF text.cursor.X > 0 THEN
i := text.cursor.X;
n := leadingSpaces(curLine);
IF n < i THEN
Lines.delChar(curLine, i - 1);
Lines.modify(curLine);
k := 1
modify(text);
move(text, -1);
delete(text)
ELSE
n := i;
line := curLine.prev(tLine);
line2 := line;
k := n;
WHILE (line # NIL) & (k >= n) DO
IF Lines.trimLength(line) # 0 THEN
k := leadingSpaces(line)
k := leadingSpaces(line);
line2 := line;
END;
PrevLine(line)
END;
IF k >= n THEN
k := 0
END;
DEC(n, k);
k := n;
n := k;
Lines.delCharN(curLine, 0, i);
Lines.insert3(curLine, 0, k);
WHILE k > 0 DO
Lines.setChar(curLine, k - 1, getChar(line2, k - 1));
DEC(k)
END;
Lines.modify(curLine);
Lines.delCharN(curLine, 0, n)
END;
SetPos(text, text.cursor.X - k, text.cursor.Y)
SetPos(text, n, text.cursor.Y)
END
ELSE
PrevLine(curLine);
IF curLine # NIL THEN
@ -1100,16 +1167,15 @@ END BkSpace;
PROCEDURE enter (text: tText);
VAR
n: INTEGER;
curLine, newLine, line: tLine;
curLine, newLine, line, line2: tLine;
BEGIN
delSelect(text);
newLine := Lines.create(FALSE);
Lines.modify(newLine);
modify(text);
curLine := text.curLine;
IF text.cursor.X < curLine.length THEN
Lines.modify(curLine);
Lines.wrap(curLine, newLine, text.cursor.X)
Lines.wrap(curLine, newLine, text.cursor.X);
Lines.modify(curLine)
END;
List._insert(text, curLine, newLine);
SetPos(text, 0, text.cursor.Y + 1);
@ -1117,7 +1183,8 @@ BEGIN
n := -1;
WHILE (line # NIL) & (n = -1) DO
IF (*line.length*)Lines.trimLength(line) # 0 THEN
n := leadingSpaces(line)
n := leadingSpaces(line);
line2 := line
END;
PrevLine(line)
END;
@ -1128,35 +1195,113 @@ BEGIN
SetPos(text, n, text.cursor.Y);
resetSelect(text);
WHILE n > 0 DO
Lines.setChar(text.curLine, n - 1, SPACE);
Lines.setChar(text.curLine, n - 1, getChar(line2, n - 1));
DEC(n)
END
END;
Lines.modify(newLine)
END enter;
PROCEDURE incIndent (line: tLine);
VAR
c: WCHAR;
i: INTEGER;
BEGIN
Lines.modify(line);
Lines.insert3(line, 0, Lines.tab);
IF Lines.tabs THEN
c := TAB1
ELSE
c := SPACE
END;
i := Lines.tab - 1;
WHILE i >= 0 DO
Lines.setChar(line, i, c);
DEC(i)
END;
IF Lines.tabs THEN
Lines.setChar(line, 0, TAB)
END
END incIndent;
PROCEDURE decIndent (line: tLine): BOOLEAN;
VAR
n: INTEGER;
BEGIN
n := leadingSpaces(line);
IF n > 0 THEN
Lines.delCharN(line, 0, MIN(Lines.tab, n));
Lines.modify(line)
END
RETURN n > 0
END decIndent;
PROCEDURE Indent* (text: tText; incr: BOOLEAN);
VAR
i: INTEGER;
line: tLine;
selBeg, selEnd: tPoint;
modified: BOOLEAN;
BEGIN
getSelect(text, selBeg, selEnd);
i := selEnd.Y - selBeg.Y + 1;
line := getLine(text, selBeg.Y);
modified := incr;
WHILE i > 0 DO
IF incr THEN
incIndent(line)
ELSE
modified := decIndent(line) OR modified
END;
NextLine(line);
DEC(i)
END;
line := getLine(text, selEnd.Y);
text.select^ := selBeg;
text.select.X := 0;
SetPos(text, line.length, selEnd.Y);
IF modified THEN
modify(text)
END
END Indent;
PROCEDURE input* (text: tText; code: INTEGER);
VAR
curLine: tLine;
PROCEDURE tab (text: tText);
VAR
i, x: INTEGER;
curLine: tLine;
c: WCHAR;
BEGIN
delSelect(text);
curLine := text.curLine;
x := text.cursor.X;
Lines.modify(curLine);
modify(text);
i := TAB - x MOD TAB;
Lines.insert3(curLine, x, i);
SetPos(text, x + i, text.cursor.Y);
WHILE i > 0 DO
Lines.setChar(curLine, x + i - 1, SPACE);
DEC(i)
END
delSelect(text);
curLine := text.curLine;
x := text.cursor.X;
i := Lines.tab - x MOD Lines.tab;
Lines.insert3(curLine, x, i);
SetPos(text, x + i, text.cursor.Y);
IF Lines.tabs THEN
c := TAB1
ELSE
c := SPACE
END;
WHILE i > 0 DO
Lines.setChar(curLine, x + i - 1, c);
DEC(i)
END;
IF Lines.tabs THEN
Lines.setChar(curLine, x + i, TAB)
END;
Lines.modify(curLine);
modify(text)
END tab;
BEGIN
IF (code >= ORD(SPACE)) & (code # 127) THEN
delSelect(text);
@ -1166,9 +1311,17 @@ BEGIN
modify(text);
SetPos(text, text.cursor.X + 1, text.cursor.Y)
ELSIF code = 8 THEN
BkSpace(text)
BkSpace(text)
ELSIF code = -8 THEN
IF selected(text) THEN
Indent(text, FALSE)
END
ELSIF code = 9 THEN
tab(text)
IF selected(text) THEN
Indent(text, TRUE)
ELSE
tab(text)
END
ELSIF code = 13 THEN
enter(text)
END
@ -1276,7 +1429,8 @@ BEGIN
END;
redoGuard(text, guard);
ChangeLog.setGuard(guard);
text.modified := ~guard.saved
text.modified := ~guard.saved;
ShowCursor
END undo;
@ -1296,7 +1450,8 @@ BEGIN
redoGuard(text, guard)
END;
ChangeLog.setGuard(guard);
text.modified := ~guard.saved
text.modified := ~guard.saved;
ShowCursor
END redo;
@ -1361,34 +1516,56 @@ END copy;
PROCEDURE paste (text: tText);
VAR
line, newLine, curLine: tLine;
L: INTEGER;
w: INTEGER;
cliptext: RW.tInput;
eol: BOOLEAN;
cursor: pPoint;
PROCEDURE lineWidth (line: tLine; pos: INTEGER): INTEGER;
VAR
i, res: INTEGER;
c: WCHAR;
BEGIN
res := pos;
i := 0;
REPEAT
c := getChar(line, i);
IF c = TAB THEN
INC(res, Lines.tab - res MOD Lines.tab)
ELSIF c # TAB1 THEN
INC(res)
END;
INC(i)
UNTIL c = 0X
RETURN res - pos - 1
END lineWidth;
BEGIN
line := Lines.create(TRUE);
cliptext := RW.clipboard();
delSelect(text);
cursor := text.cursor;
WHILE (cliptext # NIL) & (RW.getString(cliptext, line, eol) >= 0) DO
L := line.length;
IF L > 0 THEN
WHILE (cliptext # NIL) & (RW.getString(cliptext, line, Lines.tabs, eol) >= 0) DO
IF line.length > 0 THEN
w := lineWidth(line, cursor.X);
Lines.insert2(text.curLine, cursor.X, line);
Lines.modify(text.curLine);
modify(text);
SetPos(text, cursor.X + L, cursor.Y);
SetPos(text, cursor.X + w, cursor.Y);
resetSelect(text)
END;
IF eol THEN
newLine := Lines.create(FALSE);
Lines.modify(newLine);
modify(text);
curLine := text.curLine;
IF cursor.X < curLine.length THEN
Lines.modify(curLine);
Lines.wrap(curLine, newLine, cursor.X)
Lines.wrap(curLine, newLine, cursor.X);
Lines.modify(curLine)
END;
List._insert(text, curLine, newLine);
Lines.modify(newLine);
SetPos(text, 0, cursor.Y + 1);
resetSelect(text)
END;
@ -1566,17 +1743,17 @@ BEGIN
END delLine;
PROCEDURE dupLine (text: tText);
PROCEDURE dupLine* (text: tText);
VAR
newLine, curLine: tLine;
BEGIN
curLine := text.curLine;
newLine := Lines.create(FALSE);
Lines.modify(newLine);
modify(text);
Lines.insert3(newLine, 0, curLine.length);
List._insert(text, curLine, newLine);
Lines.move(curLine, newLine)
Lines.move(curLine, newLine);
Lines.modify(newLine)
END dupLine;
@ -1589,8 +1766,9 @@ BEGIN
END exchange;
PROCEDURE upLine (text: tText);
PROCEDURE upLine* (text: tText);
BEGIN
resetSelect(text);
IF text.cursor.Y > 0 THEN
DEC(text.cursor.Y);
exchange(text, text.curLine.prev(tLine), text.curLine)
@ -1598,8 +1776,9 @@ BEGIN
END upLine;
PROCEDURE downLine (text: tText);
PROCEDURE downLine* (text: tText);
BEGIN
resetSelect(text);
IF text.cursor.Y < text.count - 1 THEN
INC(text.cursor.Y);
exchange(text, text.curLine, text.curLine.next(tLine))
@ -1644,6 +1823,8 @@ END wordSel;
PROCEDURE key* (text: tText; code: INTEGER; shift, ctrl: BOOLEAN);
VAR
n: INTEGER;
BEGIN
IF shift THEN
setSelect(text)
@ -1678,13 +1859,18 @@ BEGIN
IF ctrl THEN
SetPos(text, 0, 0)
ELSE
SetPos(text, 0, text.cursor.Y)
n := leadingSpaces(text.curLine);
IF text.cursor.X > n THEN
SetPos(text, n, text.cursor.Y)
ELSE
SetPos(text, 0, text.cursor.Y)
END
END
|37:
IF (text.cursor.X = 0) & (text.curLine.prev # NIL) THEN
SetPos(text, text.curLine.prev(tLine).length, text.cursor.Y - 1)
ELSE
SetPos(text, text.cursor.X - 1, text.cursor.Y)
move(text, -1)
END
|38:
IF ctrl THEN
@ -1696,7 +1882,7 @@ BEGIN
IF (text.cursor.X = text.curLine.length) & (text.curLine.next # NIL) THEN
SetPos(text, 0, text.cursor.Y + 1)
ELSE
SetPos(text, text.cursor.X + 1, text.cursor.Y)
move(text, 1)
END
|40:
IF ctrl THEN
@ -1708,7 +1894,8 @@ BEGIN
IF ctrl THEN
delLine(text)
ELSE
delete(text); ShowCursor; drawCursor := TRUE
delete(text);
ShowCursor
END
|ORD("C"):
IF ctrl THEN
@ -1738,7 +1925,12 @@ BEGIN
END
|ORD("L"), ORD("U"):
IF ctrl THEN
changeCase(text, code = ORD("U"))
IF selected(text) THEN
chCase(text, code = ORD("U"))
ELSE
changeCase(text, code = ORD("U"))
END;
ShowCursor
END
|ORD("D"):
IF ctrl THEN
@ -2124,7 +2316,7 @@ BEGIN
text.enc := enc;
REPEAT
line := Lines.create(FALSE);
n := RW.getString(file, line, eol);
n := RW.getString(file, line, Lines.tabs, eol);
IF n >= 0 THEN
List._append(text, line)
ELSE
@ -2291,16 +2483,9 @@ BEGIN
END New;
PROCEDURE empty;
END empty;
PROCEDURE init* (pShowCursor: tProcedure);
BEGIN
ShowCursor := empty;
IF pShowCursor # NIL THEN
ShowCursor := pShowCursor
END;
ShowCursor := pShowCursor;
pdelete := delete;
drawCursor := TRUE;
padding.left := pad_left;

View File

@ -0,0 +1,85 @@
(*
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 Timer;
IMPORT SYSTEM, K := KolibriOS, KOSAPI, Ini;
VAR
stack: ARRAY 1024*64 OF INTEGER;
ID*, time, cnt: INTEGER;
paused: BOOLEAN;
PROCEDURE reset*;
BEGIN
cnt := time;
paused := FALSE
END reset;
PROCEDURE stop*;
BEGIN
cnt := time;
paused := TRUE
END stop;
PROCEDURE kill*;
BEGIN
ID := 0;
K.ExitID(ID)
END kill;
PROCEDURE [stdcall] main (mainTID: INTEGER);
CONST
step = 5;
BEGIN
WHILE TRUE DO
K.Pause(step);
IF KOSAPI.sysfunc3(18, 21, mainTID) = 0 THEN
ID := 0;
K.Exit
END;
IF ~paused THEN
DEC(cnt, step);
IF cnt <= 0 THEN
cnt := time;
IF time > 0 THEN
K.SendIPC(mainTID, ID)
END
END
END
END
END main;
PROCEDURE create* (mainTID: INTEGER);
BEGIN
time := Ini.blink;
reset;
stack[LEN(stack) - 1] := mainTID;
ID := K.CreateThread(SYSTEM.ADR(main), stack)
END create;
BEGIN
ID := 0
END Timer.

View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2021 Anton Krotov
This file is part of CEdit.

View File

@ -21,123 +21,339 @@ MODULE Scroll;
IMPORT G := Graph, K := KolibriOS;
CONST
ScrollIPC* = 0;
TYPE
tScroll* = POINTER TO RECORD
vertical, mouse: BOOLEAN;
canvas: G.tCanvas;
xSize*, ySize*, pos, mousePos: INTEGER;
value*, maxVal*: INTEGER
END;
tScroll* = RECORD
vertical, Inc*, Dec*, mouse*: BOOLEAN;
top*, left*,
width*, height*: INTEGER; (* read only *)
btnSize, sliderSize: INTEGER;
pos, Slider, pos0, maxVal*, value*: INTEGER;
canvas*: G.tCanvas
END;
PROCEDURE draw* (scroll: tScroll; x, y: INTEGER);
VAR
pos, a, b: INTEGER;
canvas: G.tCanvas;
PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
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, K.scrollBkColor);
G.clear(canvas);
G.SetColor(canvas, K.borderColor);
G.Rect(canvas, 0, 0, scroll.xSize - 1, scroll.ySize - 1);
G.SetColor(canvas, K.scrollColor);
DEC(b, 2);
IF scroll.vertical THEN
G.FillRect(canvas, 1, pos + 1, b, pos + b);
G.SetColor(canvas, K.borderColor);
G.Rect(canvas, 0, pos, b + 2, pos + b + 1);
G.SetColor(canvas, K.btnTextColor);
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, K.borderColor);
G.Rect(canvas, pos, 0, pos + b + 1, b + 2);
G.SetColor(canvas, K.btnTextColor);
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): 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.canvas := G.CreateCanvas(xSize, ySize)
RETURN scroll
scroll.vertical := vertical;
scroll.Inc := FALSE;
scroll.Dec := FALSE;
scroll.Slider := -1;
scroll.mouse := FALSE;
scroll.left := 0;
scroll.top := 0;
scroll.width := width;
scroll.height := height;
scroll.btnSize := btnSize;
scroll.sliderSize := sliderSize;
scroll.pos := 0;
scroll.maxVal := 0;
scroll.canvas := G.CreateCanvas(width, height)
END create;
PROCEDURE resize* (scroll: tScroll; xSize, ySize: INTEGER);
PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);
BEGIN
scroll.xSize := xSize;
scroll.ySize := ySize;
scroll.vertical := xSize < ySize;
G.destroy(scroll.canvas);
scroll.canvas := G.CreateCanvas(xSize, ySize);
G.FillRect(canvas, left, top, right, bottom);
G.SetColor(canvas, K.borderColor);
G.Rect(canvas, left, top, right, bottom);
END Rect;
PROCEDURE _paint (scroll: tScroll);
VAR
canvas: G.tCanvas;
x, y, d, x1, x2, y1, y2,
width, height, btn: INTEGER;
PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);
VAR
color: INTEGER;
BEGIN
IF c THEN
color := K.btnColor
ELSE
color := K.btnTextColor
END;
G.SetColor(canvas, color)
END SetColor;
BEGIN
btn := scroll.btnSize;
width := scroll.width;
height := scroll.height;
canvas := scroll.canvas;
G.SetColor(canvas, K.winColor);
G.FillRect(canvas, 0, 0, width - 1, height - 1);
G.SetColor(canvas, K.borderColor);
G.Rect(canvas, 0, 0, width - 1, height - 1);
IF scroll.vertical THEN
SetColor(canvas, ~scroll.Dec);
Rect(canvas, 0, 0, width - 1, btn - 1);
SetColor(canvas, ~scroll.Inc);
Rect(canvas, 0, height - btn, width - 1, height - 1);
G.SetColor(canvas, K.btnColor);
Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);
G.SetColor(canvas, K.btnTextColor);
y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
G.HLine(canvas, y, width DIV 4, 3*width DIV 4);
G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);
G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);
d := 4*width DIV 10;
x1 := (width - d) DIV 2;
x2 := x1 + d;
SetColor(canvas, scroll.Dec);
y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);
SetColor(canvas, scroll.Inc);
y := y + height - btn - d DIV 2 + 1;
G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);
ELSE
SetColor(canvas, ~scroll.Dec);
Rect(canvas, 0, 0, btn - 1, height - 1);
SetColor(canvas, ~scroll.Inc);
Rect(canvas, width - btn, 0, width - 1, height - 1);
G.SetColor(canvas, K.btnColor);
Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);
G.SetColor(canvas, K.btnTextColor);
x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
G.VLine(canvas, x, height DIV 4, 3*height DIV 4);
G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);
G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);
d := 4*height DIV 10;
y1 := (height - d) DIV 2;
y2 := y1 + d;
SetColor(canvas, scroll.Dec);
x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);
SetColor(canvas, scroll.Inc);
x := x + width - btn - d DIV 2 + 1;
G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);
END;
G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)
END _paint;
PROCEDURE paint* (scroll: tScroll);
BEGIN
IF scroll.canvas # NIL THEN
_paint(scroll)
END
END paint;
PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);
BEGIN
G.destroy(scroll.canvas);
scroll.canvas := G.CreateCanvas(width, height);
scroll.width := width;
scroll.height := height;
paint(scroll)
END resize;
PROCEDURE mouse* (scroll: tScroll; x, y: INTEGER);
PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);
VAR
pos, b: INTEGER;
pos, maxPos, n, m: 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;
IF scroll.vertical THEN
maxPos := scroll.height
ELSE
maxPos := scroll.width
END;
maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
IF (value < 0) OR (scroll.maxVal <= 0) THEN
value := 0;
pos := 0
ELSIF value > scroll.maxVal THEN
value := scroll.maxVal;
pos := maxPos
ELSE
IF (maxPos + 1) >= scroll.maxVal THEN
n := (maxPos + 1) DIV scroll.maxVal;
m := (maxPos + 1) MOD scroll.maxVal;
pos := value*n + MIN(value, m)
ELSE
pos := value*(maxPos + 1) DIV scroll.maxVal
END;
IF pos > maxPos THEN
pos := maxPos;
value := scroll.maxVal
END
END;
scroll.pos := pos;
scroll.value := value
END setValue;
PROCEDURE MouseUp* (scroll: tScroll);
PROCEDURE change* (VAR scroll: tScroll);
BEGIN
IF scroll # NIL THEN
scroll.mouse := FALSE
END
IF scroll.Inc THEN
setValue(scroll, scroll.value + 1)
ELSIF scroll.Dec THEN
setValue(scroll, scroll.value - 1)
END;
paint(scroll)
END change;
PROCEDURE ceil (p, q: INTEGER): INTEGER;
RETURN p DIV q + ORD(p MOD q # 0)
END ceil;
PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);
VAR
maxPos, value, n, m, x, x0, q: INTEGER;
BEGIN
IF scroll.maxVal > 0 THEN
IF scroll.vertical THEN
maxPos := scroll.height
ELSE
maxPos := scroll.width
END;
maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
IF pos <= 0 THEN
pos := 0;
value := 0
ELSIF pos >= maxPos THEN
pos := maxPos;
value := scroll.maxVal
ELSE
IF scroll.maxVal <= maxPos + 1 THEN
n := (maxPos + 1) DIV scroll.maxVal;
m := (maxPos + 1) MOD scroll.maxVal;
q := m*(n + 1);
IF q < pos THEN
value := ceil(pos - m, n)
ELSIF q > pos THEN
value := ceil(pos, n + 1)
ELSE
value := m
END;
x := value*n + MIN(value, m);
x0 := (value - 1)*n + MIN(value - 1, m);
IF x - pos > pos - x0 THEN
pos := x0;
DEC(value)
ELSE
pos := x;
IF pos > maxPos THEN
pos := maxPos;
value := scroll.maxVal
END
END
ELSE
value := scroll.maxVal*pos DIV (maxPos + 1)
END
END
ELSE
pos := 0;
scroll.value := 0
END;
scroll.pos := pos;
scroll.value := value
END setPos;
PROCEDURE isActive* (scroll: tScroll): BOOLEAN;
RETURN scroll.Inc OR scroll.Dec OR (scroll.Slider # -1)
END isActive;
PROCEDURE MouseMove* (VAR scroll: tScroll; x, y: INTEGER);
VAR
c: INTEGER;
BEGIN
IF scroll.Slider # -1 THEN
IF scroll.vertical THEN
c := y - scroll.top
ELSE
c := x - scroll.left
END;
setPos(scroll, scroll.pos0 + c - scroll.Slider);
paint(scroll)
END
END MouseMove;
PROCEDURE between (a, b, c: INTEGER): BOOLEAN;
RETURN (a <= b) & (b <= c)
END between;
PROCEDURE SendIPC*;
BEGIN
K.SendIPC(K.ThreadID(), ScrollIPC)
END SendIPC;
PROCEDURE MouseDown* (VAR scroll: tScroll; x, y: INTEGER);
VAR
c, size: INTEGER;
BEGIN
x := x - scroll.left;
y := y - scroll.top;
scroll.mouse := TRUE;
IF between(0, x, scroll.width - 1) & between(0, y, scroll.height - 1) THEN
IF scroll.vertical THEN
c := y;
size := scroll.height
ELSE
c := x;
size := scroll.width
END;
IF between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
scroll.pos0 := scroll.pos;
scroll.Slider := c
ELSE
IF between(0, c, scroll.btnSize - 1) THEN
scroll.Dec := TRUE;
SendIPC
ELSE
IF between(size - scroll.btnSize, c, size - 1) THEN
scroll.Inc := TRUE;
SendIPC
ELSE
setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);
scroll.pos0 := scroll.pos;
scroll.Slider := c;
paint(scroll)
END
END
END
END
END MouseDown;
PROCEDURE MouseUp* (VAR scroll: tScroll);
BEGIN
IF scroll.mouse THEN
scroll.Slider := -1;
scroll.Inc := FALSE;
scroll.Dec := FALSE;
scroll.mouse := FALSE;
paint(scroll)
END
END MouseUp;