From 6f18d5f96d82b33c646fa666438d988632a11d89 Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Fri, 2 Nov 2018 01:52:26 -0700 Subject: [PATCH] Extract the TransformableDia parameters to TransformParams. --- app/Icons.hs | 319 ++++++++++++++++++++++++++--------- app/Rendering.hs | 10 +- notes.txt | 2 +- test/VisualTranslateTests.hs | 17 +- 4 files changed, 257 insertions(+), 91 deletions(-) diff --git a/app/Icons.hs b/app/Icons.hs index a0d2d20..9c824f5 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -3,6 +3,7 @@ module Icons ( Icon(..), + TransformParams(..), TransformableDia, getPortAngles, iconToDiagram, @@ -36,10 +37,19 @@ import DrawingColors(colorScheme, ColorStyle(..)) {-# ANN module "HLint: ignore Use record patterns" #-} -- TYPES -- --- | A TransformableDia is a function that returns a diagram for an icon when given --- the icon's name, its nesting depth, whether it will be reflected, and by what --- angle it will be rotated. -type TransformableDia b n = NodeName -> Int -> Bool -> Angle n -> SpecialQDiagram b n + +data TransformParams n = TransformParams { + tpName :: NodeName -- The icon's name + , tpNestingDepth :: Int -- The icon's nesting depth + , tpIsReflected :: Bool -- If the icon will be reflected + , tpAngle :: Angle n -- By what angle will the icon be rotated + } + +-- | A TransformableDia is a function that returns a diagram for an icon when +-- given the icon's name, its nesting depth, whether it will be reflected, and +-- by what angle it will be rotated. +type TransformableDia b n = TransformParams n -> SpecialQDiagram b n + -- CONSTANTS -- defaultLineWidth :: (Fractional a) => a @@ -61,7 +71,8 @@ iconToDiagram icon = case icon of nestedApplyDia ApplyNodeFlavor Nothing $ replicate (1 + n) Nothing ComposeIcon n -> nestedApplyDia ComposeNodeFlavor Nothing $ replicate (1 + n) Nothing - PAppIcon n str -> generalTextAppDia (patternTextC colorScheme) (patternC colorScheme) n str + PAppIcon n str -> + generalTextAppDia (patternTextC colorScheme) (patternC colorScheme) n str TextBoxIcon s -> textBox s BindTextBoxIcon s -> identDiaFunc $ bindTextBox s GuardIcon n -> nestedGuardDia $ replicate (1 + (2 * n)) Nothing @@ -111,9 +122,10 @@ findIcon name args = icon where Nothing -> listToMaybe $ catMaybes $ fmap findSubSubIcon filteredArgs Just (argNum, NamedIcon _ finalIcon) -> Just (argNum, finalIcon) where - findSubSubIcon (argNum, NamedIcon _ subIcon) = case findNestedIcon name subIcon of - Nothing -> Nothing - Just x -> Just (argNum, x) + findSubSubIcon (argNum, NamedIcon _ subIcon) + = case findNestedIcon name subIcon of + Nothing -> Nothing + Just x -> Just (argNum, x) generalNestedPortAngles :: SpecialNum n => (Port -> [Angle n]) @@ -133,7 +145,11 @@ reflectXAngle x = reflectedAngle where reflectedAngle = (-) <$> halfTurn <*> normalizedAngle -- TODO reflect the angles for the right side sub-icons -nestedGuardPortAngles :: SpecialNum n => [Maybe NamedIcon] -> Port -> Maybe NodeName -> [Angle n] +nestedGuardPortAngles :: SpecialNum n => + [Maybe NamedIcon] + -> Port + -> Maybe NodeName + -> [Angle n] nestedGuardPortAngles args port maybeNodeName = case maybeNodeName of Nothing -> guardPortAngles port Just name -> case findIcon name args of @@ -223,14 +239,19 @@ argumentPorts n = case n of -- | Make an identity TransformableDia identDiaFunc :: SpecialNum n => SpecialQDiagram b n -> TransformableDia b n -identDiaFunc dia name _ _ _ = nameDiagram name dia +identDiaFunc dia transformParams = nameDiagram (tpName transformParams) dia --- | Names the diagram and puts all sub-names in the namespace of the top level name. -nameDiagram :: SpecialNum n => NodeName -> SpecialQDiagram b n -> SpecialQDiagram b n +-- | Names the diagram and puts all sub-names in the namespace of the top level +-- name. +nameDiagram :: SpecialNum n => + NodeName + -> SpecialQDiagram b n + -> SpecialQDiagram b n nameDiagram name dia = named name (name .>> dia) --- | Make an port with an integer name. Always use <> to add a ports (not === or |||) ---- since mempty has no size and will not be placed where you want it. +-- | Make an port with an integer name. Always use <> to add a ports +-- (not === or |||) since mempty has no size and will not be placed where you +-- want it. makePort :: SpecialNum n => Port -> SpecialQDiagram b n makePort x = named x mempty --makePort x = circle 0.2 # fc green # named x @@ -259,10 +280,12 @@ makeLabelledPort name reflect angle str portNum = case str of -- BEGIN Sub-diagrams -- apply0Triangle :: SpecialBackend b n => Colour Double -> SpecialQDiagram b n -apply0Triangle col = fc col $ lw none $ rotateBy (-1/12) $ eqTriangle (2 * circleRadius) +apply0Triangle col + = fc col $ lw none $ rotateBy (-1/12) $ eqTriangle (2 * circleRadius) composeSemiCircle :: SpecialBackend b n => Colour Double -> SpecialQDiagram b n -composeSemiCircle col = lc col $ lwG defaultLineWidth $ wedge circleRadius yDir halfTurn +composeSemiCircle col + = lc col $ lwG defaultLineWidth $ wedge circleRadius yDir halfTurn portCircle :: SpecialBackend b n => SpecialQDiagram b n portCircle = lw none $ fc lineCol $ circle (circleRadius * 0.5) @@ -285,51 +308,94 @@ coloredApplyADia :: Colour Double -> Int -> SpecialQDiagram b n coloredApplyADia appColor n = centerXY finalDia where trianglePortsCircle = hcat [ - reflectX (apply0Triangle appColor), - hcat $ take n $ map (\x -> makePort x <> portCircle <> strutX (circleRadius * 1.5)) argPortsConst, - makePort resultPortConst <> alignR (lc appColor $ lwG defaultLineWidth $ fc appColor $ circle circleRadius) + reflectX (apply0Triangle appColor) + , hcat $ take n + $ map + (\x -> makePort x <> portCircle <> strutX (circleRadius * 1.5)) + argPortsConst + , makePort resultPortConst + <> alignR + (lc appColor $ lwG defaultLineWidth $ fc appColor $ circle circleRadius) ] allPorts = makePort inputPortConst <> alignL trianglePortsCircle topAndBottomLineWidth = width allPorts - circleRadius - topAndBottomLine = alignL $ lwG defaultLineWidth $ lc appColor $ hrule topAndBottomLineWidth + topAndBottomLine + = alignL $ lwG defaultLineWidth $ lc appColor $ hrule topAndBottomLineWidth finalDia = topAndBottomLine === allPorts === topAndBottomLine generalTextAppDia :: SpecialBackend b n => Colour Double -> Colour Double -> Int -> String -> TransformableDia b n -generalTextAppDia textCol borderCol numArgs str name _ reflect angle = nameDiagram name rotateDia where - rotateDia = transformCorrectedTextBox str textCol borderCol reflect angle ||| - coloredApplyADia borderCol numArgs +generalTextAppDia + textCol + borderCol + numArgs + str + (TransformParams name _ reflect angle) + = nameDiagram name rotateDia + where + rotateDia = + transformCorrectedTextBox str textCol borderCol reflect angle + ||| + coloredApplyADia borderCol numArgs -- TODO Refactor with generalNestedDia nestedPAppDia :: SpecialBackend b n => [Colour Double] -> [(Maybe NamedIcon, String)] -> TransformableDia b n -nestedPAppDia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of - [] -> mempty - (maybeFunText:args) -> centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort - where - borderCol = borderCols !! nestingLevel +nestedPAppDia + borderCols + funcNodeNameAndArgs + (TransformParams name nestingLevel reflect angle) + = named name $ + case funcNodeNameAndArgs of + [] -> mempty + (maybeFunText:args) -> + centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort + where + borderCol = borderCols !! nestingLevel - transformedText = case maybeFunText of - (Just _, _) -> makeInnerIcon True inputPortConst maybeFunText - (Nothing, _) -> mempty - separation = circleRadius * 1.5 - verticalSeparation = circleRadius - resultCircleAndPort = makeQualifiedPort name resultPortConst <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius) - triangleAndPorts = vsep separation $ - rotate quarterTurn (apply0Triangle borderCol) : - zipWith (makeInnerIcon False) argPortsConst args + transformedText = case maybeFunText of + (Just _, _) -> makeInnerIcon True inputPortConst maybeFunText + (Nothing, _) -> mempty + separation = circleRadius * 1.5 + verticalSeparation = circleRadius + resultCircleAndPort + = makeQualifiedPort name resultPortConst + <> alignR + (lc borderCol + $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius) + triangleAndPorts = vsep separation $ + rotate quarterTurn (apply0Triangle borderCol) : + zipWith (makeInnerIcon False) argPortsConst args - allPorts = makeQualifiedPort name inputPortConst <> alignT triangleAndPorts -- alignL (strutX separation ||| trianglePortsCircle) - topAndBottomLineWidth = width allPorts - -- boxHeight = height - argBox = alignT $ lwG defaultLineWidth $ lc borderCol $ roundedRect topAndBottomLineWidth (height allPorts + verticalSeparation) (circleRadius * 0.5) - finalDia = argBox <> allPorts + allPorts + = makeQualifiedPort name inputPortConst <> alignT triangleAndPorts + -- alignL (strutX separation ||| trianglePortsCircle) + topAndBottomLineWidth = width allPorts + -- boxHeight = height + argBox + = alignT $ lwG defaultLineWidth $ lc borderCol + $ roundedRect + topAndBottomLineWidth + (height allPorts + verticalSeparation) + (circleRadius * 0.5) + finalDia = argBox <> allPorts - 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 iconNodeName innerLevel reflect angle where - innerLevel = if func then nestingLevel else nestingLevel + 1 + 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 + (TransformParams iconNodeName innerLevel reflect angle) + where + innerLevel = if func then nestingLevel else nestingLevel + 1 generalNestedDia :: SpecialBackend b n => (Colour Double -> SpecialQDiagram b n) @@ -337,7 +403,13 @@ generalNestedDia :: SpecialBackend b n -> Maybe NamedIcon -> [Maybe NamedIcon] -> TransformableDia b n -generalNestedDia dia borderCols maybeFunText funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of +generalNestedDia + dia + borderCols + maybeFunText + funcNodeNameAndArgs + (TransformParams name nestingLevel reflect angle) + = named name $ case funcNodeNameAndArgs of [] -> mempty args -> centerXY $ transformedText ||| centerY finalDia where @@ -351,17 +423,38 @@ generalNestedDia dia borderCols maybeFunText funcNodeNameAndArgs name nestingLev trianglePortsCircle = hsep seperation $ reflectX (dia borderCol) : zipWith (makeInnerIcon False) argPortsConst args ++ - [makeQualifiedPort name resultPortConst <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)] + [makeQualifiedPort name resultPortConst + <> alignR + (lc borderCol $ lwG defaultLineWidth $ fc borderCol + $ circle circleRadius) + ] - allPorts = makeQualifiedPort name inputPortConst <> alignL trianglePortsCircle + allPorts + = makeQualifiedPort name inputPortConst <> alignL trianglePortsCircle topAndBottomLineWidth = width allPorts - circleRadius - argBox = alignL $ lwG defaultLineWidth $ lc borderCol $ roundedRect topAndBottomLineWidth (height allPorts + verticalSeperation) (circleRadius * 0.5) + argBox + = alignL $ lwG defaultLineWidth $ lc borderCol + $ roundedRect + topAndBottomLineWidth + (height allPorts + verticalSeperation) + (circleRadius * 0.5) finalDia = argBox <> allPorts - 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 iconNodeName innerLevel reflect angle where - innerLevel = if func then nestingLevel else nestingLevel + 1 + 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 + (TransformParams iconNodeName innerLevel reflect angle) + where + innerLevel = if func then nestingLevel else nestingLevel + 1 nestedApplyDia :: SpecialBackend b n => LikeApplyFlavor @@ -370,7 +463,8 @@ nestedApplyDia :: SpecialBackend b n -> TransformableDia b n nestedApplyDia flavor = case flavor of ApplyNodeFlavor -> generalNestedDia apply0Triangle (nestingC colorScheme) - ComposeNodeFlavor -> generalNestedDia composeSemiCircle (repeat $ apply1C colorScheme) + ComposeNodeFlavor -> + generalNestedDia composeSemiCircle (repeat $ apply1C colorScheme) -- END Apply like diagrams @@ -402,15 +496,19 @@ textFont = "monospace" rectForText :: (InSpace V2 n t, TrailLike t) => Int -> t rectForText n = rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) where - rectangleWidth = (fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction) - + (textBoxFontSize * 0.3) + rectangleWidth + = (fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction) + + (textBoxFontSize * 0.3) -- END Text helper functions commentTextArea :: SpecialBackend b n => Colour Double -> String -> SpecialQDiagram b n commentTextArea textColor t = - alignL $ fontSize (local textBoxFontSize) (font textFont $ fc textColor $ topLeftText t) + alignL + $ fontSize + (local textBoxFontSize) + (font textFont $ fc textColor $ topLeftText t) <> alignTL (lw none $ rectForText (length t)) multilineComment :: SpecialBackend b n => @@ -426,30 +524,53 @@ coloredTextBox :: SpecialBackend b n => Colour Double -> AlphaColour Double -> String -> SpecialQDiagram b n coloredTextBox textColor boxColor t = - fontSize (local textBoxFontSize) (bold $ font textFont $ fc textColor $ text t) - <> lwG (0.6 * defaultLineWidth) (lcA boxColor $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t)) + fontSize + (local textBoxFontSize) + (bold $ font textFont $ fc textColor $ text t) + <> lwG + (0.6 * defaultLineWidth) + (lcA boxColor + $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t)) transformCorrectedTextBox :: SpecialBackend b n => - String -> Colour Double -> Colour Double -> Bool -> Angle n -> SpecialQDiagram b n + String + -> Colour Double + -> Colour Double + -> Bool + -> Angle n + -> SpecialQDiagram b n transformCorrectedTextBox str textCol borderCol reflect angle = - rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) + rotateBy + textBoxRotation + (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) where - -- If normalizeAngle is slow, the commented out function reduceAngleRange might be faster + -- If normalizeAngle is slow, the commented out function reduceAngleRange + -- might be faster. reducedAngle = normalizeAngle angle ^. turn - textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0 - reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia + textBoxRotation + = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0 + reflectIfTrue shouldReflect dia + = if shouldReflect then reflectX dia else dia transformableBindTextBox :: SpecialBackend b n => String -> Bool -> Angle n -> SpecialQDiagram b n -transformableBindTextBox str = transformCorrectedTextBox str (bindTextBoxTextC colorScheme) (bindTextBoxC colorScheme) +transformableBindTextBox str + = transformCorrectedTextBox + str + (bindTextBoxTextC colorScheme) + (bindTextBoxC colorScheme) bindTextBox :: SpecialBackend b n => String -> SpecialQDiagram b n -bindTextBox = coloredTextBox (bindTextBoxTextC colorScheme) $ opaque (bindTextBoxC colorScheme) +bindTextBox + = coloredTextBox (bindTextBoxTextC colorScheme) + $ opaque (bindTextBoxC colorScheme) textBox :: SpecialBackend b n => String -> TransformableDia b n -textBox t name _ reflect angle = nameDiagram name $ transformCorrectedTextBox t (textBoxTextC colorScheme) (textBoxC colorScheme) reflect angle +textBox t (TransformParams name _ reflect angle) + = nameDiagram name $ transformCorrectedTextBox + t (textBoxTextC colorScheme) (textBoxC colorScheme) reflect angle -- END Text boxes and icons @@ -460,10 +581,14 @@ guardSize = 0.7 guardTriangle :: SpecialBackend b n => SpecialQDiagram b n -> SpecialQDiagram b n guardTriangle portDia = - alignL $ alignR (triangleAndPort ||| lwG defaultLineWidth (hrule (guardSize * 0.8))) <> portDia + alignL + $ alignR (triangleAndPort ||| lwG defaultLineWidth (hrule (guardSize * 0.8))) + <> portDia where triangleAndPort = alignR $ alignT $ lwG defaultLineWidth $ rotateBy (1/8) $ - polygon (polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize] $ with) + polygon + (polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize] + $ with) -- | generalNestedGuard port layout: -- 0 -> top @@ -476,7 +601,9 @@ generalNestedGuard :: SpecialBackend b n -> SpecialQDiagram b n -> [Maybe NamedIcon] -> TransformableDia b n -generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLevel reflect angle = named name $ case inputAndArgs of +generalNestedGuard triangleColor lBracket bottomDia inputAndArgs + (TransformParams name nestingLevel reflect angle) + = named name $ case inputAndArgs of [] -> mempty input : args -> centerXY finalDia where finalDia = alignT (bottomDia <> makeQualifiedPort name resultPortConst) @@ -491,19 +618,26 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev where port = makeQualifiedPort name (Port portNum) - (lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortsConst args + (lBrackets, trianglesWithPorts) + = partitionEithers $ zipWith iconMapper argPortsConst args trianglesAndBrackets = zipWith zipper trianglesWithPorts lBrackets - zipper thisTriangle lBrack = verticalLine === (alignR (extrudeRight guardSize lBrack) <> lc triangleColor (alignL thisTriangle)) + zipper thisTriangle lBrack + = verticalLine + === + (alignR (extrudeRight guardSize lBrack) + <> lc triangleColor (alignL thisTriangle)) where verticalLine = strutY 0.4 inputIcon = makeInnerIcon False input guardDia = vcat (alignT trianglesAndBrackets) - bigVerticalLine = alignT $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia) + bigVerticalLine + = alignT + $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia) makeInnerIcon innerReflected mNameAndIcon = case mNameAndIcon of Nothing -> mempty @@ -511,21 +645,29 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev then reflectX dia else dia where - dia = iconToDiagram icon iconNodeName nestingLevel (innerReflected /= reflect) angle + dia = iconToDiagram icon (TransformParams + iconNodeName + nestingLevel + (innerReflected /= reflect) + angle) guardLBracket :: SpecialBackend b n => SpecialQDiagram b n -> SpecialQDiagram b n guardLBracket portDia = alignL (alignT ell) <> portDia where ellShape = fromOffsets $ map r2 [(0, guardSize), (-guardSize, 0)] - ell = lineJoin LineJoinRound $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape) + ell + = lineJoin LineJoinRound + $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape) -- | The ports of the guard icon are as follows: -- inputPortConst: Top result port (not used) -- resultPortConst: Bottom result port -- Ports 3,5...: The left ports for the booleans -- Ports 2,4...: The right ports for the values -nestedGuardDia :: SpecialBackend b n => [Maybe NamedIcon] -> TransformableDia b n +nestedGuardDia :: SpecialBackend b n => + [Maybe NamedIcon] + -> TransformableDia b n nestedGuardDia = generalNestedGuard lineCol guardLBracket mempty -- TODO Improve design to be more than a circle. @@ -554,14 +696,27 @@ nestedCaseDia = generalNestedGuard (patternC colorScheme) caseC caseResult -- 1: The lambda function value -- 2,3.. : The parameters flatLambda :: SpecialBackend b n => [String] -> TransformableDia b n -flatLambda paramNames name _ reflect angle = named name finalDia where - lambdaCircle = lwG defaultLineWidth $ lc (regionPerimC colorScheme) $ fc (regionPerimC colorScheme) $ circle (1.5 * circleRadius) - lambdaParts = (makeQualifiedPort name inputPortConst <> resultIcon) : (portIcons ++ [makeQualifiedPort name resultPortConst <> alignR lambdaCircle]) +flatLambda paramNames (TransformParams name _ reflect angle) + = named name finalDia + where + lambdaCircle + = lwG defaultLineWidth + $ lc (regionPerimC colorScheme) + $ fc (regionPerimC colorScheme) $ circle (1.5 * circleRadius) + lambdaParts + = (makeQualifiedPort name inputPortConst <> resultIcon) + : + (portIcons + ++ [makeQualifiedPort name resultPortConst <> alignR lambdaCircle]) - portIcons = zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst + portIcons + = zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst middle = alignL (hsep 0.5 lambdaParts) topAndBottomLineWidth = width middle - circleRadius - topAndBottomLine = alignL $ lwG defaultLineWidth $ lc (regionPerimC colorScheme) $ hrule topAndBottomLineWidth + topAndBottomLine + = alignL + $ lwG defaultLineWidth + $ lc (regionPerimC colorScheme) $ hrule topAndBottomLineWidth finalDia = topAndBottomLine <> alignB (topAndBottomLine <> alignT middle) -- END Main icons diff --git a/app/Rendering.hs b/app/Rendering.hs index 11ddf3f..fd76e34 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -25,7 +25,8 @@ import Data.Typeable(Typeable) --import qualified Debug.Trace --import Data.Word(Word16) -import Icons(colorScheme, iconToDiagram, defaultLineWidth, ColorStyle(..), getPortAngles) +import Icons(colorScheme, iconToDiagram, defaultLineWidth, ColorStyle(..) + , getPortAngles, TransformParams(..)) import TranslateCore(nodeToIcon) import Types(Edge(..), Icon, EdgeOption(..), Drawing(..), EdgeEnd(..), NameAndPort(..), SpecialQDiagram, SpecialBackend, SpecialNum, NodeName(..), Port(..), @@ -293,7 +294,7 @@ placeNodes layoutResult graph = (mconcat placedNodes, rotationMap) -- todo: Not sure if the diagrams should already be centered at this point. placeNode (key@(NamedIcon name icon), (reflected, angle)) = place transformedDia diaPosition where - origDia = iconToDiagram icon name 0 reflected angle + origDia = iconToDiagram icon (TransformParams name 0 reflected angle) transformedDia = centerXY $ rotate angle $ (if reflected then reflectX else id) origDia diaPosition = graphvizScaleFactor *^ (positionMap Map.! key) @@ -338,7 +339,10 @@ doGraphLayout graph = do where -- This type annotation (:: SpecialQDiagram b n) requires Scoped Typed Variables, which only works if the function's -- type signiture has "forall b e." - dia = iconToDiagram nodeIcon (NodeName (-1)) 0 False mempty :: SpecialQDiagram b Double + dia :: SpecialQDiagram b Double + dia = iconToDiagram + nodeIcon + (TransformParams (NodeName (-1)) 0 False mempty) diaWidth = drawingToGraphvizScaleFactor * width dia diaHeight = drawingToGraphvizScaleFactor * height dia diff --git a/notes.txt b/notes.txt index 41f0ed6..60d414b 100644 --- a/notes.txt +++ b/notes.txt @@ -12,7 +12,7 @@ View circle.svg with svg-preview plug-in. To use ghci for the main executable: stack ghci glance -To use ghci with the test file: +To use ghci with the test modules: stack ghci glance:test:glance-test For all warnings (some warnings duplicated): diff --git a/test/VisualTranslateTests.hs b/test/VisualTranslateTests.hs index ed31e36..9a728ee 100644 --- a/test/VisualTranslateTests.hs +++ b/test/VisualTranslateTests.hs @@ -10,10 +10,11 @@ import qualified Data.Graph.Inductive.Graph as ING import Data.List(intercalate) import Types(SpecialQDiagram, SpecialBackend, NodeName(..)) -import Translate(translateStringToCollapsedGraphAndDecl, translateStringToSyntaxGraph) +import Translate(translateStringToCollapsedGraphAndDecl + , translateStringToSyntaxGraph) import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..)) import Rendering(renderIngSyntaxGraph) -import Icons(textBox) +import Icons(textBox, TransformParams(..)) prettyShowList :: Show a => [a] -> String @@ -202,7 +203,7 @@ letTests = [ -- TODO fix. See UnitTests/letTests "y = g $ f y", "y = let {a = f b; b = g a} in b", - + "y = let {a= 1; x = let {a = 27; x = f a 2} in x} in x", "y = let {a = b; b = a; d = f a} in d", "y = let {a = b; b = a} in a", @@ -255,7 +256,9 @@ testDecls = mconcat [ ] -translateStringToDrawing :: SpecialBackend b Double => String -> IO (SpecialQDiagram b Double) +translateStringToDrawing :: SpecialBackend b Double => + String + -> IO (SpecialQDiagram b Double) translateStringToDrawing s = do putStrLn $ "Translating string: " ++ s let @@ -280,6 +283,10 @@ visualTranslateTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double) visualTranslateTests = do drawings <- traverse translateStringToDrawing testDecls let - textDrawings = fmap (\t -> alignL $ textBox t (NodeName (-1)) 0 False mempty) testDecls + textDrawings + = fmap + (\t -> + alignL $ textBox t (TransformParams (NodeName (-1)) 0 False mempty)) + testDecls vCattedDrawings = vsep 1 $ zipWith (===) (fmap alignL drawings) textDrawings pure vCattedDrawings