INblobs-0.1.1: src/ContextMenu.hs

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