diff --git a/app/Icons.hs b/app/Icons.hs index 9c824f5..2db3e82 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -349,7 +349,8 @@ nestedPAppDia case funcNodeNameAndArgs of [] -> mempty (maybeFunText:args) -> - centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort + centerXY + $ centerY finalDia ||| beside' unitX transformedText resultCircleAndPort where borderCol = borderCols !! nestingLevel @@ -367,7 +368,6 @@ nestedPAppDia rotate quarterTurn (apply0Triangle borderCol) : zipWith (makeInnerIcon False) argPortsConst args - allPorts = makeQualifiedPort name inputPortConst <> alignT triangleAndPorts -- alignL (strutX separation ||| trianglePortsCircle) @@ -383,13 +383,6 @@ nestedPAppDia makeInnerIcon _ portNum (Nothing, str) = centerX $ makeLabelledPort name reflect angle str portNum - makeInnerIcon True _ (Just (NamedIcon _ (TextBoxIcon t)), _) - = transformCorrectedTextBox - t - (textBoxTextC colorScheme) - borderCol - reflect - angle makeInnerIcon func _ (Just (NamedIcon iconNodeName icon), _) = iconToDiagram icon @@ -397,6 +390,10 @@ nestedPAppDia where innerLevel = if func then nestingLevel else nestingLevel + 1 +-- | Like beside, but it puts the second dia atop the first dia +beside' :: (Semigroup a, Juxtaposable a) => V a (N a) -> a -> a -> a +beside' dir dia1 dia2 = juxtapose dir dia1 dia2 <> dia1 + generalNestedDia :: SpecialBackend b n => (Colour Double -> SpecialQDiagram b n) -> [Colour Double] @@ -407,11 +404,9 @@ generalNestedDia dia borderCols maybeFunText - funcNodeNameAndArgs + args (TransformParams name nestingLevel reflect angle) - = named name $ case funcNodeNameAndArgs of - [] -> mempty - args -> centerXY $ transformedText ||| centerY finalDia + = named name $ centerXY $ beside' unitX transformedText finalDia where borderCol = borderCols !! nestingLevel @@ -442,13 +437,6 @@ generalNestedDia makeInnerIcon _ portNum Nothing = makeQualifiedPort name portNum <> portCircle - makeInnerIcon True _ (Just (NamedIcon _ (TextBoxIcon t))) - = transformCorrectedTextBox - t - (textBoxTextC colorScheme) - borderCol - reflect - angle makeInnerIcon func _ (Just (NamedIcon iconNodeName icon)) = iconToDiagram icon diff --git a/app/Rendering.hs b/app/Rendering.hs index fd76e34..334ae48 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -205,7 +205,7 @@ makeEdge graph dia rotationMap (node0, node1, edge@(Edge _ _ (namePort0, namePor getPortPoint n = head $ fromMaybeError ("makeEdge: port not found. Port: " ++ show n ++ ". Valid ports: " ++ show diaNodeNamePointMap) (lookup n diaNodeNamePointMap) - + portAngles = (icon0PortAngle, icon1PortAngle) -- | addEdges draws the edges underneath the nodes. @@ -246,10 +246,10 @@ bestAngleForIcon positionMap graph key@(NamedIcon (NodeName nodeId) _) reflected -- possibleAngles = [0, 1/2] -- (uncomment this line and comment out the line above to disable rotation) iconPosition = positionMap Map.! key edges = getPositionAndAngles <$> fmap getSucEdge (ING.lsuc graph nodeId) <> fmap getPreEdge (ING.lpre graph nodeId) - + getPositionAndAngles (node, nameAndPort) = (positionMap Map.! nodeLabel, portAngles) where nodeLabel = fromMaybeError "getPositionAndAngles: node not found" $ ING.lab graph node - portAngles = findPortAngles key nameAndPort + portAngles = findPortAngles key nameAndPort -- Edge points from id to otherNode getSucEdge (otherNode, edge) = (otherNode, nameAndPort) where @@ -347,7 +347,10 @@ doGraphLayout graph = do diaWidth = drawingToGraphvizScaleFactor * width dia diaHeight = drawingToGraphvizScaleFactor * height dia circleDiameter' = max diaWidth diaHeight - circleDiameter = if circleDiameter' <= 0.01 then error ("circleDiameter too small: " ++ show circleDiameter') else circleDiameter' + circleDiameter + = if circleDiameter' <= 0.01 + then error ("circleDiameter too small: " ++ show circleDiameter') + else circleDiameter' -- | Given a Drawing, produce a Diagram complete with rotated/flipped icons and -- lines connecting ports and icons. IO is needed for the GraphViz layout. diff --git a/test/VisualRenderingTests.hs b/test/VisualRenderingTests.hs index 5127e75..1756abe 100644 --- a/test/VisualRenderingTests.hs +++ b/test/VisualRenderingTests.hs @@ -126,6 +126,38 @@ flatGuardDrawing = Drawing icons edges where ] edges = [] +nestedPAppDia :: Drawing +nestedPAppDia = Drawing icons [] + where + icons = [ + NamedIcon (NodeName 1) (NestedPApp [(Nothing, "baz")]) + , NamedIcon + (NodeName 2) + (NestedPApp + [ (Nothing, "") + , (Just (NamedIcon (NodeName 1) (TextBoxIcon "foo")), "bar") + , (Nothing, "bar")]) + , NamedIcon + (NodeName 3) + (NestedPApp + [ + (Just (NamedIcon (NodeName 4) (TextBoxIcon "foo")), "bar") + , (Nothing, "bar")]) + ] + +nestedApplyDia :: Drawing +nestedApplyDia = Drawing icons [] + where + icons = [ + NamedIcon + (NodeName 1) + (NestedApply + ApplyNodeFlavor + (Just $ NamedIcon (NodeName 1) (TextBoxIcon "foo")) + []) + --[Just $ NamedIcon (NodeName 1) (TextBoxIcon "bar")]) + ] + --renderTests :: IO (Diagram B) renderTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double) renderTests = do @@ -139,6 +171,7 @@ renderTests = do nestedCaseDrawing, nestedGuardDrawing, flatCaseDrawing, - flatGuardDrawing - -- TODO Add a nested test where the function expression is nested. + flatGuardDrawing, + nestedPAppDia, + nestedApplyDia ]