Tell GraphViz to use round nodes.

This commit is contained in:
Robbie Gleichman 2016-01-19 15:52:56 -08:00
parent 0985291c80
commit e311a9b38f
2 changed files with 34 additions and 14 deletions

View File

@ -18,10 +18,10 @@ import Icons
import Rendering
-- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
-- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg")
-- todo: Rotate based on difference from ideal tangent angle, not line distance.
-- todo: layout and rotate considering external connections.
-- todo: add port to bottom of guard.
-- todo: give GraphViz square or circular icons such that rotation can not cause icons to inersect.
-- todo: use constants for icon name strings in Main
-- todo: figure out local vs. global icon positions
@ -78,7 +78,8 @@ superEdges =
iconToIcon "y" "lam0",
iconToIcon "z" "lam0",
iconToIcon "q" "lam0",
iconToIcon "A" "z"
iconToIcon "A" "z",
iconToPort ("lam0" .> "foo" .> "foo") "lam0" 0
]
superIcons = toNames [
@ -120,7 +121,7 @@ super3Edges =
d1Name = toName "d1"
super3Drawing = Drawing super3Icons super2Edges [(d1Name, super2Drawing)]
factIcons = toNames
fact0Icons = toNames
[
("g0", GuardIcon 2),
("one", TextBoxIcon "1"),
@ -136,7 +137,7 @@ factIcons = toNames
("res", ResultIcon)
]
factEdges = [
fact0Edges = [
iconToPort "eq0" "eq0Ap" 0,
portToPort "eq0Ap" 2 "g0" 1,
iconToPort "-1" "-1Ap" 0,
@ -152,7 +153,22 @@ factEdges = [
iconToPort "res" "g0" 0
]
factDrawing = Drawing factIcons factEdges []
fact0Drawing = Drawing fact0Icons fact0Edges []
fact0Name = toName "fac0"
factLam0Icons = toNames [
("lam0", LambdaRegionIcon 1 fact0Name),
("fac", TextBoxIcon "factorial")
]
factLam0Edges = [
iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0,
iconToPort "lam0" ("lam0" .> "recurAp") 0,
--portToPort "lam0" 0 ("lam0" .> "*Ap2") 3,
iconToIcon "lam0" "fac"
]
factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)]
-- This is left commented out for a future test of the manual connect functions.
-- connectNodes g =
@ -164,7 +180,7 @@ factDrawing = Drawing factIcons factEdges []
main1 :: IO ()
main1 = do
placedNodes <- renderDrawing factDrawing
placedNodes <- renderDrawing factLam0Drawing
mainWith (placedNodes # bgFrame 0.1 black)
main2 = mainWith (guardIcon 3 # bgFrame 0.1 black)

View File

@ -16,7 +16,6 @@ import Diagrams.Backend.SVG(B)
import Data.GraphViz
import qualified Data.GraphViz.Attributes.Complete as GVA
--import Data.GraphViz.Commands
import Data.Map((!))
import qualified Data.Map as Map
import Data.Maybe(fromMaybe, isJust)
import qualified Debug.Trace
@ -68,7 +67,7 @@ makeConnections edges = applyAll connections
connectedPorts :: [Edge] -> Name -> [(Int, Name, Maybe Int)]
connectedPorts edges name = map edgeToPort $ filter nameInEdge edges
where
nameInEdge (n1, p1, n2, p2) = (name == n1 && (isJust p1)) || (name == n2 && (isJust p2))
nameInEdge (n1, p1, n2, p2) = (name == n1 && isJust p1) || (name == n2 && isJust p2)
edgeToPort (n1, p1, n2, p2) =
if name == n1
then (fromMaybe (error "connectedPorts port is Nothing") p1, n2, p2)
@ -99,9 +98,9 @@ angleWithMinDist myLocation edges =
totalLength angle = (angle, totalLenghtOfLines angle myLocation edges)
-- constant
scaleFactor = 0.025
scaleFactor = 0.02
getFromMapAndScale posMap name = scaleFactor *^ (posMap ! name)
getFromMapAndScale posMap name = scaleFactor *^ (posMap Map.! name)
-- | rotateNodes rotates the nodes such that the distance of its connecting lines
-- are minimized.
@ -138,14 +137,18 @@ placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
placedNodes = map placeNode rotatedNameDiagramMap
--placedNodes = map placeNode nameDiagramMap
-- todo: Not sure if the diagrams should already be centered at this point.
placeNode (name, diagram) = place (diagram # centerXY) (scaleFactor *^ (positionMap ! name))
placeNode (name, diagram) = place (diagram # centerXY) (scaleFactor *^ (positionMap Map.! name))
doGraphLayout graph nameDiagramMap connectNodes edges = do
layoutResult <- layoutGraph' layoutParams Neato graph
return $ placeNodes layoutResult nameDiagramMap edges # connectNodes
where
layoutParams :: GraphvizParams Int v e () v
layoutParams = defaultDiaParams{
layoutParams = defaultParams{
globalAttributes =
[ NodeAttrs [shape Circle]
, GraphAttrs [GVA.Overlap GVA.ScaleXYOverlaps]
],
fmtEdge = const [arrowTo noArrow],
fmtNode = nodeAttribute
}
@ -153,9 +156,10 @@ doGraphLayout graph nameDiagramMap connectNodes edges = do
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)]
[GVA.Width shapeDimensions, GVA.Height shapeDimensions]
where
--todo: Hack!!! Using (!!) here relies upon the implementation of Diagrams.TwoD.GraphViz.mkGraph
shapeDimensions = max (width dia) (height dia)
--todo: Hack! Using (!!) here relies upon the implementation of Diagrams.TwoD.GraphViz.mkGraph
-- to name the nodes in order
(_, dia) = nameDiagramMap !! nodeInt