module ContextMenu ( canvas, edge, node, via ) where import State import Network import Document import NetworkControl import SafetyNet import CommonIO import Math (DoublePoint) import qualified PersistentDocument as PD import Palette import InfoKind import Text.Parse import INReduction import Graphics.UI.WX import Graphics.UI.WXCore(windowGetMousePosition) -- | Context menu for empty area of canvas canvas :: (InfoKind n g, Show g, Parse g) => Frame () -> State g n e -> IO () canvas theFrame state = do{ contextMenu <- menuPane [] ; menuItem contextMenu [ text := "Add node (shift-click)" , on command := safetyNet theFrame $ addNodeItem theFrame state ] {- ; menuItem contextMenu [ text := "Edit global info" , on command := safetyNet theFrame $ changeGlobalInfo theFrame state ] -} ; pointWithinWindow <- windowGetMousePosition theFrame ; menuPopup contextMenu pointWithinWindow theFrame ; objectDelete contextMenu } addNodeItem :: (InfoKind n g) => Frame () -> State g n e -> IO () addNodeItem theFrame state = do{ mousePoint <- windowGetMousePosition theFrame ; ppi <- getScreenPPI ; let doubleMousePoint = screenToLogicalPoint ppi mousePoint ; createNode doubleMousePoint state } -- | Context menu for an edge edge :: (InfoKind n g, InfoKind e g) => Frame () -> DoublePoint -> State g n e -> Bool -> IO () edge theFrame mousepoint state isActivepair = do{ contextMenu <- menuPane [] ; menuItem contextMenu [ text := "Add control point" , on command := safetyNet theFrame $ createVia mousepoint state ] ; menuItem contextMenu [ text := "Delete edge (Del)" , on command := safetyNet theFrame $ deleteSelection state ] {- ; menuItem contextMenu [ text := "Edit info (i)" , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state ] -} ; menuItem contextMenu [ text := "Reduce active pair" , enabled := isActivepair , on command := reduce state ] ; pointWithinWindow <- windowGetMousePosition theFrame ; menuPopup contextMenu pointWithinWindow theFrame ; objectDelete contextMenu } -- | Context menu for a 'via' point via :: Frame () -> State g n e -> IO () via theFrame state = do{ contextMenu <- menuPane [] ; menuItem contextMenu [ text := "Delete control point (Del)" , on command := safetyNet theFrame $ deleteSelection state ] ; pointWithinWindow <- windowGetMousePosition theFrame ; menuPopup contextMenu pointWithinWindow theFrame ; objectDelete contextMenu } -- | Context menu for a node node :: (InfoKind n g, InfoKind e g) => Int -> Frame () -> State g n e -> IO () node nodeNr theFrame state = do{ contextMenu <- menuPane [] ; pDoc <- getDocument state ; doc <- PD.getDocument pDoc ; canvas <- getActiveCanvas state ; let network = selectNetwork doc canvas theNode = getNode nodeNr network labelAbove = getNameAbove theNode palette = getPalette doc theShape = getShape theNode ; aboveItem <- menuRadioItem contextMenu [ text := "Label above (up arrow)" , checked := labelAbove , on command := safetyNet theFrame $ changeNamePosition True state ] ; belowItem <- menuRadioItem contextMenu [ text := "Label below (down arrow)" , checked := not labelAbove , on command := safetyNet theFrame $ changeNamePosition False state ] -- ; set (if labelAbove then aboveItem else belowItem) [ checked := True ] ; menuItem contextMenu [ text := "Rename (r)" , on command := safetyNet theFrame $ renameNode theFrame state ] {- ; menuItem contextMenu [ text := "Edit info (i)" , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state ] -} ; menuLine contextMenu -- ; mapM_ (shapeItem theShape contextMenu) (shapes palette) -- ; menuLine contextMenu ; menuItem contextMenu [ text := "Delete (Del)" , on command := safetyNet theFrame $ deleteSelection state ] ; pointWithinWindow <- windowGetMousePosition theFrame ; menuPopup contextMenu pointWithinWindow theFrame ; objectDelete contextMenu } where shapeItem curShape contextMenu (name,(shape,ports,info)) = menuRadioItem contextMenu [ text := ("Shape: "++name) , checked := case curShape of { Left n -> n==name; Right s -> False; } , on command := safetyNet theFrame $ changeNodeShape name newinfo state ] where newinfo = maybe blank id info