diff --git a/app/Main.hs b/app/Main.hs index ae6ec76..c54f605 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -114,7 +114,7 @@ super3Edges = iconToIcon "lam0" "A" ] 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. -- connectNodes g = @@ -126,7 +126,7 @@ super3Drawing = Drawing super3Icons super3Edges [(d1Name, super2Drawing)] main1 :: IO () main1 = do - placedNodes <- renderDrawing superDrawing (0.7 :: Double) + placedNodes <- renderDrawing super2Drawing mainWith (placedNodes # bgFrame 0.1 black) main :: IO () diff --git a/app/Rendering.hs b/app/Rendering.hs index a4d2d58..830c8e1 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -14,7 +14,7 @@ import Diagrams.TwoD.GraphViz import Diagrams.Backend.SVG(B) 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.Map((!)) import Data.Maybe (fromMaybe) @@ -60,23 +60,40 @@ makeConnections edges = applyAll connections where connections = map (uncurry4 connectMaybePorts) edges -placeNodes scaleFactor layoutResult nameDiagramMap = mconcat placedNodes +placeNodes layoutResult nameDiagramMap = mconcat placedNodes where (positionMap, _) = getGraph layoutResult placedNodes = map placeNode nameDiagramMap placeNode (name, diagram) = place diagram (scaleFactor *^ (positionMap ! name)) + -- constant + scaleFactor = 0.017 -doGraphLayout scaleFactor graph nameDiagramMap connectNodes = do - layoutResult <- layoutGraph Neato graph - return $ placeNodes scaleFactor layoutResult nameDiagramMap # connectNodes +doGraphLayout graph nameDiagramMap connectNodes = do + layoutResult <- layoutGraph' layoutParams Neato graph + 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 let diagramMap = makeNamedMap subDiagramMap nameIconMap --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 iconNames = map fst nameIconMap subDrawingMapper (name, subDrawing) = do - subDiagram <- renderDrawing subDrawing (0.2 * scaleFactor) + subDiagram <- renderDrawing subDrawing return (name, subDiagram)