GraphAbstraction.hs revision b6b955bb313159bdd477048e9eeaf7d76cfd5c82
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerModule : $Header$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerDescription : Interface for graph viewing and abstraction
6b26240dca29e026900a83d51c75ca230a072a16Thiemo WiedemeyerCopyright : (c) Thiemo Wiedemeyer, T. Mossakowski, Uni Bremen 2002-2008
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerMaintainer : raider@informatik.uni-bremen.de
2eeec5240b424984e3ee26296da1eeab6c6d739eChristian MaederStability : provisional
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerPortability : non-portable (relies on Logic via DevGraph)
7520452bb30b5abbd471f82352fc4c1c937e02c5Till MossakowskiInterface for graph viewing and abstraction.
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , AbstractionGraph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -- * Creation and display
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , makegraphExt
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -- * Node interface
38122cbf09ad3dcc31a826cc4093f630515a5cfcChristian Maeder , isHiddenNode
521045d36343cd17dd217a81d4b9422ad6ab6a07Christian Maeder , hasHiddenNodes
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , changeNodeType
0193c86704431f83731015a77cb613d67ae4e3c2Thiemo Wiedemeyer -- * Edge interface
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer , hideSetOfEdgeTypes
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer , isHiddenEdge
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer , hasHiddenEdges
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyer , changeEdgeType
7ae38566aaf40710cd83ffa3ba25655c4ad22741Thiemo Wiedemeyer -- * Direct manipulation of uDrawGraph
1a389234e68da7c3d087b038307ed8c66fc6dc32Thiemo Wiedemeyer , layoutImproveAll
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer , showTemporaryMessage
38122cbf09ad3dcc31a826cc4093f630515a5cfcChristian Maeder , deactivateGraphWindow
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , activateGraphWindow
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport DaVinciGraph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport DaVinciBasic
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport qualified DaVinciTypes as DVT
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport GraphDisp
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport GraphConfigure
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport Static.DevGraph (DGLinkLab, EdgeId(..),DGEdgeType,DGNodeType)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport qualified Data.Map as Map
36f69d35e01d2d6b6bdc165b49661f2a80af8687Mihai Codescuimport qualified Data.Graph.Inductive.Graph as Graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport Data.Maybe (isNothing)
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyerimport Control.Monad (filterM, unless)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerimport Control.Concurrent (threadDelay)
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyertype OurGraph =
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer Graph DaVinciGraph
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder DaVinciGraphParms
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder DaVinciNodeType
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder DaVinciNodeTypeParms
7ae38566aaf40710cd83ffa3ba25655c4ad22741Thiemo Wiedemeyer DaVinciArcType
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer DaVinciArcTypeParms
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maedertype NodeId = Int
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyertype NodeValue = (String, NodeId)
79d103748927615310322af6f7806c7cef11a802Christian Maedertype EdgeValue = (String, EdgeId, Maybe (LEdge DGLinkLab))
ecd98975b8a8ab5a7bc075562bdab51cf47d2a90Christian Maeder-- | Internal node
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maederdata GANode = GANode
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder { udgNode :: Maybe (DaVinciNode NodeValue) -- ^ uDrawGraph node
ecd98975b8a8ab5a7bc075562bdab51cf47d2a90Christian Maeder , ganType :: DGNodeType -- ^ ID of nodetype
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , ganValue :: NodeValue -- ^ Holds the nodevalue for uDrawGraph node
f456529a89bfb620d39e5fd5b0a53b24643db96dDominik Luecke-- | Internal edge
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerdata GAEdge = GAEdge
4c8d3c5a9e938633f6147b5a595b9b93bfca99e6Christian Maeder { udgEdge :: Maybe (DaVinciArc EdgeValue) -- ^ uDrawGraph edge
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , ganFrom :: NodeId -- ^ ID of source node
4c8d3c5a9e938633f6147b5a595b9b93bfca99e6Christian Maeder , ganTo :: NodeId -- ^ID of target node
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , gaeType :: DGEdgeType -- ^ ID of edgetype
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , gaeValue :: EdgeValue -- ^ Holds the edgevalue for uDrawGraph edge
93eeaffa1087fc6eae3f19b8ca5affb7802799fdThiemo Wiedemeyerdata GANodeType = GANodeType
415b2b968b52f687ba19f57aa85c9c5ee36f91e0Thiemo Wiedemeyer { udgNodeType :: DaVinciNodeType NodeValue
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerdata GAEdgeType = GAEdgeType
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer { udgEdgeType :: DaVinciArcType EdgeValue
16e45483b5ce48f0b92d01c817242a8c9b8bae02Christian Maeder , udgCompressed :: DaVinciArcType EdgeValue
40b73e7d13a858afeac95321fcdb9ac216bfbf01Thiemo Wiedemeyer , gaeHidden :: Bool
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- Main datastructure for carrying around the graph,
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- both internally (nodes as integers), and at the daVinci level
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanudata AbstractionGraph = AbstractionGraph
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer { theGraph :: OurGraph
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyer , nodes :: Map.Map NodeId GANode
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyer , edges :: Map.Map EdgeId GAEdge
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyer , nodeTypes :: Map.Map DGNodeType GANodeType
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyer , edgeTypes :: Map.Map DGEdgeType GAEdgeType
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyer , compressedEdges :: [GAEdge]
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyertype GraphInfo = IORef AbstractionGraph
03bbcb1fefdbd8bc4e8329ca2688809d84aff0a9Christian Maederinstance Eq (DaVinciNode NodeValue) where
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyerinstance Eq (DaVinciArc EdgeValue) where
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder-- | Forces a redraw of the uDrawGraph and wait an amount of time
331603b37dec12e37e2e1df9634ef0f2c5c73ddfThiemo Wiedemeyerredisplay :: GraphInfo -> IO ()
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerredisplay gi = do
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer g <- readIORef gi
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder redraw (theGraph g)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu threadDelay 300000
1ac36418f204bbe56f4cd951a979180721758999Christian Maederclear :: GraphInfo -> IO ()
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu g <- readIORef gi
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer mapM_ (delCompressedEdge gi) $ compressedEdges g
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer writeIORef gi g { compressedEdges = [] }
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer mapM_ (delEdge gi) $ Map.keys $ edges g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu mapM_ (delNode gi) $ Map.keys $ nodes g
ddc662fdf0207eae2034d7b68ae5e2225c575207Thiemo Wiedemeyer-- | Creates an empty graph structure
966a6c024c828387023fccb0cd0049f78687e5dcThiemo Wiedemeyergraphtool :: OurGraph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanugraphtool = daVinciSort
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder-- | Creates the empty AbstractionGraph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanuinitgraphs :: IO GraphInfo
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanuinitgraphs = do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu let g = AbstractionGraph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu { theGraph = graphtool
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , compressedEdges = []
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Simpler version of makegraphExt
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanumakegraph :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> String -- Title
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> Maybe (IO ()) -- FileOpen Menu
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -> Maybe (IO ()) -- FileSave Menu
109b67ffce2bad83667e2f4a319d2d7f380f91afThiemo Wiedemeyer -> Maybe (IO ()) -- FileSaveAs Menu
109b67ffce2bad83667e2f4a319d2d7f380f91afThiemo Wiedemeyer -> [GlobalMenu]
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder -> [(DGNodeType,DaVinciNodeTypeParms NodeValue)]
109b67ffce2bad83667e2f4a319d2d7f380f91afThiemo Wiedemeyer -> [(DGEdgeType,DaVinciArcTypeParms EdgeValue)]
109b67ffce2bad83667e2f4a319d2d7f380f91afThiemo Wiedemeyermakegraph gi title open save saveAs menus nodetypeparams edgetypeparams =
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder makegraphExt gi title open save saveAs (return True) Nothing menus
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder nodetypeparams edgetypeparams
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer-- | Creates the uDrawGraph graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanumakegraphExt :: GraphInfo -- ^ The graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -> String -- Title
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> Maybe (IO ()) -- FileOpen Menu
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder -> Maybe (IO ()) -- FileSave Menu
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder -> Maybe (IO ()) -- FileSaveAs Menu
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> IO Bool -- FileClose Menu
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> Maybe (IO ()) -- FileExit Menu
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> [GlobalMenu]
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -> [(DGNodeType,DaVinciNodeTypeParms NodeValue)]
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> [(DGEdgeType,DaVinciArcTypeParms EdgeValue)]
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyermakegraphExt gi title open save saveAs close exit menus nTypeParams
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu eTypeParams = do
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer let graphParms =
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer foldr ($$) (GraphTitle title $$
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer OptimiseLayout False $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer AllowClose close $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer FileMenuAct OpenMenuOption open $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer FileMenuAct SaveMenuOption save $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer FileMenuAct SaveAsMenuOption saveAs $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer FileMenuAct ExitMenuOption exit $$
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer emptyGraphParms)
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer (nTypeNames,nTypeParams1) = unzip nTypeParams
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer (eTypeNames,eTypeParams1) = unzip eTypeParams
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer eTypeParams2 = map (LocalMenu (Button "Expand" (\ _ -> do
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer redisplay gi)) $$$)
1be357403a65d1954fd6b5f38e5cf8a630d8112fThiemo Wiedemeyer $ map (Color "purple2" $$$) eTypeParams1
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder graph <- newGraph graphtool graphParms
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu nTypes <- mapM (newNodeType graph) nTypeParams1
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder eTypes <- mapM (newArcType graph) eTypeParams1
86b2d79be961f0247a2eed10ed4f86d8d6a7639dChristian Maeder cTypes <- mapM (newArcType graph) eTypeParams2
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer let g = AbstractionGraph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer { theGraph = graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer , nodeTypes = Map.fromList $ zip nTypeNames
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu $ map (\ nt -> GANodeType { udgNodeType = nt }) nTypes
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , edgeTypes = Map.fromList $ zip eTypeNames
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder $ map (\ (et,ct) -> GAEdgeType { udgEdgeType = et
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , udgCompressed = ct
8f5219469b89a15dc6d4c2c30463775975f5841cRazvan Pascanu , gaeHidden = False })
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu $ zip eTypes cTypes
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , compressedEdges = []
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer writeIORef gi g
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder{- similar to lookup (for Map), but returns just the value if lookup was
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu successful otherwise an error is raised. -}
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyerget :: (Show k, Ord k) => k -> Map.Map k a -> a
1ac36418f204bbe56f4cd951a979180721758999Christian Maederget key = Map.findWithDefault (error $ "get: id unknown: " ++ show key) key
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer-- | Shows all hidden nodes and edges
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanushowAll :: GraphInfo -- ^ The graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyershowAll gi = do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu g <- readIORef gi
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder mapM_ (delCompressedEdge gi) $ compressedEdges g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu writeIORef gi g { compressedEdges = [] }
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu nodes' <- filterM (isHiddenNode gi) $ Map.keys $ nodes g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu edges' <- filterM (isHiddenEdge gi) $ Map.keys $ edges g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu mapM_ (showNode gi) nodes'
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu mapM_ (showEdge gi) edges'
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu{- Functions for adding, deleting, changing and hidding nodes.-}
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Adds a node (type id)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuaddNode :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> NodeId -- ^ ID of the node
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -> DGNodeType -- ^ ID of the nodetype
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> String -- ^ Name of the node
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyeraddNode gi nId nType nName = do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu g' <- readIORef gi
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer g <- if Map.member nId $ nodes g' then do
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer delNode gi nId
ddc662fdf0207eae2034d7b68ae5e2225c575207Thiemo Wiedemeyer else return g'
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu node' <- newNode (theGraph g) (udgNodeType $ get nType $ nodeTypes g)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu let node = GANode { udgNode = Just node'
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder , ganType = nType
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , ganValue = (nName, nId)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu writeIORef gi g { nodes = Map.insert nId node $ nodes g }
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Deletes a node
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanudelNode :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> NodeId -- ^ ID of the node
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanudelNode gi nId = do
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer g <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer case udgNode $ get nId $ nodes g of
aa07f9c4585a94514dcff2979d853d6e04c12fb9Thiemo Wiedemeyer Just node -> deleteNode (theGraph g) node
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyer Nothing -> return ()
aa07f9c4585a94514dcff2979d853d6e04c12fb9Thiemo Wiedemeyer writeIORef gi g { nodes = Map.delete nId $ nodes g }
aa07f9c4585a94514dcff2979d853d6e04c12fb9Thiemo Wiedemeyer-- | Hides a node
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo WiedemeyerhideNode :: GraphInfo -- ^ The graph
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer -> NodeId -- ^ ID of the node
86b2d79be961f0247a2eed10ed4f86d8d6a7639dChristian MaederhideNode gi nId = do
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer g <- readIORef gi
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer let node = get nId $ nodes g
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer case udgNode node of
aa07f9c4585a94514dcff2979d853d6e04c12fb9Thiemo Wiedemeyer Nothing -> return ()
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Just node' -> do
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer deleteNode (theGraph g) node'
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer writeIORef gi g
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer { nodes = Map.insert nId node {udgNode = Nothing} $ nodes g }
76ecd8e01387d1edc9197f3464073264fa2c789aThiemo Wiedemeyer-- | Hides a set of nodes
1ac36418f204bbe56f4cd951a979180721758999Christian MaederhideNodes :: GraphInfo -- ^ The graph
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> [NodeId] -- ^ IDs of the nodes to hide
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer -> [(NodeId, NodeId, DGEdgeType)] -- ^ A list of new edges
545d0cd78159cade346b579d06052638b19b0f72Thiemo WiedemeyerhideNodes gi nIds compedges = do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu threadDelay 300000
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer hideEdgesOfNodes gi nIds
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu mapM_ (hideNode gi) nIds
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder mapM_ (addCompressedEdge gi) compedges
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder-- | Checks whether a node is hidden or not
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuisHiddenNode :: GraphInfo -- ^ The graph
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder -> NodeId -- ^ ID of the node
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuisHiddenNode gi nId =
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu fmap (isNothing . udgNode . get nId . nodes) $ readIORef gi
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Checks if at least one hidden node exists
5b00a9d748d5bea461601ed7ed5198dfd30cf2d2Thiemo WiedemeyerhasHiddenNodes :: GraphInfo -- ^ The graph
5b00a9d748d5bea461601ed7ed5198dfd30cf2d2Thiemo WiedemeyerhasHiddenNodes =
5b00a9d748d5bea461601ed7ed5198dfd30cf2d2Thiemo Wiedemeyer fmap (Map.fold (\ n b -> b || isNothing (udgNode n)) False . nodes)
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer-- | Shows a hidden node again
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyershowNode :: GraphInfo -- ^ The graph
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer -> NodeId -- ^ ID of the node
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyershowNode gi nId = do
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer g <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer let node = get nId $ nodes g
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer case udgNode node of
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer Just _ -> return ()
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer node' <- newNode (theGraph g)
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer (udgNodeType $ get (ganType node) $ nodeTypes g)
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer $ ganValue node
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer writeIORef gi g
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer { nodes = Map.insert nId node { udgNode = Just node' } $ nodes g }
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer-- | Change the node type of the given node
1ac36418f204bbe56f4cd951a979180721758999Christian MaederchangeNodeType :: GraphInfo -- ^ The graph
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder -> NodeId -- ^ ID of the node
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> DGNodeType -- ^ ID of the nodetype
1ac36418f204bbe56f4cd951a979180721758999Christian MaederchangeNodeType gi nId nType = do
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer g <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer let node = get nId $ nodes g
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder case udgNode node of
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Nothing -> return ()
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Just node' -> setNodeType (theGraph g) node'
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer $ udgNodeType $ get nType $ nodeTypes g
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer writeIORef gi g
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer { nodes = Map.insert nId node { ganType = nType } $ nodes g }
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer-- | Focus a node
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyerfocusNode :: GraphInfo -- ^ The graph
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer -> NodeId -- ^ ID of the node
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyerfocusNode gi nId = do
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer g <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer case udgNode $ get nId $ nodes g of
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Nothing -> error "focusNode: node is hidden!"
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder Just node -> setNodeFocus (theGraph g) node
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer{- Functions for adding, deleting, changing and hidding edges.-}
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer-- | Adds an edge (type id)
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyeraddEdge :: GraphInfo -- ^ The graph
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> EdgeId -- ^ ID of the edge
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> DGEdgeType -- ^ ID of the edgetype
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> NodeId -- ^ ID of source node
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer -> NodeId -- ^ ID of target node
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer -> String -- ^ Name of the edge
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer -> Maybe (LEdge DGLinkLab) -- ^ Label of the edge
1ac36418f204bbe56f4cd951a979180721758999Christian MaederaddEdge gi eId eType nIdFrom nIdTo eName eLabel = do
84ba39232a012abf2085c8a421ebce6abc52d56eThiemo Wiedemeyer g' <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer g <- if Map.member eId $ edges g' then do
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer delEdge gi eId
545d0cd78159cade346b579d06052638b19b0f72Thiemo Wiedemeyer else return g'
1a389234e68da7c3d087b038307ed8c66fc6dc32Thiemo Wiedemeyer let gaeV = (eName, eId, eLabel)
1a389234e68da7c3d087b038307ed8c66fc6dc32Thiemo Wiedemeyer edge' <- case getEdgeAux g nIdFrom nIdTo eType (not . gaeHidden) of
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu Just (nFrom, nTo, gaeT) ->
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu fmap Just $ newArc (theGraph g) (udgEdgeType gaeT) gaeV nFrom nTo
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder Nothing -> return Nothing
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu let edge = GAEdge { udgEdge = edge'
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , gaeType = eType
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , ganFrom = nIdFrom
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , ganTo = nIdTo
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , gaeValue = gaeV }
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer writeIORef gi g { edges = Map.insert eId edge $ edges g }
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanugetEdgeAux :: AbstractionGraph -> NodeId -> NodeId -> DGEdgeType
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> (GAEdgeType -> Bool)
8681833aefdae18bfd52607b841373f024bbd99cChristian Maeder -> Maybe (DaVinciNode NodeValue, DaVinciNode NodeValue, GAEdgeType)
1a389234e68da7c3d087b038307ed8c66fc6dc32Thiemo WiedemeyergetEdgeAux g nIdFrom nIdTo eType f =
1a389234e68da7c3d087b038307ed8c66fc6dc32Thiemo Wiedemeyer let ns = nodes g
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer gaeT = get eType $ edgeTypes g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu in case (udgNode $ get nIdFrom ns, udgNode $ get nIdTo ns) of
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer (Just nFrom, Just nTo) | f gaeT -> Just (nFrom, nTo, gaeT)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Adds an compressed edge
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian MaederaddCompressedEdge :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> (NodeId, NodeId, DGEdgeType) -- ^ source, target, edgetype
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuaddCompressedEdge gi (nIdFrom, nIdTo, eType) = do
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer g <- readIORef gi
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer let gaeV = ("", EdgeId 0, Nothing)
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer edge' <- case getEdgeAux g nIdFrom nIdTo eType (not . gaeHidden) of
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer Just (nFrom, nTo, gaeT) ->
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer fmap Just $ newArc (theGraph g) (udgCompressed gaeT) gaeV nFrom nTo
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer Nothing -> return Nothing
37e30366abd83c00a5d5447b45694627fd783de8Cui Jian let edge = GAEdge { udgEdge = edge'
da955132262baab309a50fdffe228c9efe68251dCui Jian , gaeType = eType
37e30366abd83c00a5d5447b45694627fd783de8Cui Jian , ganFrom = nIdFrom
37e30366abd83c00a5d5447b45694627fd783de8Cui Jian , ganTo = nIdTo
37e30366abd83c00a5d5447b45694627fd783de8Cui Jian , gaeValue = gaeV }
37e30366abd83c00a5d5447b45694627fd783de8Cui Jian writeIORef gi g { compressedEdges = edge : compressedEdges g }
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer-- | Deletes an edge
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo WiedemeyerdelEdge :: GraphInfo -- ^ The graph
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder -> EdgeId -- ^ ID of the node
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian MaederdelEdge gi eId = do
40c18e3f63c23085e5bb36ea35efe141a87df8e4Klaus Luettich g <- readIORef gi
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer case udgEdge $ get eId $ edges g of
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Just edge -> deleteArc (theGraph g) edge
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Nothing -> return ()
8836fa284a241af325aa6f41234b5130b26ec4f9Thiemo Wiedemeyer writeIORef gi g { edges = Map.delete eId $ edges g }
fe1f344573c570949fa4f255c68bb9026c609832Thiemo Wiedemeyer-- | Deletes an compressed edge
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo WiedemeyerdelCompressedEdge :: GraphInfo -- ^ The graph
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer -> GAEdge -- ^ The compressed edge
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian MaederdelCompressedEdge gi e = do
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer g <- readIORef gi
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu case udgEdge e of
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer Just edge -> deleteArc (theGraph g) edge
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu Nothing -> return ()
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Hides an edge
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian MaederhideEdge :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> EdgeId -- ^ ID of the edge
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerhideEdge gi eId = do
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer g <- readIORef gi
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer let edge = get eId $ edges g
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer case udgEdge edge of
109b67ffce2bad83667e2f4a319d2d7f380f91afThiemo Wiedemeyer Nothing -> return ()
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer Just edge' -> do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu deleteArc (theGraph g) edge'
4d3b50fc78a0c99ff2914fb23f3c7fba6e38d790Thiemo Wiedemeyer writeIORef gi g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu { edges = Map.insert eId edge { udgEdge = Nothing } $ edges g }
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Hides incoming and outgoing edges of nodes
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuhideEdgesOfNodes :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> [NodeId] -- ^ IDs of the nodes to hide
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerhideEdgesOfNodes gi nIds = do
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer g <- readIORef gi
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer mapM_ (hideEdge gi) $ map fst
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer $ filter (\ (_,e) -> elem (ganTo e) nIds || elem (ganFrom e) nIds)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer-- | Hides a set of edgetypes (type ids)
d1066b8fb69179973dcab47154858d77e72760a7Thiemo WiedemeyerhideSetOfEdgeTypes :: GraphInfo -- ^ The graph
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer -> [DGEdgeType] -- ^ IDs of the edgetypes to hide
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerhideSetOfEdgeTypes gi eTypes = do
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer g <- readIORef gi
d1066b8fb69179973dcab47154858d77e72760a7Thiemo Wiedemeyer let (hEdges, sEdges) = Map.foldWithKey (\ eid e (he, se) ->
5107ba7da675778f2fded68493512b60eff8a455Christian Maeder if elem (gaeType e) eTypes then (eid : he, se) else (he, eid : se))
966a6c024c828387023fccb0cd0049f78687e5dcThiemo Wiedemeyer ([], []) $ edges g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu writeIORef gi g { edgeTypes = Map.mapWithKey
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu (\ etId et -> et { gaeHidden = elem etId eTypes }) $ edgeTypes g }
5107ba7da675778f2fded68493512b60eff8a455Christian Maeder mapM_ (hideEdge gi) hEdges
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu mapM_ (showEdge gi) sEdges
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- | Checks whether an edge is hidden or not
966a6c024c828387023fccb0cd0049f78687e5dcThiemo WiedemeyerisHiddenEdge :: GraphInfo -- ^ The graph
0dba5bbaaef2f620f3b83a16ab6b229c3dd50c98Christian Maeder -> EdgeId -- ^ ID of the edge
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo WiedemeyerisHiddenEdge gi eId =
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyer fmap (isNothing . udgEdge . get eId . edges) $ readIORef gi
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo Wiedemeyer-- | Checks if at least one hiddes edge exists
5044e8de9e6fde7a139a5e34324c92a4d08a6e73Thiemo WiedemeyerhasHiddenEdges :: GraphInfo -- ^ The graph
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian MaederhasHiddenEdges =
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer fmap (Map.fold (\ e b -> b || isNothing (udgEdge e)) False . edges)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer-- | Shows a hidden edge again
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanushowEdge :: GraphInfo -- ^ The graph
ddc662fdf0207eae2034d7b68ae5e2225c575207Thiemo Wiedemeyer -> EdgeId -- ^ ID of the edge
8f5219469b89a15dc6d4c2c30463775975f5841cRazvan PascanushowEdge gi eId = do
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu g <- readIORef gi
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder let es = edges g
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu edge = get eId es
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu case udgEdge edge of
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu Just _ -> return ()
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu Nothing -> case getEdgeAux g (ganFrom edge) (ganTo edge) (gaeType edge)
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu (const True) of
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer Just (nFrom, nTo, gaeT) -> do
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder edge' <- newArc (theGraph g) (udgEdgeType gaeT) (gaeValue edge)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer writeIORef gi g
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer { edges = Map.insert eId edge { udgEdge = Just edge' } es }
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer Nothing -> return ()
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer-- | Change the edge type of the given edge
966a6c024c828387023fccb0cd0049f78687e5dcThiemo WiedemeyerchangeEdgeType :: GraphInfo -- ^ The graph
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu -> EdgeId -- ^ ID of the edge
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer -> DGEdgeType -- ^ ID of the edgetype
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo WiedemeyerchangeEdgeType gi eId eType = do
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer g <- readIORef gi
966a6c024c828387023fccb0cd0049f78687e5dcThiemo Wiedemeyer let es = edges g
966a6c024c828387023fccb0cd0049f78687e5dcThiemo Wiedemeyer edge = get eId es
79d103748927615310322af6f7806c7cef11a802Christian Maeder unless (eType == gaeType edge) $ case udgEdge edge of
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer Nothing -> writeIORef gi g
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer { edges = Map.insert eId edge { gaeType = eType } es }
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder Just edge' ->
b6a59f004903ac7bc96323ee3ef09c01fd221157Christian Maeder case getEdgeAux g (ganFrom edge) (ganTo edge) eType (const True) of
b6a59f004903ac7bc96323ee3ef09c01fd221157Christian Maeder Just (nFrom, nTo, gaeT) -> do
b6a59f004903ac7bc96323ee3ef09c01fd221157Christian Maeder deleteArc (theGraph g) edge'
a4e6fb26100f53e3b1e9f5b97c2e0a0c129294e5Christian Maeder e <- newArc (theGraph g) (udgEdgeType gaeT) (gaeValue edge)
8f5219469b89a15dc6d4c2c30463775975f5841cRazvan Pascanu writeIORef gi g { edges = Map.insert eId edge
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder { udgEdge = Just e
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu , gaeType = eType } es }
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder Nothing -> return () -- ignore error
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan Pascanu-- * direct manipulation of uDrawGraph
966a6c024c828387023fccb0cd0049f78687e5dcThiemo Wiedemeyer-- | execute in the context of the given graph
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo WiedemeyerdoInGraphContext :: DVT.DaVinciCmd -> GraphInfo -> IO ()
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo WiedemeyerdoInGraphContext cmd gi = do
1ac36418f204bbe56f4cd951a979180721758999Christian Maeder g <- readIORef gi
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer let Graph dg = theGraph g
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer synchronize (pendingChangesLock dg) $ doInContext cmd
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer $ getDaVinciGraphContext dg
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo Wiedemeyer-- | Improve the layout of a graph like calling \"Layout->Improve All\"
1ac36418f204bbe56f4cd951a979180721758999Christian MaederlayoutImproveAll :: GraphInfo -- ^ The graph
c40b7badd217089d8a256dabdf8f7d4e219ca215Thiemo WiedemeyerlayoutImproveAll = doInGraphContext (DVT.Menu $ DVT.Layout $ DVT.ImproveAll)
66fd8f017efdb8a6c862c3f1856dfaef90865dd5Thiemo Wiedemeyer-- | Display a message in a uDrawGraph window controlled by AbstractGraphView
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyershowTemporaryMessage :: GraphInfo -- ^ The graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer -> String -- ^ message to be displayed
38122cbf09ad3dcc31a826cc4093f630515a5cfcChristian MaedershowTemporaryMessage gi message =
38122cbf09ad3dcc31a826cc4093f630515a5cfcChristian Maeder doInGraphContext (DVT.Window $ DVT.ShowMessage message) gi
38122cbf09ad3dcc31a826cc4093f630515a5cfcChristian Maeder-- | Deactivate the input of all uDrawGraph windows;
521045d36343cd17dd217a81d4b9422ad6ab6a07Christian Maeder-- Warning: every deactivate event must be paired an activate event
521045d36343cd17dd217a81d4b9422ad6ab6a07Christian MaederdeactivateGraphWindow :: GraphInfo -- ^ The graph
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo WiedemeyerdeactivateGraphWindow = doInGraphContext (DVT.Window DVT.Deactivate)
53e76316f409f6b1b57ed3d2e5cb9cfe1cb511e5Thiemo Wiedemeyer-- | Activate the input of a uDrawGraph display
71654489020a03cf6ce9f2947f3da26a996f9c32Razvan PascanuactivateGraphWindow :: GraphInfo -- ^ The graph
1ac36418f204bbe56f4cd951a979180721758999Christian MaederactivateGraphWindow = doInGraphContext (DVT.Window DVT.Activate)