Subversion Repositories Kolibri OS

(*

    Copyright 2021 Anton Krotov

    This file is part of CEdit.

    CEdit is free software: you can redistribute it and/or modify

    it under the terms of the GNU General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    CEdit is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License

    along with CEdit. If not, see .

*)

MODULE Menu;

IMPORT

    SYSTEM, G := Graph, List, K := KolibriOS;

CONST

    fontHeight = 20;

    fontWidth = 8;

    RIGHT = 16;

    LEFT = 16;

    TOP = 1;

    backColor = 0F0F0F0H;

    foreColor = 0;

    selBackColor = 091C9F7H;

    selForeColor = 0;

    disBackColor = backColor;

    disForeColor = 808080H;

    disSelBackColor = 0E4E4E4H;

    disSelForeColor = disForeColor;

TYPE

    tItem* = POINTER TO RECORD (List.tItem)

        id*, check: INTEGER;

        text: ARRAY 32 OF WCHAR;

        enabled, delim: BOOLEAN

    END;

    tMenu* = POINTER TO RECORD

        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 # NIL) & 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;

        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;

    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);

    G.SetFont(m.canvas, m.font);

    RETURN m

END create;

BEGIN

    lastTID := 0

END Menu.