kolibrios/programs/develop/cedit/SRC/Menu.ob07

(*
    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 = 22;
    fontWidth = 8;

    MainMenuHeight* = K.fontHeight + 7;
	MainMenuX* = 3;

    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, 2500 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 := MainMenuX
	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;
        Y := y + (fontHeight - 16) DIV 2;
        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 - 2, item.text, LENGTH(item.text));

        G.SetColor(canvas, TextColor);
        IF item.check = 1 THEN
            G.DLine(canvas, 4, 7, Y + 5, -1);
            G.DLine(canvas, 4, 7, Y + 6, -1);
            G.DLine(canvas, 7, 12, Y + 8, 1);
            G.DLine(canvas, 7, 12, Y + 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;
        	G.Triangle(canvas, X, Y + 2, X, Y + 10, 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;
    msState: SET;
    key, temp: INTEGER;
    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.EventTimeout(100) OF
        |0:
        |1:
            draw_window(m)
        |2:
        	K.getKBState(shift, ctrl);
            key := K.GetKey();
            IF ~shift & ~ ctrl THEN
	            IF key DIV 65536 = 72 THEN
	                m.selItem := (m.selItem - 1) MOD m.items.count
	            ELSIF key DIV 65536 = 80 THEN
	                m.selItem := (m.selItem + 1) MOD m.items.count
	            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 K.GetThreadSlot(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.