forked from KolibriOS/kolibrios
640 lines
15 KiB
Plaintext
640 lines
15 KiB
Plaintext
(*
|
|
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, KOSAPI;
|
|
|
|
CONST
|
|
fontHeight = 22;
|
|
fontWidth = 8;
|
|
|
|
MainMenuHeight* = K.fontHeight + 7;
|
|
|
|
RIGHT = 16;
|
|
LEFT = 16;
|
|
TOP = 1;
|
|
|
|
maxLEVEL = 1;
|
|
|
|
backColor = 0F0F0F0H;
|
|
foreColor = 0;
|
|
selBackColor = 091C9F7H;
|
|
selForeColor = 0;
|
|
disBackColor = backColor;
|
|
disForeColor = 808080H;
|
|
disSelBackColor = 0E4E4E4H;
|
|
disSelForeColor = disForeColor;
|
|
|
|
|
|
TYPE
|
|
|
|
tMainItem* = POINTER TO descMainItem;
|
|
|
|
tMain* = POINTER TO RECORD (List.tList)
|
|
id: INTEGER
|
|
END;
|
|
|
|
tMenu* = POINTER TO RECORD
|
|
tid*: INTEGER;
|
|
active*, keyboard: BOOLEAN;
|
|
parent*, child: tMenu;
|
|
mainID: 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;
|
|
|
|
tItem* = POINTER TO RECORD (List.tItem)
|
|
id*, check: INTEGER;
|
|
text: ARRAY 32 OF WCHAR;
|
|
enabled, delim: BOOLEAN;
|
|
child: tMenu
|
|
END;
|
|
|
|
descMainItem = RECORD (List.tItem)
|
|
id*, x: INTEGER;
|
|
text: ARRAY 32 OF WCHAR;
|
|
menu*: tMenu;
|
|
main: tMain
|
|
END;
|
|
|
|
tClick = PROCEDURE (menu: tMenu; id: INTEGER);
|
|
tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
|
|
tProc = PROCEDURE;
|
|
|
|
VAR
|
|
stack: ARRAY maxLEVEL + 1, 250000 OF INTEGER;
|
|
TIDs: ARRAY maxLEVEL + 1 OF INTEGER;
|
|
resetTimer: tProc;
|
|
_open: PROCEDURE (m: tMenu; x, y: INTEGER);
|
|
(*
|
|
backColor, foreColor, selBackColor, selForeColor,
|
|
disBackColor, disForeColor, disSelBackColor, disSelForeColor: INTEGER;
|
|
*)
|
|
|
|
PROCEDURE AddMainItem* (main: tMain; text: ARRAY OF WCHAR; menu: tMenu);
|
|
VAR
|
|
item, prev: tMainItem;
|
|
BEGIN
|
|
NEW(item);
|
|
item.id := main.id + main.count;
|
|
COPY(text, item.text);
|
|
item.menu := menu;
|
|
item.main := main;
|
|
menu.mainID := item.id;
|
|
List.append(main, item);
|
|
prev := item.prev(tMainItem);
|
|
IF prev # NIL THEN
|
|
item.x := prev.x + LENGTH(prev.text)*fontWidth + 9
|
|
ELSE
|
|
item.x := 0
|
|
END
|
|
END AddMainItem;
|
|
|
|
|
|
PROCEDURE CreateMain* (id: INTEGER): tMain;
|
|
VAR
|
|
res: tMain;
|
|
list: List.tList;
|
|
BEGIN
|
|
NEW(res);
|
|
res.id := id;
|
|
list := List.create(res)
|
|
RETURN res
|
|
END CreateMain;
|
|
|
|
|
|
PROCEDURE drawMainItem (item: tMainItem);
|
|
VAR
|
|
menuColor, textColor, n: INTEGER;
|
|
BEGIN
|
|
IF item.menu.tid # 0 THEN
|
|
menuColor := K.textColor;
|
|
textColor := K.winColor
|
|
ELSE
|
|
menuColor := K.winColor;
|
|
textColor := K.textColor
|
|
END;
|
|
n := LENGTH(item.text);
|
|
K.DrawRect(item.x, 0, n*fontWidth + 2, MainMenuHeight, menuColor);
|
|
K.CreateButton(item.id + ORD({30}), item.x, 0, n*fontWidth + 2, MainMenuHeight, K.btnColor, "");
|
|
K.DrawText(item.x + 1, (MainMenuHeight - K.fontHeight) DIV 2 + 1, textColor, item.text)
|
|
END drawMainItem;
|
|
|
|
|
|
PROCEDURE DrawMain* (main: tMain);
|
|
VAR
|
|
item: List.tItem;
|
|
BEGIN
|
|
item := main.first;
|
|
WHILE item # NIL DO
|
|
drawMainItem(item(tMainItem));
|
|
item := item.next
|
|
END
|
|
END DrawMain;
|
|
|
|
|
|
PROCEDURE getMainID (m: tMenu): INTEGER;
|
|
BEGIN
|
|
WHILE m.parent # NIL DO
|
|
m := m.parent
|
|
END
|
|
RETURN m.mainID
|
|
END getMainID;
|
|
|
|
|
|
PROCEDURE ClickMain* (main: tMain; btn: INTEGER): tMenu;
|
|
VAR
|
|
item: List.tItem;
|
|
res: tMenu;
|
|
BEGIN
|
|
item := List.getItem(main, btn - main.id);
|
|
IF item # NIL THEN
|
|
res := item(tMainItem).menu
|
|
ELSE
|
|
res := NIL
|
|
END
|
|
RETURN res
|
|
END ClickMain;
|
|
|
|
|
|
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.active := FALSE;
|
|
resetTimer;
|
|
m.tid := 0;
|
|
K.Exit
|
|
END exit;
|
|
|
|
|
|
PROCEDURE escape (m: tMenu);
|
|
BEGIN
|
|
m.active := FALSE;
|
|
IF m.parent = NIL THEN
|
|
resetTimer
|
|
END;
|
|
m.tid := 0;
|
|
K.Exit
|
|
END escape;
|
|
|
|
|
|
PROCEDURE repaint (m: tMenu);
|
|
VAR
|
|
y, i, X, Y: INTEGER;
|
|
item: tItem;
|
|
BkColor, TextColor: INTEGER;
|
|
canvas: G.tCanvas;
|
|
|
|
BEGIN
|
|
(*
|
|
backColor := K.winColor;
|
|
foreColor := K.textColor;
|
|
selBackColor := K.btnColor;
|
|
selForeColor := K.btnTextColor;
|
|
|
|
disBackColor := backColor;
|
|
disForeColor := K.darkColor;
|
|
disSelBackColor := K.lightColor;
|
|
disSelForeColor := disForeColor;
|
|
*)
|
|
canvas := m.canvas;
|
|
G.SetColor(canvas, backColor);
|
|
G.clear(canvas);
|
|
G.SetColor(canvas, foreColor);
|
|
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));
|
|
|
|
G.SetColor(canvas, TextColor);
|
|
IF item.check = 1 THEN
|
|
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.FillRect(canvas, 6, y + fontHeight DIV 2 - 4, 10, y + fontHeight DIV 2)
|
|
END;
|
|
|
|
IF item.child # NIL THEN
|
|
X := m.width - 9;
|
|
Y := y + (fontHeight - 16) DIV 2 + 2;
|
|
G.Triangle(canvas, X, Y, X, Y + 8, G.triRight)
|
|
END;
|
|
|
|
INC(y, fontHeight);
|
|
IF item.delim THEN
|
|
G.SetColor(canvas, foreColor);
|
|
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 close* (m: tMenu);
|
|
VAR
|
|
temp: INTEGER;
|
|
BEGIN
|
|
IF (m # NIL) & (m.tid # 0) THEN
|
|
IF m.child # NIL THEN
|
|
close(m.child);
|
|
m.child := NIL
|
|
END;
|
|
temp := m.tid;
|
|
m.tid := 0;
|
|
K.ExitID(temp);
|
|
m.active := FALSE
|
|
END
|
|
END close;
|
|
|
|
|
|
PROCEDURE click (m: tMenu; i: INTEGER);
|
|
VAR
|
|
item: List.tItem;
|
|
p: tMenu;
|
|
id: INTEGER;
|
|
BEGIN
|
|
id := -1;
|
|
IF i < 0 THEN
|
|
id := i
|
|
ELSE
|
|
item := List.getItem(m.items, i);
|
|
IF (item # NIL) & item(tItem).enabled & (item(tItem).child = NIL) THEN
|
|
id := item(tItem).id
|
|
END
|
|
END;
|
|
IF id # -1 THEN
|
|
m.click(m, id);
|
|
p := m.parent;
|
|
WHILE p # NIL DO
|
|
p.child := NIL;
|
|
close(p);
|
|
p := p.parent
|
|
END;
|
|
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
|
|
close(m.child);
|
|
m.child := NIL
|
|
END
|
|
END closeChild;
|
|
|
|
|
|
PROCEDURE submenu (m: tMenu; keyboard: BOOLEAN): BOOLEAN;
|
|
VAR
|
|
item: List.tItem;
|
|
res: BOOLEAN;
|
|
BEGIN
|
|
res := FALSE;
|
|
item := List.getItem(m.items, m.selItem);
|
|
IF (item # NIL) & item(tItem).enabled & (item(tItem).child # NIL) THEN
|
|
res := TRUE;
|
|
IF ~opened(item(tItem).child) THEN
|
|
closeChild(m);
|
|
item(tItem).child.keyboard := keyboard;
|
|
_open(item(tItem).child, m.winX + m.width - 2, m.winY + m.selItem*fontHeight);
|
|
m.child := item(tItem).child;
|
|
END
|
|
ELSE
|
|
closeChild(m)
|
|
END
|
|
RETURN res
|
|
END submenu;
|
|
|
|
|
|
PROCEDURE [stdcall] window (m: tMenu);
|
|
VAR
|
|
x, y: INTEGER;
|
|
key, temp: INTEGER;
|
|
msState: SET;
|
|
shift, ctrl: BOOLEAN;
|
|
BEGIN
|
|
m.selItem := ORD(m.keyboard) - 1;
|
|
m.cliItem := -1;
|
|
m.keyboard := FALSE;
|
|
K.SetEventsMask({0, 1, 5});
|
|
WHILE TRUE DO
|
|
CASE K.WaitForEvent() OF
|
|
|1:
|
|
draw_window(m)
|
|
|2:
|
|
K.getKBState(shift, ctrl);
|
|
key := K.GetKey();
|
|
IF ~shift & ~ ctrl THEN
|
|
IF key DIV 65536 = 72 THEN
|
|
DEC(m.selItem);
|
|
IF m.selItem < 0 THEN
|
|
m.selItem := m.items.count - 1
|
|
END
|
|
ELSIF key DIV 65536 = 80 THEN
|
|
INC(m.selItem);
|
|
IF m.selItem >= m.items.count THEN
|
|
m.selItem := 0
|
|
END
|
|
ELSIF key DIV 65536 = 28 THEN
|
|
IF m.selItem >= 0 THEN
|
|
click(m, m.selItem)
|
|
END;
|
|
m.cliItem := -1
|
|
ELSIF key DIV 65536 = 77 THEN
|
|
IF ~submenu(m, TRUE) THEN
|
|
click(m, -(getMainID(m) + 1))
|
|
END;
|
|
m.cliItem := -1
|
|
ELSIF key DIV 65536 = 75 THEN
|
|
IF m.parent # NIL THEN
|
|
escape(m)
|
|
ELSE
|
|
click(m, -(getMainID(m) - 1))
|
|
END;
|
|
m.cliItem := -1
|
|
ELSIF key DIV 65536 = 1 THEN
|
|
escape(m)
|
|
ELSE
|
|
IF m.key(m, key) THEN
|
|
IF m.parent # NIL THEN
|
|
temp := m.parent.tid;
|
|
m.parent.tid := 0;
|
|
K.ExitID(temp)
|
|
END;
|
|
exit(m)
|
|
END
|
|
END
|
|
ELSE
|
|
IF m.key(m, key) THEN
|
|
IF m.parent # NIL THEN
|
|
temp := m.parent.tid;
|
|
m.parent.tid := 0;
|
|
K.ExitID(temp)
|
|
END;
|
|
exit(m)
|
|
END
|
|
END;
|
|
repaint(m)
|
|
|6:
|
|
K.mouse(msState, 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
|
|
END;
|
|
IF 16 IN msState THEN
|
|
IF m.cliItem = m.selItem THEN
|
|
click(m, m.cliItem)
|
|
END;
|
|
m.cliItem := -1
|
|
END
|
|
ELSE
|
|
m.active := FALSE;
|
|
m.cliItem := -1;
|
|
IF ({8, 9, 10, 16} * msState # {}) & ~isActive(m.child) THEN
|
|
exit(m)
|
|
END
|
|
END;
|
|
repaint(m);
|
|
IF submenu(m, FALSE) THEN END
|
|
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
|
|
L := level(m);
|
|
IF KOSAPI.sysfunc3(18, 21, TIDs[L]) = 0 THEN
|
|
m.winX := x;
|
|
m.winY := y;
|
|
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
|
|
END open;
|
|
|
|
|
|
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;
|
|
item.child := NIL;
|
|
List.append(items, item);
|
|
END AddMenuItem;
|
|
|
|
|
|
PROCEDURE delimiter* (items: List.tList);
|
|
BEGIN
|
|
items.last(tItem).delim := TRUE
|
|
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;
|
|
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 check* (m: tMenu; id: INTEGER; value: BOOLEAN);
|
|
VAR
|
|
item: tItem;
|
|
BEGIN
|
|
item := getItem(m, id);
|
|
IF item # NIL THEN
|
|
item.check := ORD(value)
|
|
END
|
|
END check;
|
|
|
|
|
|
PROCEDURE option* (m: tMenu; id: INTEGER; value: BOOLEAN);
|
|
VAR
|
|
item: tItem;
|
|
BEGIN
|
|
item := getItem(m, id);
|
|
IF item # NIL THEN
|
|
item.check := ORD(value)*2
|
|
END
|
|
END option;
|
|
|
|
|
|
PROCEDURE isEnabled* (m: tMenu; id: INTEGER): BOOLEAN;
|
|
VAR
|
|
item: tItem;
|
|
BEGIN
|
|
item := getItem(m, id)
|
|
RETURN (item # NIL) & item.enabled
|
|
END isEnabled;
|
|
|
|
|
|
PROCEDURE create* (items: List.tList; click: tClick; key: tKey): tMenu;
|
|
VAR
|
|
m: tMenu;
|
|
maxLength: INTEGER;
|
|
item: tItem;
|
|
BEGIN
|
|
NEW(m);
|
|
m.tid := 0;
|
|
m.active := FALSE;
|
|
m.parent := NIL;
|
|
m.child := NIL;
|
|
m.mainID := 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);
|
|
G.SetFont(m.canvas, m.font);
|
|
RETURN m
|
|
END create;
|
|
|
|
|
|
PROCEDURE init* (_resetTimer: tProc);
|
|
VAR
|
|
i: INTEGER;
|
|
BEGIN
|
|
resetTimer := _resetTimer;
|
|
_open := open;
|
|
FOR i := 0 TO maxLEVEL DO
|
|
TIDs[i] := 0
|
|
END
|
|
END init;
|
|
|
|
|
|
END Menu. |