MODULE WMMenus; (** AUTHOR "TF/staubesv"; PURPOSE "Menu support"; *) (* Vertical menu entry layout: | HMenuDistance | image.width OR MinImageWidth | HMenuDistance | TextImageDistance | TextWidth | HMenuDistance | *) IMPORT Inputs, Strings, Raster, WMRectangles, WMGraphics, WMGraphicUtilities, WMComponents, WMWindowManager, WMProperties, WMEvents, WMDropTarget, WMTrees; CONST OpenDefault* = OpenDownRight; OpenUpLeft* = 1; OpenUpRight* = 2; OpenDownLeft* = 3; OpenDownRight* = 4; (* ShadowWindow.type *) Right = 0; Bottom = 1; ShadowWidth = 5; ShadowHeight = 5; ShadowOffsetVertical = 5; ShadowOffsetHorizontal = 5; LightGrey = LONGINT(0C0C0C0FFH); LightGreyDrag = LONGINT(0C0C0C0C0H); WhiteDrag = LONGINT(0FFFFFFC0H); TextImageDistance = 4; MinImageWidth = 4; HMenuDistance = 8; VMenuDistance = 4; SeparatorCaption = "---"; SeparatorWidth = 9; SeparatorHeight = 5; DragDist = 10; TYPE Separator* = OBJECT(WMTrees.TreeNode) END Separator; TYPE DragWrapper* = OBJECT END DragWrapper; TYPE MenuPanel*= OBJECT(WMComponents.VisualComponent) VAR horizontal- : WMProperties.BooleanProperty; horizontalI : BOOLEAN; openDirection- : WMProperties.Int32Property; openDirectionI : LONGINT; clSelected : WMProperties.ColorProperty; onSelect- : WMEvents.EventSource; menu : WMTrees.Tree; root, selection, hover : WMTrees.TreeNode; subMenuIndicatorImg : WMGraphics.Image; subMenu, parentWindow : MenuWindow; parentMenuPanel, focusPanel, rootMenuPanel : MenuPanel; greyBoxWidth : LONGINT; dragNode : WMTrees.TreeNode; dragObject : ANY; (* pointer handling *) leftClick, dragPossible : BOOLEAN; downX, downY : LONGINT; PROCEDURE &Init*; BEGIN Init^; SetNameAsString(StrMenuPanel); NEW(horizontal, NIL, NIL, NIL); properties.Add(horizontal); horizontalI := horizontal.Get(); NEW(openDirection, NIL, NIL, NIL); properties.Add(openDirection); NEW(clSelected, NIL, NIL, NIL); properties.Add(clSelected); clSelected.Set(WMGraphics.Blue); NEW(onSelect, SELF, NIL, NIL, NIL); openDirectionI := OpenDefault; openDirection.Set(openDirectionI); menu := NIL; root := NIL; selection := NIL; hover := NIL; subMenuIndicatorImg := NIL; subMenu := NIL; parentWindow := NIL; greyBoxWidth := 2 * HMenuDistance + MinImageWidth; dragObject := NIL; parentMenuPanel := NIL; focusPanel := SELF; rootMenuPanel := SELF; takesFocus.Set(TRUE); END Init; PROCEDURE PropertyChanged*(sender, property : ANY); BEGIN IF (property = clSelected) THEN Invalidate; ELSIF (property = horizontal) THEN horizontalI := horizontal.Get(); Invalidate; ELSIF (property = openDirection) THEN openDirectionI := openDirection.Get(); Invalidate; ELSIF property=properties THEN RecacheProperties; Invalidate ELSE PropertyChanged^(sender, property); END; END PropertyChanged; PROCEDURE RecacheProperties*; BEGIN RecacheProperties^; horizontalI := horizontal.Get(); openDirectionI := openDirection.Get(); (*Invalidate;*) END RecacheProperties; PROCEDURE SetParent(parentMenuPanel : MenuPanel); BEGIN SELF.parentMenuPanel := parentMenuPanel; IF (parentMenuPanel # NIL) THEN rootMenuPanel := parentMenuPanel.rootMenuPanel; END; END SetParent; (* If menus are used as popup menus, the initial window most be registered here so it can be closed when an item has been selected *) PROCEDURE SetParentWindow(parentWindow : MenuWindow); BEGIN ASSERT(parentWindow # NIL); SELF.parentWindow := parentWindow; END SetParentWindow; PROCEDURE SetMenu*(menu : WMTrees.Tree; root : WMTrees.TreeNode); BEGIN ASSERT((menu # NIL) & (root # NIL)); Acquire; SELF.menu := menu; SELF.root := root; hover := NIL; greyBoxWidth := MAX(MinImageWidth + 2 * HMenuDistance , MaxImageWidth() + 2 * HMenuDistance); Invalidate; Release END SetMenu; PROCEDURE Measure(VAR width, height : LONGINT); VAR child : WMTrees.TreeNode; BEGIN ASSERT((menu # NIL) & (root # NIL)); width := 0; height := 0; IF horizontal.Get() THEN menu.Acquire; child := menu.GetChildren(root); WHILE (child # NIL) DO width := width + ItemWidth(child, TRUE); child := menu.GetNextSibling(child); END; menu.Release; ELSE menu.Acquire; child := menu.GetChildren(root); WHILE (child # NIL) DO height := height + ItemHeight(child); width := MAX(width, ItemWidth(child, FALSE)); child := menu.GetNextSibling(child); END; menu.Release; END; END Measure; PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas); VAR child : WMTrees.TreeNode; x, y, dx, dy, t, textY : LONGINT; font : WMGraphics.Font; caption : Strings.String; image : Raster.Image; BEGIN DrawBackground^(canvas); IF (menu = NIL) OR (root = NIL) THEN RETURN; END; font := GetFont(); canvas.SetFont(font); canvas.SetColor(WMGraphics.Black); IF horizontalI THEN x := 0; menu.Acquire; child := menu.GetChildren(root); WHILE (child # NIL) DO IF ~(child IS Separator) THEN IF (child = hover) THEN canvas.Fill(WMRectangles.MakeRect(x, 0, x + ItemWidth(child, horizontalI), bounds.GetHeight()), LONGINT(0FFFF00FFH), WMGraphics.ModeCopy); ELSIF (child = selection) THEN canvas.Fill(WMRectangles.MakeRect(x, 0, x + ItemWidth(child, horizontalI), bounds.GetHeight()), clSelected.Get(), WMGraphics.ModeCopy); END; x := x + HMenuDistance; image := menu.GetNodeImage(child); IF (image # NIL) THEN canvas.DrawImage(x, 0, image, WMGraphics.ModeSrcOverDst); x := x + image.width + HMenuDistance + TextImageDistance; END; caption := menu.GetNodeCaption(child); IF (caption # NIL) THEN font.GetStringSize(caption^, dx, dy); canvas.DrawString(x, dy, caption^); x := x + dx; END; INC(x, HMenuDistance); ELSE INC(x, HMenuDistance); canvas.Line(x + (SeparatorWidth DIV 2) + 1, 2, x + (SeparatorWidth DIV 2) + 1, bounds.GetHeight() - 2, WMGraphics.Black, WMGraphics.ModeCopy); x := x + SeparatorWidth + HMenuDistance; END; child := menu.GetNextSibling(child) END; menu.Release; ELSE y := 0; menu.Acquire; IF (openDirectionI = OpenDownLeft) OR (openDirectionI = OpenUpLeft) THEN canvas.Fill(WMRectangles.MakeRect(bounds.GetWidth() - greyBoxWidth, 0, bounds.GetWidth() - greyBoxWidth, bounds.GetHeight()), LightGrey, WMGraphics.ModeCopy); ELSE canvas.Fill(WMRectangles.MakeRect(0, 0, greyBoxWidth, bounds.GetHeight()), LightGrey, WMGraphics.ModeCopy); END; child := menu.GetChildren(root); WHILE (child # NIL) DO x := HMenuDistance; IF ~(child IS Separator) THEN IF (child = hover) THEN canvas.Fill(WMRectangles.MakeRect(0, y, bounds.GetWidth(), y + ItemHeight(child)), LONGINT(0FFFF00FFH), WMGraphics.ModeCopy); ELSIF (child = selection) THEN canvas.Fill(WMRectangles.MakeRect(0, y, bounds.GetWidth(), y + ItemHeight(child)), clSelected.Get(), WMGraphics.ModeCopy); END; INC(y, VMenuDistance); dy := 0; image := menu.GetNodeImage(child); IF (image # NIL) THEN canvas.DrawImage(x, y, image, WMGraphics.ModeSrcOverDst); x := x + image.width + HMenuDistance + TextImageDistance; dy := image.height; ELSE x := x + MinImageWidth + HMenuDistance + TextImageDistance; END; caption := menu.GetNodeCaption(child); IF (caption # NIL) THEN font.GetStringSize(caption^, dx, t); IF (image # NIL) & (image.height > t) THEN textY := y + ((image.height + t - font.GetDescent()) DIV 2); ELSE textY := y + font.ascent; dy := t; END; canvas.DrawString(x, textY, caption^); END; IF menu.GetChildren(child) # NIL THEN IF subMenuIndicatorImg # NIL THEN canvas.DrawImage(bounds.GetWidth() - subMenuIndicatorImg.width, 0, subMenuIndicatorImg, WMGraphics.ModeSrcOverDst) ELSE canvas.DrawString(bounds.GetWidth() - 10, textY, "...") END END; y := y + dy + VMenuDistance; ELSE y := y + VMenuDistance; canvas.Line(greyBoxWidth + 4, y + (SeparatorHeight DIV 2) + 1, bounds.GetWidth(), y + (SeparatorHeight DIV 2) + 1, LightGrey, WMGraphics.ModeCopy); y := y + SeparatorHeight + VMenuDistance; END; child := menu.GetNextSibling(child) END; menu.Release; END; END DrawBackground; (* caller must hold tree lock *) PROCEDURE ItemWidth(item : WMTrees.TreeNode; isHorizontal : BOOLEAN) : LONGINT; VAR width, dx, dy : LONGINT; font : WMGraphics.Font; caption : Strings.String; image : Raster.Image; BEGIN ASSERT(menu.HasLock()); width := 0; IF ~(item IS Separator) THEN image := menu.GetNodeImage(item); IF (image # NIL) THEN width := image.width + HMenuDistance + TextImageDistance; ELSIF ~(isHorizontal) THEN width := width + MinImageWidth + HMenuDistance + TextImageDistance; END; caption := menu.GetNodeCaption(item); IF (caption # NIL) THEN font := GetFont(); font.GetStringSize(caption^, dx, dy); width := width + dx; END; ELSE width := SeparatorWidth; END; width := width + 2*HMenuDistance; RETURN width; END ItemWidth; (* caller must hold tree lock *) PROCEDURE ItemHeight(item : WMTrees.TreeNode) : LONGINT; VAR height, dx, dy : LONGINT; font : WMGraphics.Font; caption : Strings.String; image : Raster.Image; BEGIN height := 0; IF ~(item IS Separator) THEN caption := menu.GetNodeCaption(item); IF (caption # NIL) THEN font := GetFont(); font.GetStringSize(caption^, dx, dy); height := dy; END; image := menu.GetNodeImage(item); IF (image # NIL) THEN IF (image.height > height) THEN height := image.height; END; END; ELSE height := SeparatorHeight; END; height := height + 2 * VMenuDistance; RETURN height END ItemHeight; PROCEDURE MaxImageWidth() : LONGINT; VAR child : WMTrees.TreeNode; image : WMGraphics.Image; maxWidth : LONGINT; BEGIN maxWidth := 0; menu.Acquire; child := menu.GetChildren(root); WHILE (child # NIL) DO image := menu.GetNodeImage(child); IF (image # NIL) & (image.width > maxWidth) THEN maxWidth := image.width; END; child := menu.GetNextSibling(child); END; menu.Release; RETURN maxWidth; END MaxImageWidth; PROCEDURE IsSelectable(node : WMTrees.TreeNode) : BOOLEAN; BEGIN ASSERT(node # NIL); RETURN ~(node IS Separator); END IsSelectable; PROCEDURE FindHorizontal(x : LONGINT) : WMTrees.TreeNode; VAR p : LONGINT; child : WMTrees.TreeNode; BEGIN p := 0; menu.Acquire; child := menu.GetChildren(root); IF (child # NIL) THEN REPEAT p := p + ItemWidth(child, horizontalI); IF p < x THEN child := menu.GetNextSibling(child); END; UNTIL (child = NIL) OR (p >= x); END; menu.Release; RETURN child; END FindHorizontal; PROCEDURE FindVertical(y : LONGINT) : WMTrees.TreeNode; VAR p : LONGINT; child : WMTrees.TreeNode; BEGIN p := 0; menu.Acquire; child := menu.GetChildren(root); IF (child # NIL) THEN REPEAT p := p + ItemHeight(child); IF p < y THEN child := menu.GetNextSibling(child); END; UNTIL (child = NIL) OR (p >= y); END; menu.Release; RETURN child; END FindVertical; PROCEDURE GetItemRect(i : WMTrees.TreeNode; VAR r : WMRectangles.Rectangle); VAR child : WMTrees.TreeNode; BEGIN r.l := 0; r.t := 0; menu.Acquire; child := menu.GetChildren(root); WHILE (child # NIL) & (child # i) DO IF horizontal.Get() THEN INC(r.l, ItemWidth(child, horizontalI)); ELSE INC(r.t, ItemHeight(child)); END; child := menu.GetNextSibling(child); END; IF (child # NIL) THEN r.r := r.l + ItemWidth(child, horizontalI); r.b := r.t + ItemHeight(child) END; menu.Release END GetItemRect; PROCEDURE LeafSelect(item : WMTrees.TreeNode); VAR data : ANY; BEGIN IF parentMenuPanel = NIL THEN CloseSubMenu(FALSE); menu.Acquire; data := menu.GetNodeData(item); menu.Release; IF (data # NIL) THEN onSelect.Call(data); ELSE onSelect.Call(item); END; IF (parentWindow # NIL) THEN parentWindow.CloseMenu(SELF, NIL); parentWindow := NIL; END; ELSE parentMenuPanel.LeafSelect(item); END END LeafSelect; PROCEDURE SetSelection(node : WMTrees.TreeNode); BEGIN IF (selection # node) THEN selection := node; Invalidate; END; END SetSelection; PROCEDURE SelectNode(node : WMTrees.TreeNode; indicateLast : BOOLEAN); VAR child : WMTrees.TreeNode; r : WMRectangles.Rectangle; x, y : LONGINT; BEGIN ASSERT(node # NIL); menu.Acquire; child := menu.GetChildren(node); IF (child # NIL) THEN GetItemRect(node, r); IF horizontal.Get() THEN IF openDirection.Get() IN {OpenUpLeft, OpenUpRight} THEN ToWMCoordinates(r.l, r.t, x, y); ELSE ToWMCoordinates(r.l, r.b, x, y); END ELSE CASE openDirection.Get() OF |OpenUpLeft : ToWMCoordinates(r.l, r.b, x, y); |OpenUpRight : ToWMCoordinates(r.r, r.b, x, y); |OpenDownLeft : ToWMCoordinates(r.l, r.t, x, y); |OpenDownRight : ToWMCoordinates(r.r, r.t, x, y); ELSE ToWMCoordinates(r.r, r.t, x, y); END; END; CloseSubMenu(indicateLast); SetSelection(node); NEW(subMenu, x, y, openDirection.Get(), menu, node, SELF, FALSE, TRUE); rootMenuPanel.focusPanel := subMenu.menuPanel; PointerLeave; ELSE LeafSelect(node) END; menu.Release; END SelectNode; PROCEDURE CloseSubMenu(indicateLast : BOOLEAN); BEGIN IF (subMenu # NIL) THEN subMenu.CloseMenu(NIL, NIL); subMenu := NIL; IF (selection # NIL) THEN IF indicateLast THEN hover := selection; END; selection := NIL; Invalidate; END; rootMenuPanel.focusPanel := SELF; END; END CloseSubMenu; PROCEDURE PointerDown*(x, y : LONGINT; keys : SET); VAR node : WMTrees.TreeNode; BEGIN IF horizontal.Get() THEN node := FindHorizontal(x); ELSE node := FindVertical(y); END; leftClick := (0 IN keys); IF leftClick & (node # NIL) & IsSelectable(node) THEN dragObject := GetDragWrapper(node, menu); IF (dragObject # NIL) THEN dragPossible := TRUE; dragNode := node; END; ELSE CloseSubMenu(FALSE); END; END PointerDown; PROCEDURE PointerUp*(x, y : LONGINT; keys : SET); VAR node : WMTrees.TreeNode; BEGIN IF leftClick THEN IF horizontal.Get() THEN node := FindHorizontal(x); ELSE node := FindVertical(y); END; IF (node # NIL) THEN IF IsSelectable(node) THEN SelectNode(node, FALSE); END; ELSE CloseSubMenu(FALSE); END; END; dragPossible := FALSE; END PointerUp; PROCEDURE PointerMove*(x, y : LONGINT; keys : SET); VAR node : WMTrees.TreeNode; BEGIN IF dragPossible THEN IF (ABS(x - downX) > DragDist) OR (ABS(y - downY) > DragDist) THEN dragPossible := FALSE; IF (dragObject # NIL) THEN leftClick := FALSE; MyStartDrag(dragNode, dragObject); END; END; ELSE IF horizontal.Get() THEN node := FindHorizontal(x); ELSE node := FindVertical(y); END; IF (node # NIL) & ~IsSelectable(node) THEN node := NIL; END; IF (node # hover) THEN hover := node; Invalidate; END; END; END PointerMove; PROCEDURE PointerLeave*; BEGIN IF hover # NIL THEN hover := NIL; Invalidate; END; END PointerLeave; PROCEDURE MyStartDrag(node : WMTrees.TreeNode; object : ANY); VAR image, canvasImage : WMGraphics.Image; VAR caption : Strings.String; canvas : WMGraphics.BufferCanvas; width, height, x : LONGINT; BEGIN ASSERT((node # NIL) & (object # NIL)); menu.Acquire; image := menu.GetNodeImage(node); caption := menu.GetNodeCaption(node); height := ItemHeight(node); menu.Release; width := bounds.GetWidth(); NEW(canvasImage); Raster.Create(canvasImage, width, height, Raster.BGRA8888); NEW(canvas, canvasImage); (* actually should factor out node rendering code in DrawBackground and re-use it here... *) x := HMenuDistance; canvas.Fill(WMRectangles.MakeRect(0, 0, greyBoxWidth, height), LightGreyDrag, WMGraphics.ModeSrcOverDst); canvas.Fill(WMRectangles.MakeRect(greyBoxWidth, 0, width, height), WhiteDrag, WMGraphics.ModeSrcOverDst); IF (image # NIL) THEN canvas.DrawImage(x, VMenuDistance, image, WMGraphics.ModeSrcOverDst); x := x + image.width + HMenuDistance + TextImageDistance; END; IF (caption # NIL) THEN canvas.SetColor(WMGraphics.Black); WMGraphics.DrawStringInRect(canvas, WMRectangles.MakeRect(x, 0, width, height), FALSE, WMGraphics.AlignLeft, WMGraphics.AlignCenter, caption^); END; IF ~StartDrag(object, canvasImage, 0,0,DragWasAccepted, NIL) THEN dragNode := NIL; dragObject := NIL; END; END MyStartDrag; PROCEDURE DragWasAccepted(sender, data : ANY); VAR di : WMWindowManager.DragInfo; itf : WMDropTarget.DropInterface; ignoreRes : WORD; BEGIN IF (data # NIL) & (data IS WMWindowManager.DragInfo) THEN di := data(WMWindowManager.DragInfo); IF (di.data # NIL) & (di.data IS WMDropTarget.DropTarget) THEN itf := di.data(WMDropTarget.DropTarget).GetInterface(WMDropTarget.TypeObject); IF (itf # NIL) & (itf IS WMDropTarget.DropObject) THEN itf(WMDropTarget.DropObject).Set(dragObject, ignoreRes); END; END; END; IF (rootMenuPanel.parentWindow # NIL) THEN rootMenuPanel.parentWindow.Close; ELSE rootMenuPanel.CloseSubMenu(FALSE); END; END DragWasAccepted; PROCEDURE CursorUp; BEGIN IF horizontal.Get() THEN IF (openDirectionI = OpenUpLeft) OR (openDirectionI = OpenUpRight) THEN IF (hover # NIL) & HasChildren(hover, menu) THEN SelectNode(hover, TRUE); END; END; ELSE MoveToPrevious; END; END CursorUp; PROCEDURE CursorDown; BEGIN IF horizontal.Get() THEN IF (openDirectionI = OpenDownLeft) OR (openDirectionI = OpenDownRight) THEN IF (hover # NIL) & HasChildren(hover, menu) THEN SelectNode(hover, TRUE); END; END; ELSE MoveToNext; END; END CursorDown; PROCEDURE CursorLeft; BEGIN IF horizontal.Get() THEN MoveToPrevious; ELSE IF (openDirectionI = OpenUpLeft) OR (openDirectionI = OpenDownLeft) THEN Acquire; IF (hover # NIL) & HasChildren(hover, menu) THEN SelectNode(hover, TRUE); END; Release; ELSE IF (parentMenuPanel # NIL) THEN parentMenuPanel.CloseSubMenu(TRUE); END; END; END; END CursorLeft; PROCEDURE CursorRight; BEGIN IF horizontal.Get() THEN MoveToNext; ELSE IF (openDirectionI = OpenUpRight) OR (openDirectionI = OpenDownRight) THEN Acquire; IF (hover # NIL) & HasChildren(hover, menu) THEN SelectNode(hover, TRUE); END; Release; ELSE IF (parentMenuPanel # NIL) THEN parentMenuPanel.CloseSubMenu(TRUE); END; END; END; END CursorRight; PROCEDURE MoveToPrevious; BEGIN Acquire; menu.Acquire; IF (hover # NIL) THEN hover := menu.GetPrevSibling(hover); IF (hover = NIL) THEN hover := menu.GetLastChild(root); END; ELSE hover := menu.GetLastChild(root); END; menu.Release; Release; Invalidate; END MoveToPrevious; PROCEDURE MoveToNext; BEGIN Acquire; menu.Acquire; IF (hover # NIL) THEN hover := menu.GetNextSibling(hover); IF (hover = NIL) THEN hover := menu.GetChildren(root); END; ELSE hover := menu.GetChildren(root); END; menu.Release; Release; Invalidate; END MoveToNext; PROCEDURE SelectCurrent; BEGIN Acquire; IF (hover # NIL) THEN SelectNode(hover, TRUE); END; Release; END SelectCurrent; PROCEDURE KeyEvent*(ucs : LONGINT; flags: SET; VAR keySym: LONGINT); (** PROTECTED *) VAR focusPanel : MenuPanel; BEGIN ASSERT(IsCallFromSequencer()); IF (Inputs.Release IN flags) THEN RETURN; END; focusPanel := rootMenuPanel.focusPanel; IF (focusPanel # NIL) THEN IF (keySym = Inputs.KsUp) THEN focusPanel.CursorUp; ELSIF (keySym = Inputs.KsDown) THEN focusPanel.CursorDown; ELSIF (keySym = Inputs.KsLeft) THEN focusPanel.CursorLeft; ELSIF (keySym = Inputs.KsRight) THEN focusPanel.CursorRight; ELSIF (ucs = 20H) OR (keySym = Inputs.KsReturn) THEN focusPanel.SelectCurrent; ELSIF (keySym = Inputs.KsEscape) THEN IF (focusPanel.parentMenuPanel # NIL) THEN focusPanel.parentMenuPanel.CloseSubMenu(TRUE); ELSIF (focusPanel.parentWindow # NIL) THEN focusPanel.parentWindow.CloseMenu(NIL, NIL); END; ELSE END; END; END KeyEvent; PROCEDURE FocusLost*; BEGIN FocusLost^; CloseSubMenu(FALSE); IF (selection # NIL) OR (hover # NIL) THEN selection := NIL; hover := NIL; Invalidate; END; END FocusLost; PROCEDURE Finalize*; BEGIN Finalize^; CloseSubMenu(FALSE); END Finalize; END MenuPanel; TYPE ShadowWindow = OBJECT(WMWindowManager.Window) VAR type, color : LONGINT; PROCEDURE &New(type : LONGINT); BEGIN ASSERT((type = Right) OR (type = Bottom)); SELF.type := type; Init(0, 0, TRUE); color := 04FH; END New; PROCEDURE Draw*(canvas : WMGraphics.Canvas; w, h, q : LONGINT); BEGIN canvas.Fill(WMRectangles.MakeRect(0, 0, w, h), color, WMGraphics.ModeSrcOverDst); END Draw; END ShadowWindow; TYPE MenuWindow= OBJECT(WMComponents.FormWindow) VAR menuPanel : MenuPanel; takesFocus : BOOLEAN; PROCEDURE &Open*(x, y : LONGINT; openDirection : LONGINT; menu : WMTrees.Tree; root : WMTrees.TreeNode; parent : MenuPanel; takesFocus, indicate : BOOLEAN); VAR width, height, dx, dy : LONGINT; ignore : BOOLEAN; flags : SET; BEGIN NEW(menuPanel); menuPanel.openDirection.Set(openDirection); menuPanel.SetMenu(menu, root); menuPanel.SetParent(parent); IF (indicate) THEN menu.Acquire; menuPanel.hover := menu.GetChildren(root); menu.Release; END; SELF.takesFocus := takesFocus; menuPanel.Measure(width, height); IF (height < 5) THEN height := 5; END; IF (width < 5) THEN width := 5; END; CASE openDirection OF |OpenUpLeft : dx := -width; dy := -height; |OpenUpRight : dy := -height; |OpenDownLeft : dx := -width; ELSE dx := 0; dy := 0; END; menuPanel.bounds.SetExtents(width, height); menuPanel.fillColor.Set(WMGraphics.White); Init(menuPanel.bounds.GetWidth(), menuPanel.bounds.GetHeight(), FALSE); SetContent(menuPanel); flags := {WMWindowManager.FlagFrame, WMWindowManager.FlagHidden, WMWindowManager.FlagStayOnTop}; IF ~takesFocus THEN flags := flags + {WMWindowManager.FlagNoFocus}; END; AddWindow(SELF, x + dx, y + dy, flags); ignore := manager.TransferPointer(SELF); manager.SetFocus(SELF); END Open; PROCEDURE CloseMenu(sender, data : ANY); BEGIN IF ~sequencer.IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.CloseMenu, NIL, NIL); ELSE Close; END END CloseMenu; PROCEDURE FocusLost*; BEGIN FocusLost^; IF takesFocus THEN Close; END; END FocusLost; PROCEDURE Draw*(canvas : WMGraphics.Canvas; w, h, q : LONGINT); (** override *) BEGIN Draw^(canvas, w, h, q); WMGraphicUtilities.DrawRect(canvas, WMRectangles.MakeRect(0, 0, w, h), WMGraphics.Black, WMGraphics.ModeCopy); END Draw; END MenuWindow; VAR StrMenuPanel : Strings.String; PROCEDURE AddWindow(window : WMWindowManager.Window; x, y : LONGINT; flags : SET); VAR manager : WMWindowManager.WindowManager; view : WMWindowManager.ViewPort; oldDecorator : WMWindowManager.Decorator; BEGIN ASSERT(window # NIL); manager := WMWindowManager.GetDefaultManager(); view := WMWindowManager.GetDefaultView(); ASSERT((manager # NIL) & (view # NIL)); manager.lock.AcquireWrite; oldDecorator := manager.decorate; manager.decorate := ShadowDecorator; manager.Add((*ENTIER(view.range.l) +*) x, (*ENTIER(view.range.t) + *)y, window, flags); manager.decorate := oldDecorator; manager.lock.ReleaseWrite; END AddWindow; PROCEDURE ShadowDecorator(window : WMWindowManager.Window); VAR shadow : ShadowWindow; l, r, t, b : LONGINT; PROCEDURE InsertAfter(old, new : WMWindowManager.Window); BEGIN new.next := old.next; new.prev := old; old.next := new; new.next.prev := new END InsertAfter; PROCEDURE InitShadow(shadow : ShadowWindow); BEGIN shadow.manager := window.manager; shadow.flags := {WMWindowManager.FlagNoFocus, WMWindowManager.FlagHidden}; IF WMWindowManager.FlagStayOnBottom IN window.flags THEN INCL(shadow.flags, WMWindowManager.FlagStayOnBottom); END; IF WMWindowManager.FlagNoResizing IN window.flags THEN INCL(shadow.flags, WMWindowManager.FlagNoResizing); END; IF WMWindowManager.FlagNavigation IN window.flags THEN shadow.view := window.view; INCL(shadow.flags, WMWindowManager.FlagNavigation); END; InsertAfter(window, shadow); shadow.manager.AddDecorWindow(window, shadow); shadow.manager.AddVisibleDirty(shadow, shadow.bounds); END InitShadow; BEGIN ASSERT((window.manager # NIL) & (window.manager.lock.HasWriteLock())); l := window.bounds.l; r := window.bounds.r; t := window.bounds.t; b := window.bounds.b; NEW(shadow, Right); window.rightW := shadow; shadow.bounds := WMRectangles.MakeRect(r, t + ShadowOffsetVertical, r + ShadowWidth, b + ShadowHeight); InitShadow(shadow); NEW(shadow, Bottom); window.bottomW := shadow; shadow.bounds := WMRectangles.MakeRect(l + ShadowOffsetHorizontal, b, r, b + ShadowHeight); InitShadow(shadow); END ShadowDecorator; PROCEDURE HasChildren(parent : WMTrees.TreeNode; tree : WMTrees.Tree) : BOOLEAN; VAR hasChildren : BOOLEAN; BEGIN ASSERT(tree # NIL); IF (parent # NIL) THEN tree.Acquire; hasChildren := tree.GetChildren(parent) # NIL; tree.Release; ELSE hasChildren := FALSE; END; RETURN hasChildren; END HasChildren; PROCEDURE GetCaption*(data : ANY; menu : WMTrees.Tree) : Strings.String; VAR caption : Strings.String; BEGIN ASSERT(menu # NIL); IF (data # NIL) & (data IS WMTrees.TreeNode) THEN menu.Acquire; caption := menu.GetNodeCaption(data(WMTrees.TreeNode)); menu.Release; ELSE caption := NIL; END; RETURN caption; END GetCaption; PROCEDURE GetDragWrapper*(node : WMTrees.TreeNode; menu : WMTrees.Tree) : DragWrapper; VAR data: ANY; drag : DragWrapper BEGIN ASSERT(menu # NIL); drag := NIL; IF (node # NIL) THEN menu.Acquire; data := menu.GetNodeData(node); menu.Release; IF (data # NIL) & (data IS DragWrapper) THEN drag := data(DragWrapper); END; END; RETURN drag; END GetDragWrapper; PROCEDURE FindChild(CONST caption : ARRAY OF CHAR; parent : WMTrees.TreeNode; tree : WMTrees.Tree) : WMTrees.TreeNode; VAR child : WMTrees.TreeNode; string : Strings.String; found : BOOLEAN; BEGIN ASSERT((parent # NIL) & (tree # NIL) & (tree.HasLock())); found := FALSE; child := tree.GetChildren(parent); WHILE (child # NIL) & ~found DO string := tree.GetNodeCaption(child); found := (string # NIL) & (string^ = caption); IF ~found THEN child := tree.GetNextSibling(child); END; END; RETURN child; END FindChild; PROCEDURE AddChild*(CONST caption : ARRAY OF CHAR; parent : WMTrees.TreeNode; tree : WMTrees.Tree) : WMTrees.TreeNode; VAR node : WMTrees.TreeNode; separator : Separator; BEGIN ASSERT((parent # NIL) & (tree # NIL) & (tree.HasLock())); IF (caption # SeparatorCaption) THEN NEW(node); tree.SetNodeCaption(node, Strings.NewString(caption)); ELSE NEW(separator); node := separator; END; tree.AddChildNode(parent, node); RETURN node; END AddChild; PROCEDURE Find*(CONST path : ARRAY OF CHAR; menu : WMTrees.Tree) : WMTrees.TreeNode; VAR caption : ARRAY 256 OF CHAR; child, node, parent : WMTrees.TreeNode; i, j : LONGINT; BEGIN ASSERT(menu # NIL); node := NIL; menu.Acquire; parent := menu.GetRoot(); IF (parent # NIL) THEN caption := ""; i := 0; j := 0; LOOP IF (i >= LEN(path)) THEN EXIT; ELSIF (path[i] = ".") OR (path[i] = 0X) THEN caption[j] := 0X; child := FindChild(caption, parent, menu); IF (child = NIL) THEN EXIT; END; parent := child; IF (path[i] = 0X) THEN node := child; EXIT; ELSE caption := ""; j := 0; END; ELSIF (j < LEN(caption) - 1) THEN caption[j] := path[i]; INC(j); END; INC(i); END; END; menu.Release; RETURN node; END Find; PROCEDURE AddItemNode*(CONST path : ARRAY OF CHAR; menu : WMTrees.Tree) : WMTrees.TreeNode; VAR caption : ARRAY 256 OF CHAR; node, parent : WMTrees.TreeNode; i, j : LONGINT; BEGIN ASSERT(menu # NIL); menu.Acquire; IF (menu.GetRoot() = NIL) THEN NEW(node); menu.SetRoot(node) END; i := 0; j := 0; caption := ""; parent := menu.GetRoot(); LOOP IF (i >= LEN(path)) THEN EXIT; ELSIF (path[i] = ".") OR (path[i] = 0X) THEN caption[j] := 0X; node := FindChild(caption, parent, menu); IF (node = NIL) THEN node := AddChild(caption, parent, menu); END; parent := node; caption := ""; j := 0; IF (path[i] = 0X) THEN EXIT; END; ELSIF (j < LEN(caption) - 1) THEN caption[j] := path[i]; INC(j); END; INC(i); END; menu.Release; ASSERT(node # NIL); RETURN node; END AddItemNode; PROCEDURE AddItem*(CONST path : ARRAY OF CHAR; menu : WMTrees.Tree); VAR ignore : WMTrees.TreeNode; BEGIN ignore := AddItemNode(path, menu); END AddItem; PROCEDURE Show*(menu : WMTrees.Tree; x, y : LONGINT; handler : WMEvents.EventListener); VAR window : MenuWindow; root : WMTrees.TreeNode; BEGIN ASSERT((menu # NIL) & (handler # NIL)); menu.Acquire; root := menu.GetRoot(); menu.Release; IF (root # NIL) THEN NEW(window, x, y, OpenDefault, menu, root, NIL, TRUE, FALSE); window.menuPanel.SetParentWindow(window); window.menuPanel.onSelect.Add(handler); END; END Show; BEGIN StrMenuPanel := Strings.NewString("MenuPanel"); END WMMenus.