mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Rotate diagrams to minimize total line distance.
This commit is contained in:
parent
4de1e369b1
commit
97c84d27e5
@ -18,6 +18,7 @@ import Icons
|
|||||||
import Rendering
|
import Rendering
|
||||||
|
|
||||||
-- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
|
-- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
|
||||||
|
-- todo: Flip and rotate the icons after placement to minimize line distances to ports.
|
||||||
|
|
||||||
applyDia = apply0Dia
|
applyDia = apply0Dia
|
||||||
-- --apply0A = "A" .>> applyDia
|
-- --apply0A = "A" .>> applyDia
|
||||||
@ -137,11 +138,10 @@ factEdges = [
|
|||||||
iconToPort "one" "g0" 2,
|
iconToPort "one" "g0" 2,
|
||||||
portToPort "*Ap2" 2 "g0" 4,
|
portToPort "*Ap2" 2 "g0" 4,
|
||||||
portToPort "*Ap1" 2 "*Ap2" 0,
|
portToPort "*Ap1" 2 "*Ap2" 0,
|
||||||
portToPort "recurAp" 2 "*Ap1" 1,
|
portToPort "recurAp" 2 "*Ap1" 3,
|
||||||
iconToPort "arg" "eq0Ap" 1,
|
iconToPort "arg" "eq0Ap" 3,
|
||||||
iconToPort "arg" "-1Ap" 1,
|
iconToPort "arg" "-1Ap" 1,
|
||||||
iconToPort "arg" "*Ap2" 1
|
iconToPort "arg" "*Ap2" 1
|
||||||
|
|
||||||
]
|
]
|
||||||
|
|
||||||
factDrawing = Drawing factIcons factEdges []
|
factDrawing = Drawing factIcons factEdges []
|
||||||
|
@ -17,7 +17,11 @@ 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 qualified Data.Map as Map
|
||||||
|
import Data.Maybe(fromMaybe, isJust)
|
||||||
|
import qualified Debug.Trace
|
||||||
|
import Data.List(minimumBy)
|
||||||
|
import Data.Function(on)
|
||||||
|
|
||||||
import Icons
|
import Icons
|
||||||
|
|
||||||
@ -60,18 +64,72 @@ makeConnections edges = applyAll connections
|
|||||||
where
|
where
|
||||||
connections = map (uncurry4 connectMaybePorts) edges
|
connections = map (uncurry4 connectMaybePorts) edges
|
||||||
|
|
||||||
placeNodes layoutResult nameDiagramMap = mconcat placedNodes
|
-- | Returns [(myport, other node, other node's port)]
|
||||||
|
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))
|
||||||
|
edgeToPort (n1, p1, n2, p2) =
|
||||||
|
if name == n1
|
||||||
|
then (fromMaybe (error "connectedPorts port is Nothing") p1, n2, p2)
|
||||||
|
else (fromMaybe (error "connectedPorts port is Nothing") p2, n1, p1)
|
||||||
|
|
||||||
|
printSelf :: (Show a) => a -> a
|
||||||
|
printSelf a = Debug.Trace.trace (show a ++ "/n") a
|
||||||
|
|
||||||
|
totalLenghtOfLines :: Double -> P2 Double -> [(P2 Double, P2 Double)] -> Double
|
||||||
|
totalLenghtOfLines angle myLocation edges = sum $ map edgeDist edges
|
||||||
|
where
|
||||||
|
--edgeDist :: (P2 a, P2 a) -> Double
|
||||||
|
edgeDist (relativePortLocation, iconLocation) =
|
||||||
|
(norm $ absPortVec ^-^ iconLocationVec)
|
||||||
|
where
|
||||||
|
-- todo: is there a better way to convert from Points to vectors?
|
||||||
|
relPortVec = r2 $ unp2 relativePortLocation
|
||||||
|
iconLocationVec = r2 $ unp2 iconLocation
|
||||||
|
myLocVec = r2 $ unp2 myLocation
|
||||||
|
absPortVec = myLocVec ^+^ (rotateBy angle relPortVec)
|
||||||
|
|
||||||
|
angleWithMinDist :: P2 Double -> [(P2 Double, P2 Double)] -> Double
|
||||||
|
angleWithMinDist myLocation edges =
|
||||||
|
fst $ minimumBy (compare `on` snd) $ map totalLength [0,(1/40)..1]
|
||||||
|
where
|
||||||
|
totalLength angle = (angle, totalLenghtOfLines angle myLocation edges)
|
||||||
|
|
||||||
|
|
||||||
|
-- | rotateNodes rotates the nodes such that the distance of its connecting lines
|
||||||
|
-- are minimized.
|
||||||
|
-- Precondition: the diagrams are already centered
|
||||||
|
-- todo: confirm precondition (or use a newtype)
|
||||||
|
rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
|
||||||
|
where
|
||||||
|
rotateDiagram (name, dia) = (name, rotateBy minAngle dia)
|
||||||
|
where
|
||||||
|
--ports = Debug.Trace.trace ((show $ names dia) ++ "\n") $ names dia
|
||||||
|
ports = names dia
|
||||||
|
namesOfPortsWithLines = connectedPorts edges name
|
||||||
|
portEdges = map makePortEdge $ filter iconInMap namesOfPortsWithLines
|
||||||
|
iconInMap (_, otherIconName, _) = Map.member otherIconName positionMap
|
||||||
|
makePortEdge (portInt, otherIconName, _) = (getPortPoint portInt, positionMap ! otherIconName)
|
||||||
|
getPortPoint :: Int -> P2 Double
|
||||||
|
getPortPoint x = head $ fromMaybe
|
||||||
|
(error "port not found")
|
||||||
|
(lookup (name .> x) ports)
|
||||||
|
minAngle = angleWithMinDist (positionMap ! name) portEdges
|
||||||
|
|
||||||
|
placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
|
||||||
where
|
where
|
||||||
(positionMap, _) = getGraph layoutResult
|
(positionMap, _) = getGraph layoutResult
|
||||||
placedNodes = map placeNode nameDiagramMap
|
rotatedNameDiagramMap = rotateNodes positionMap nameDiagramMap edges
|
||||||
|
placedNodes = map placeNode rotatedNameDiagramMap
|
||||||
-- todo: Not sure if the diagrams should already be centered at this point.
|
-- 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 ! name))
|
||||||
-- constant
|
-- constant
|
||||||
scaleFactor = 0.025
|
scaleFactor = 0.025
|
||||||
|
|
||||||
doGraphLayout graph nameDiagramMap connectNodes = do
|
doGraphLayout graph nameDiagramMap connectNodes edges = do
|
||||||
layoutResult <- layoutGraph' layoutParams Neato graph
|
layoutResult <- layoutGraph' layoutParams Neato graph
|
||||||
return $ placeNodes layoutResult nameDiagramMap # connectNodes
|
return $ placeNodes layoutResult nameDiagramMap edges # connectNodes
|
||||||
where
|
where
|
||||||
layoutParams :: GraphvizParams Int v e () v
|
layoutParams :: GraphvizParams Int v e () v
|
||||||
layoutParams = defaultDiaParams{
|
layoutParams = defaultDiaParams{
|
||||||
@ -92,7 +150,7 @@ 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 (edgesToGraph iconNames edges) diagramMap (makeConnections edges)
|
doGraphLayout (edgesToGraph iconNames edges) diagramMap (makeConnections edges) edges
|
||||||
where
|
where
|
||||||
iconNames = map fst nameIconMap
|
iconNames = map fst nameIconMap
|
||||||
subDrawingMapper (name, subDrawing) = do
|
subDrawingMapper (name, subDrawing) = do
|
||||||
|
Loading…
Reference in New Issue
Block a user