mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Give graphviz the width and height of the nodes.
This commit is contained in:
parent
a8d801e690
commit
954e7c5829
@ -114,7 +114,7 @@ super3Edges =
|
|||||||
iconToIcon "lam0" "A"
|
iconToIcon "lam0" "A"
|
||||||
]
|
]
|
||||||
d1Name = toName "d1"
|
d1Name = toName "d1"
|
||||||
super3Drawing = Drawing super3Icons super3Edges [(d1Name, super2Drawing)]
|
super3Drawing = Drawing super3Icons super2Edges [(d1Name, super2Drawing)]
|
||||||
|
|
||||||
-- This is left commented out for a future test of the manual connect functions.
|
-- This is left commented out for a future test of the manual connect functions.
|
||||||
-- connectNodes g =
|
-- connectNodes g =
|
||||||
@ -126,7 +126,7 @@ super3Drawing = Drawing super3Icons super3Edges [(d1Name, super2Drawing)]
|
|||||||
|
|
||||||
main1 :: IO ()
|
main1 :: IO ()
|
||||||
main1 = do
|
main1 = do
|
||||||
placedNodes <- renderDrawing superDrawing (0.7 :: Double)
|
placedNodes <- renderDrawing super2Drawing
|
||||||
mainWith (placedNodes # bgFrame 0.1 black)
|
mainWith (placedNodes # bgFrame 0.1 black)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
@ -14,7 +14,7 @@ import Diagrams.TwoD.GraphViz
|
|||||||
import Diagrams.Backend.SVG(B)
|
import Diagrams.Backend.SVG(B)
|
||||||
|
|
||||||
import Data.GraphViz
|
import Data.GraphViz
|
||||||
--import qualified Data.GraphViz.Attributes.Complete as GVA
|
import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||||
--import Data.GraphViz.Commands
|
--import Data.GraphViz.Commands
|
||||||
import Data.Map((!))
|
import Data.Map((!))
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
@ -60,23 +60,40 @@ makeConnections edges = applyAll connections
|
|||||||
where
|
where
|
||||||
connections = map (uncurry4 connectMaybePorts) edges
|
connections = map (uncurry4 connectMaybePorts) edges
|
||||||
|
|
||||||
placeNodes scaleFactor layoutResult nameDiagramMap = mconcat placedNodes
|
placeNodes layoutResult nameDiagramMap = mconcat placedNodes
|
||||||
where
|
where
|
||||||
(positionMap, _) = getGraph layoutResult
|
(positionMap, _) = getGraph layoutResult
|
||||||
placedNodes = map placeNode nameDiagramMap
|
placedNodes = map placeNode nameDiagramMap
|
||||||
placeNode (name, diagram) = place diagram (scaleFactor *^ (positionMap ! name))
|
placeNode (name, diagram) = place diagram (scaleFactor *^ (positionMap ! name))
|
||||||
|
-- constant
|
||||||
|
scaleFactor = 0.017
|
||||||
|
|
||||||
doGraphLayout scaleFactor graph nameDiagramMap connectNodes = do
|
doGraphLayout graph nameDiagramMap connectNodes = do
|
||||||
layoutResult <- layoutGraph Neato graph
|
layoutResult <- layoutGraph' layoutParams Neato graph
|
||||||
return $ placeNodes scaleFactor layoutResult nameDiagramMap # connectNodes
|
return $ placeNodes layoutResult nameDiagramMap # connectNodes
|
||||||
|
where
|
||||||
|
layoutParams :: GraphvizParams Int v e () v
|
||||||
|
layoutParams = defaultDiaParams{
|
||||||
|
fmtEdge = const [arrowTo noArrow],
|
||||||
|
fmtNode = nodeAttribute
|
||||||
|
}
|
||||||
|
nodeAttribute :: (Int, l) -> [Data.GraphViz.Attribute]
|
||||||
|
nodeAttribute (nodeInt, _) =
|
||||||
|
-- todo: Potential bug. GVA.Width and GVA.Height have a minimum of 0.01
|
||||||
|
-- throw an error if the width or height are less than 0.01
|
||||||
|
[GVA.Shape BoxShape, GVA.Width (width dia), GVA.Height (height dia)]
|
||||||
|
where
|
||||||
|
--todo: Hack!!! Using (!!) here relies upon the implementation of Diagrams.TwoD.GraphViz.mkGraph
|
||||||
|
-- to name the nodes in order
|
||||||
|
(_, dia) = nameDiagramMap !! nodeInt
|
||||||
|
|
||||||
renderDrawing (Drawing nameIconMap edges subDrawings) scaleFactor = do
|
renderDrawing (Drawing nameIconMap edges subDrawings) = do
|
||||||
subDiagramMap <- mapM subDrawingMapper subDrawings
|
subDiagramMap <- mapM subDrawingMapper subDrawings
|
||||||
let diagramMap = makeNamedMap subDiagramMap nameIconMap
|
let diagramMap = makeNamedMap subDiagramMap nameIconMap
|
||||||
--mapM_ (putStrLn . (++"\n") . show . (map fst) . names . snd) diagramMap
|
--mapM_ (putStrLn . (++"\n") . show . (map fst) . names . snd) diagramMap
|
||||||
doGraphLayout scaleFactor (edgesToGraph iconNames edges) diagramMap (makeConnections edges)
|
doGraphLayout (edgesToGraph iconNames edges) diagramMap (makeConnections edges)
|
||||||
where
|
where
|
||||||
iconNames = map fst nameIconMap
|
iconNames = map fst nameIconMap
|
||||||
subDrawingMapper (name, subDrawing) = do
|
subDrawingMapper (name, subDrawing) = do
|
||||||
subDiagram <- renderDrawing subDrawing (0.2 * scaleFactor)
|
subDiagram <- renderDrawing subDrawing
|
||||||
return (name, subDiagram)
|
return (name, subDiagram)
|
||||||
|
Loading…
Reference in New Issue
Block a user