WebSVN – Kolibri OS – Diff – /programs/develop/cedit/SRC/Menu.ob07

 IMPORT
     SYSTEM, G := Graph, List, K := KolibriOS;
 CONST
-    fontHeight = 20;
+    fontHeight = 22;
     fontWidth = 8;
+    RIGHT = 16;
+    LEFT = 16;
-    RIGHT = 16;
+    TOP = 1;
     LEFT = 16;
-    TOP = 1;
+    maxLEVEL = 1;
     backColor = 0F0F0F0H;
     disSelBackColor = 0E4E4E4H;
     disSelForeColor = disForeColor;
-TYPE
-    tItem* = POINTER TO RECORD (List.tItem)
-        id*, check: INTEGER;
-        text: ARRAY 32 OF WCHAR;
         enabled, delim: BOOLEAN
-    END;
+TYPE
+    tMenu* = POINTER TO RECORD
         tid*: INTEGER;
-    tMenu* = POINTER TO RECORD
+        active*: BOOLEAN;
-        tid*: INTEGER;
+        parent*, child: tMenu;
         winX, winY, width*, height*: INTEGER;
         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;
     tClick = PROCEDURE (menu: tMenu; id: INTEGER);
+    tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
-    tKey = PROCEDURE (menu: tMenu; key: INTEGER): BOOLEAN;
+    tProc = PROCEDURE;
+VAR
+    stack: ARRAY maxLEVEL + 1, 250000 OF INTEGER;
-VAR
+    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
-    lastTID*: INTEGER;
+	RETURN i <= maxLEVEL
-    stack: ARRAY 250000 OF INTEGER;
+END isSender;
+PROCEDURE exit (m: tMenu);
 BEGIN
-PROCEDURE exit (m: tMenu);
+    m.tid := 0;
-BEGIN
+    m.active := FALSE;
-    m.tid := 0;
+    resetTimer;
     K.Exit
 END exit;
 PROCEDURE repaint (m: tMenu);
         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.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.SetColor(canvas, TextColor);
+        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;
+            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}));
     x := mouseX - m.winX;
     y := mouseY - m.winY;
 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
-VAR
+    item: List.tItem;
-    item: List.tItem;
+    p: tMenu;
 BEGIN
     item := List.getItem(m.items, i);
+    IF (item # NIL) & item(tItem).enabled & (item(tItem).child = NIL) THEN
+        m.click(m, item(tItem).id);
+        p := m.parent;
+       	WHILE p # NIL DO
+       		p.child := NIL;
+       		close(p);
+       		p := p.parent
-    IF (item # NIL) & item(tItem).enabled THEN
+       	END;
-        m.click(m, item(tItem).id);
+       	redraw := TRUE;
-        exit(m)
+       	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 click;
+END submenu;
 PROCEDURE [stdcall] window (m: tMenu);
             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
+                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)
                 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.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
                         click(m, m.cliItem)
                     END;
                     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;
 BEGIN
     NEW(item);
     item.id := id;
     item.text := s;
+    item.enabled := TRUE;
-    item.enabled := TRUE;
+    item.delim := FALSE;
-    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 delimiter* (items: List.tList);
+PROCEDURE child* (items: List.tList; menu: tMenu);
 BEGIN
-    items.last(tItem).delim := TRUE
+    items.last(tItem).child := menu
-END delimiter;
+END child;
     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.active := FALSE;
-    NEW(m);
+    m.parent := NIL;
-    m.tid := 0;
+    m.child := NIL;
     m.items  := items;
     m.click := click;
     m.key := key;
     G.SetFont(m.canvas, m.font);
     RETURN m
 END create;
+PROCEDURE Redraw*;
+BEGIN
+	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;
 BEGIN
     lastTID := 0

Subversion Repositories Kolibri OS

(root)/programs/develop/cedit/SRC/Menu.ob07 – Rev 8762 → 9174