mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Use bezier curves for edges.
This commit is contained in:
parent
334369afac
commit
a250b479a5
94
app/Icons.hs
94
app/Icons.hs
@ -3,10 +3,10 @@ module Icons
|
||||
(
|
||||
Icon(..),
|
||||
TransformableDia,
|
||||
portAngles,
|
||||
applyADia,
|
||||
flatLambda,
|
||||
iconToDiagram,
|
||||
nameDiagram,
|
||||
textBox,
|
||||
multilineComment,
|
||||
enclosure,
|
||||
@ -22,27 +22,31 @@ module Icons
|
||||
) where
|
||||
|
||||
import Diagrams.Prelude hiding ((&), (#))
|
||||
|
||||
import Data.List(find)
|
||||
import Data.Maybe(catMaybes, listToMaybe)
|
||||
import Data.Typeable(Typeable)
|
||||
|
||||
-- import Diagrams.Backend.SVG(B)
|
||||
--import Diagrams.TwoD.Text(Text)
|
||||
import Data.Typeable(Typeable)
|
||||
--import Data.Maybe(fromMaybe)
|
||||
|
||||
import Types(Icon(..), SpecialQDiagram, SpecialBackend)
|
||||
import DrawingColors(colorScheme, ColorStyle(..))
|
||||
|
||||
-- TYPES --
|
||||
type TransformableDia b = (Bool -> Double -> SpecialQDiagram b)
|
||||
-- TODO Consider changing the order to
|
||||
-- (Name -> Bool -> Double -> SpecialQDiagram b)
|
||||
type TransformableDia b = (Bool -> Double -> Name -> SpecialQDiagram b)
|
||||
|
||||
-- COLORS --
|
||||
lineCol :: Colour Double
|
||||
lineCol = lineC colorScheme
|
||||
|
||||
-- FUNCTIONS --
|
||||
-- Optimization: The apply0NDia's can be memoized.
|
||||
iconToDiagram :: SpecialBackend b => Icon -> TransformableDia b
|
||||
iconToDiagram (ApplyAIcon n) = identDiaFunc $ applyADia n
|
||||
iconToDiagram (PAppIcon n str) = pAppDia n str
|
||||
iconToDiagram (TextApplyAIcon n str) = textApplyADia n str
|
||||
iconToDiagram ResultIcon = identDiaFunc resultIcon
|
||||
iconToDiagram BranchIcon = identDiaFunc branchIcon
|
||||
iconToDiagram (TextBoxIcon s) = textBox s
|
||||
@ -54,9 +58,63 @@ iconToDiagram (FlatLambdaIcon n) = identDiaFunc $ flatLambda n
|
||||
iconToDiagram (NestedApply args) = nestedApplyDia args
|
||||
iconToDiagram (NestedPApp args) = nestedPAppDia args
|
||||
|
||||
applyPortAngles :: (Integral a, Floating n) => a -> [Angle n]
|
||||
applyPortAngles x = case x of
|
||||
0 -> [1/2 @@ turn]
|
||||
1 -> [0 @@ turn]
|
||||
_ -> fmap (@@ turn) [1/4, 3/4]
|
||||
|
||||
guardPortAngles :: (Integral a, Floating n) => a -> [Angle n]
|
||||
guardPortAngles port = case port of
|
||||
0 -> [1/4 @@ turn]
|
||||
1 -> [3/4 @@ turn]
|
||||
_ -> otherAngles where otherAngles
|
||||
| even port = [0 @@ turn]
|
||||
| otherwise = [1/2 @@ turn]
|
||||
|
||||
findNestedIcon :: Name -> Icon -> Maybe Icon
|
||||
findNestedIcon name icon = case icon of
|
||||
NestedApply args -> findIcon name args
|
||||
NestedPApp args -> findIcon name args
|
||||
_ -> Nothing
|
||||
|
||||
findIcon :: Name -> [Maybe (Name, Icon)] -> Maybe Icon
|
||||
findIcon name args = icon where
|
||||
filteredArgs = catMaybes args
|
||||
nameMatches (n, _) = n == name
|
||||
icon = case filteredArgs of
|
||||
[] -> Nothing
|
||||
_ -> case find nameMatches filteredArgs of
|
||||
Nothing -> listToMaybe $ catMaybes $ fmap (findNestedIcon name . snd) filteredArgs
|
||||
Just (_, finalIcon) -> Just finalIcon
|
||||
|
||||
nestedApplyPortAngles :: (Integral a, Floating n) => [Maybe (Name, Icon)] -> a -> Maybe Name -> [Angle n]
|
||||
nestedApplyPortAngles args port maybeName = case maybeName of
|
||||
Nothing -> applyPortAngles port
|
||||
Just name -> case findIcon name args of
|
||||
Nothing -> []
|
||||
Just icon -> portAngles icon port Nothing
|
||||
|
||||
portAngles :: (Integral a, Floating n) => Icon -> a -> Maybe Name -> [Angle n]
|
||||
portAngles icon port maybeName = case icon of
|
||||
ApplyAIcon _ -> applyPortAngles port
|
||||
PAppIcon _ _ -> applyPortAngles port
|
||||
ResultIcon -> []
|
||||
BranchIcon -> []
|
||||
TextBoxIcon _ -> []
|
||||
BindTextBoxIcon _ -> []
|
||||
GuardIcon _ -> guardPortAngles port
|
||||
CaseIcon _ -> guardPortAngles port
|
||||
CaseResultIcon -> []
|
||||
FlatLambdaIcon _ -> applyPortAngles port
|
||||
NestedApply args -> nestedApplyPortAngles args port maybeName
|
||||
NestedPApp args -> nestedApplyPortAngles args port maybeName
|
||||
|
||||
-- END FUNCTIONS --
|
||||
|
||||
-- Make an identity TransformableDia
|
||||
identDiaFunc :: SpecialQDiagram b -> TransformableDia b
|
||||
identDiaFunc dia _ _ = dia
|
||||
identDiaFunc dia _ _ name = nameDiagram name dia
|
||||
|
||||
-- | Names the diagram and puts all sub-names in the namespace of the top level name.
|
||||
nameDiagram :: IsName nm => nm -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
@ -122,13 +180,13 @@ reduceAngleRange :: Double -> Double
|
||||
reduceAngleRange x = x - fromInteger (floor x)
|
||||
|
||||
generalTextAppDia :: SpecialBackend b =>
|
||||
Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> SpecialQDiagram b
|
||||
generalTextAppDia textCol borderCol numArgs str reflect angle = rotateDia where
|
||||
Colour Double -> Colour Double -> Int -> String -> TransformableDia b
|
||||
generalTextAppDia textCol borderCol numArgs str reflect angle name = nameDiagram name rotateDia where
|
||||
rotateDia = transformCorrectedTextBox str textCol borderCol reflect angle |||
|
||||
coloredApplyADia borderCol numArgs
|
||||
|
||||
transformCorrectedTextBox :: SpecialBackend b =>
|
||||
String -> Colour Double -> Colour Double -> TransformableDia b
|
||||
String -> Colour Double -> Colour Double -> Bool -> Double -> SpecialQDiagram b
|
||||
transformCorrectedTextBox str textCol borderCol reflect angle =
|
||||
rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str))
|
||||
where
|
||||
@ -146,10 +204,11 @@ nestedPAppDia = generalNestedDia (patternC colorScheme)
|
||||
|
||||
generalNestedDia :: SpecialBackend b =>
|
||||
Colour Double -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
generalNestedDia borderCol funcNameAndArgs reflect angle = case funcNameAndArgs of
|
||||
generalNestedDia borderCol funcNameAndArgs reflect angle name = named name $ case funcNameAndArgs of
|
||||
[] -> mempty
|
||||
(maybeFunText:args) -> centerXY $ transformedText ||| centerY finalDia
|
||||
where
|
||||
makeQualifiedPort x = name .>> makePort x
|
||||
transformedText = case maybeFunText of
|
||||
Just _ -> makeInnerIcon 0 maybeFunText
|
||||
Nothing -> mempty
|
||||
@ -158,15 +217,15 @@ generalNestedDia borderCol funcNameAndArgs reflect angle = case funcNameAndArgs
|
||||
trianglePortsCircle = hsep seperation $
|
||||
reflectX (fc borderCol apply0Triangle) :
|
||||
zipWith makeInnerIcon [2,3..] args ++
|
||||
[makePort 1 <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)]
|
||||
[makeQualifiedPort 1 <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)]
|
||||
|
||||
allPorts = makePort 0 <> alignL trianglePortsCircle
|
||||
allPorts = makeQualifiedPort 0 <> alignL trianglePortsCircle
|
||||
topAndBottomLineWidth = width allPorts - circleRadius
|
||||
argBox = alignL $ lwG defaultLineWidth $ lc borderCol $ rect topAndBottomLineWidth (height allPorts + verticalSeperation)
|
||||
finalDia = argBox <> allPorts
|
||||
|
||||
makeInnerIcon portNum Nothing = makePort portNum <> portCircle
|
||||
makeInnerIcon _ (Just (iconName, icon)) = nameDiagram iconName $ iconToDiagram icon reflect angle
|
||||
makeInnerIcon portNum Nothing = makeQualifiedPort portNum <> portCircle
|
||||
makeInnerIcon _ (Just (iconName, icon)) = iconToDiagram icon reflect angle iconName
|
||||
|
||||
|
||||
-- TEXT ICON --
|
||||
@ -179,7 +238,7 @@ textBoxHeightFactor = 1.1
|
||||
|
||||
textBox :: SpecialBackend b =>
|
||||
String -> TransformableDia b
|
||||
textBox t = transformCorrectedTextBox t (textBoxTextC colorScheme) $ textBoxC colorScheme
|
||||
textBox t reflect rotate name = nameDiagram name $ transformCorrectedTextBox t (textBoxTextC colorScheme) (textBoxC colorScheme) reflect rotate
|
||||
|
||||
bindTextBox :: SpecialBackend b =>
|
||||
String -> SpecialQDiagram b
|
||||
@ -268,6 +327,11 @@ guardLBracket x = alignL (alignT ell) <> makePort x
|
||||
ellShape = fromOffsets $ map r2 [(0, guardSize), (-guardSize,0)]
|
||||
ell = lineJoin LineJoinRound $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape)
|
||||
|
||||
-- | generalGuardIcon port layout:
|
||||
-- 0 -> top
|
||||
-- 1 -> bottom
|
||||
-- odds -> left
|
||||
-- evens -> right
|
||||
generalGuardIcon :: SpecialBackend b =>
|
||||
Colour Double -> (Int -> SpecialQDiagram b) -> SpecialQDiagram b -> Int -> SpecialQDiagram b
|
||||
generalGuardIcon triangleColor lBracket bottomDia n = centerXY $ alignT (bottomDia <> makePort 1) <> alignB (bigVerticalLine <> guardDia <> makePort 0)
|
||||
|
117
app/Rendering.hs
117
app/Rendering.hs
@ -28,7 +28,7 @@ import Data.Typeable(Typeable)
|
||||
--import qualified Debug.Trace
|
||||
--import Data.Word(Word16)
|
||||
|
||||
import Icons(colorScheme, iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..), TransformableDia)
|
||||
import Icons(colorScheme, iconToDiagram, defaultLineWidth, ColorStyle(..), portAngles)
|
||||
import TranslateCore(nodeToIcon)
|
||||
import Types(Edge(..), Icon, EdgeOption(..), Connection, Drawing(..), EdgeEnd(..),
|
||||
NameAndPort(..), SpecialQDiagram, SpecialBackend, SyntaxNode)
|
||||
@ -92,8 +92,8 @@ bezierShaft angle1 angle2 = fromSegments [bezier3 c1 c2 x] where
|
||||
c1 = rotate angle1 (scale scaleFactor unitX)
|
||||
c2 = rotate angle2 (scale scaleFactor unitX) ^+^ x
|
||||
|
||||
getArrowOpts :: (RealFloat n, Typeable n) => (EdgeEnd, EdgeEnd) -> [EdgeOption]-> ArrowOpts n
|
||||
getArrowOpts (t, h) opts = arrowOptions
|
||||
getArrowOpts :: (RealFloat n, Typeable n) => (EdgeEnd, EdgeEnd) -> [EdgeOption] -> (Angle n, Angle n) -> ArrowOpts n
|
||||
getArrowOpts (t, h) opts (fromAngle, toAngle) = arrowOptions
|
||||
where
|
||||
shaftColor = if EdgeInPattern `elem` opts then patternC else lineC
|
||||
ap1ArgTexture = solid (backgroundC colorScheme)
|
||||
@ -113,30 +113,72 @@ getArrowOpts (t, h) opts = arrowOptions
|
||||
arrowOptions =
|
||||
arrowHead .~ noHead $
|
||||
arrowTail .~ noTail $
|
||||
arrowShaft .~ bezierShaft fromAngle toAngle $
|
||||
lengths .~ global 0.75 $
|
||||
shaftStyle %~ (lwG defaultLineWidth . lc (shaftColor colorScheme)) $
|
||||
shaftStyle %~ (lwG defaultLineWidth . lcA (withOpacity (shaftColor colorScheme) 0.7)) $
|
||||
lookupHead h $ lookupTail t with
|
||||
|
||||
-- | Given an Edge, return a transformation on Diagrams that will draw a line.
|
||||
connectMaybePorts :: SpecialBackend b =>
|
||||
Edge -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
connectMaybePorts (Edge opts ends (NameAndPort icon0 (Just port0), NameAndPort icon1 (Just port1))) =
|
||||
connect'
|
||||
(getArrowOpts ends opts)
|
||||
(icon0 .> port0)
|
||||
(icon1 .> port1)
|
||||
connectMaybePorts (Edge opts ends (NameAndPort icon0 Nothing, NameAndPort icon1 (Just port1))) =
|
||||
connectOutside' (getArrowOpts ends opts) icon0 (icon1 .> port1)
|
||||
connectMaybePorts (Edge opts ends (NameAndPort icon0 (Just port0), NameAndPort icon1 Nothing)) =
|
||||
connectOutside' (getArrowOpts ends opts) (icon0 .> port0) icon1
|
||||
connectMaybePorts (Edge opts ends (NameAndPort icon0 Nothing, NameAndPort icon1 Nothing)) =
|
||||
connectOutside' (getArrowOpts ends opts) icon0 icon1
|
||||
--connectMaybePorts :: SpecialBackend b =>
|
||||
-- a -> Edge -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
connectMaybePorts :: (Floating n, SpecialBackend b) =>
|
||||
(Angle Double, Angle Double)-> Edge -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
connectMaybePorts portAngles (Edge opts ends (NameAndPort name0 mPort1, NameAndPort name1 mPort2)) =
|
||||
connectFunc (getArrowOpts ends opts portAngles) qPort0 qPort1 where
|
||||
(connectFunc, qPort0, qPort1) = case (mPort1, mPort2) of
|
||||
(Just port0, Just port1) -> (connect', name0 .> port0, name1 .> port1)
|
||||
(Nothing, Just port1) -> (connectOutside', name0, name1 .> port1)
|
||||
(Just port0, Nothing) -> (connectOutside', name0 .> port0, name1)
|
||||
(_, _) -> (connectOutside', name0, name1)
|
||||
|
||||
makeConnections :: SpecialBackend b =>
|
||||
[Edge] -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
makeConnections edges = applyAll connections
|
||||
-- START addEdges --
|
||||
nameAndPortToName (NameAndPort name mPort) = case mPort of
|
||||
Nothing -> name
|
||||
Just port -> name .> port
|
||||
|
||||
findPortAngles :: Floating n => (Name, Icon) -> NameAndPort -> [Angle n]
|
||||
findPortAngles (nodeName, nodeIcon) (NameAndPort diaName mPort) = case mPort of
|
||||
Nothing -> []
|
||||
Just port -> foundAngles where
|
||||
mName = if nodeName == diaName then Nothing else Just diaName
|
||||
foundAngles = portAngles nodeIcon port mName
|
||||
|
||||
makeEdge :: (SpecialBackend b, ING.Graph gr) =>
|
||||
gr (Name, Icon) Edge -> SpecialQDiagram b -> ING.LEdge Edge -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
makeEdge graph dia (node0, node1, edge@(Edge _ _ (namePort0, namePort1))) =
|
||||
connectMaybePorts portAngles edge
|
||||
where
|
||||
connections = map connectMaybePorts edges
|
||||
node0label = fromMaybeError ("node0 is not in graph. node0: " ++ show node0) $
|
||||
ING.lab graph node0
|
||||
node1label = fromMaybeError ("node0 is not in graph. node1: " ++ show node1) $
|
||||
ING.lab graph node1
|
||||
icon0Angle = case findPortAngles node0label namePort0 of
|
||||
[] -> 0 @@ turn
|
||||
(x:_) -> ((x ^. turn) - (shaftAngle ^. turn)) @@ turn
|
||||
icon1Angle = case findPortAngles node1label namePort1 of
|
||||
[] -> 1/2 @@ turn
|
||||
(x:_) -> ((x ^. turn) - (shaftAngle ^. turn)) @@ turn
|
||||
|
||||
diaNamePointMap = names dia
|
||||
port0Point = getPortPoint $ nameAndPortToName namePort0
|
||||
port1Point = getPortPoint $ nameAndPortToName namePort1
|
||||
shaftVector = port1Point .-. port0Point
|
||||
shaftAngle = signedAngleBetween shaftVector unitX
|
||||
--fromAngle = icon0Angle - shaftAngle
|
||||
--toAngle = icon1Angle - shaftAngle
|
||||
|
||||
getPortPoint n = head $ fromMaybeError
|
||||
("makeEdge: port not found. Port: " ++ show n ++ ". Valid ports: " ++ show diaNamePointMap)
|
||||
(lookup n diaNamePointMap)
|
||||
|
||||
portAngles = (icon0Angle, icon1Angle)
|
||||
|
||||
|
||||
addEdges :: (SpecialBackend b, ING.Graph gr) =>
|
||||
gr (Name, Icon) Edge -> SpecialQDiagram b -> SpecialQDiagram b
|
||||
addEdges graph dia = applyAll connections dia
|
||||
where
|
||||
connections = fmap (makeEdge graph dia) $ ING.labEdges graph
|
||||
|
||||
-- ROTATING/FLIPPING ICONS --
|
||||
|
||||
@ -198,14 +240,14 @@ rotateNodes :: SpecialBackend b =>
|
||||
rotateNodes positionMap edges = map rotateDiagram (Map.keys positionMap)
|
||||
where
|
||||
positionMapNameKeys = Map.mapKeys fst positionMap
|
||||
rotateDiagram key@(name, icon) = (key, nameDiagram name transformedDia)
|
||||
rotateDiagram key@(name, icon) = (key, transformedDia)
|
||||
where
|
||||
originalDia = iconToDiagram icon
|
||||
transformedDia = if flippedDist < unflippedDist
|
||||
then rotateBy flippedAngle . reflectX $ originalDia True flippedAngle
|
||||
else rotateBy unflippedAngle $ originalDia False unflippedAngle
|
||||
(unflippedAngle, unflippedDist) = minAngleForDia (originalDia False 0)
|
||||
(flippedAngle, flippedDist) = minAngleForDia (reflectX $ originalDia True 0)
|
||||
then rotateBy flippedAngle . reflectX $ originalDia True flippedAngle name
|
||||
else rotateBy unflippedAngle $ originalDia False unflippedAngle name
|
||||
(unflippedAngle, unflippedDist) = minAngleForDia (originalDia False 0 name)
|
||||
(flippedAngle, flippedDist) = minAngleForDia (reflectX $ originalDia True 0 name)
|
||||
--minAngleForDia :: QDiagram b V2 Double m -> (Double, Double)
|
||||
minAngleForDia dia = minAngle where
|
||||
--ports = Debug.Trace.trace ((show $ names dia) ++ "\n") $ names dia
|
||||
@ -235,14 +277,15 @@ type LayoutResult a b = Gr (GV.AttributeNode (Name, b)) (GV.AttributeNode a)
|
||||
|
||||
placeNodes :: SpecialBackend b =>
|
||||
LayoutResult a Icon
|
||||
-> [Connection]
|
||||
-> [Edge]
|
||||
-> SpecialQDiagram b
|
||||
placeNodes layoutResult edges = mconcat placedNodes
|
||||
where
|
||||
connections = fmap edgeConnection edges
|
||||
positionMap = fst $ getGraph layoutResult
|
||||
rotatedNameDiagramMap = rotateNodes positionMap edges
|
||||
placedNodes = map placeNode rotatedNameDiagramMap
|
||||
--placedNodes = map placeNode nameDiagramMap
|
||||
--rotatedNameDiagramMap = rotateNodes positionMap connections
|
||||
--placedNodes = map placeNode rotatedNameDiagramMap
|
||||
placedNodes = map placeNode $ (\key@(name, icon) -> (key, iconToDiagram icon False 0 name)) <$> Map.keys positionMap
|
||||
-- todo: Not sure if the diagrams should already be centered at this point.
|
||||
placeNode (name, diagram) = place (centerXY diagram) (graphvizScaleFactor *^ (positionMap Map.! name))
|
||||
|
||||
@ -265,15 +308,15 @@ customLayoutParams = GV.defaultParams{
|
||||
GV.fmtEdge = const [GV.arrowTo GV.noArrow]
|
||||
}
|
||||
|
||||
doGraphLayout :: forall b e.
|
||||
doGraphLayout :: forall b.
|
||||
SpecialBackend b =>
|
||||
Gr (Name, Icon) e
|
||||
-> [Connection]
|
||||
Gr (Name, Icon) Edge
|
||||
-> [Edge]
|
||||
-> IO (SpecialQDiagram b)
|
||||
doGraphLayout graph edges = do
|
||||
layoutResult <- layoutGraph' layoutParams GVA.Neato graph
|
||||
-- layoutResult <- layoutGraph' layoutParams GVA.Fdp graph
|
||||
return $ placeNodes layoutResult edges
|
||||
pure $ addEdges graph $ placeNodes layoutResult edges
|
||||
where
|
||||
layoutParams :: GV.GraphvizParams Int (Name,Icon) e () (Name,Icon)
|
||||
--layoutParams :: GV.GraphvizParams Int l el Int l
|
||||
@ -288,7 +331,7 @@ doGraphLayout graph edges = do
|
||||
where
|
||||
-- This type annotation (:: SpecialQDiagram b) requires Scoped Typed Variables, which only works if the function's
|
||||
-- type signiture has "forall b e."
|
||||
dia = iconToDiagram nodeIcon False 0 :: SpecialQDiagram b
|
||||
dia = iconToDiagram nodeIcon False 0 (toName ""):: SpecialQDiagram b
|
||||
|
||||
diaWidth = drawingToGraphvizScaleFactor * width dia
|
||||
diaHeight = drawingToGraphvizScaleFactor * height dia
|
||||
@ -310,6 +353,4 @@ renderIngSyntaxGraph = renderIconGraph . ING.nmap (Control.Arrow.second nodeToIc
|
||||
renderIconGraph :: SpecialBackend b => Gr (Name, Icon) Edge -> IO (SpecialQDiagram b)
|
||||
renderIconGraph iconGraph = diagramAction where
|
||||
edges = ING.edgeLabel <$> ING.labEdges iconGraph
|
||||
connections = fmap edgeConnection edges
|
||||
diagramAction = makeConnections edges <$>
|
||||
doGraphLayout iconGraph connections
|
||||
diagramAction = doGraphLayout iconGraph edges
|
||||
|
@ -31,7 +31,7 @@ import Control.Monad.State(State, state)
|
||||
-- subdrawing.
|
||||
data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
|
||||
| FlatLambdaIcon Int | ApplyAIcon Int
|
||||
| TextApplyAIcon Int String | PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| BindTextBoxIcon String
|
||||
-- TODO: NestedApply should have the type NestedApply (Maybe (Name, Icon)) [Maybe (Name, Icon)]
|
||||
| NestedApply [Maybe (Name, Icon)]
|
||||
|
@ -454,7 +454,7 @@ translateTests :: IO (Diagram B)
|
||||
translateTests = do
|
||||
drawings <- traverse translateStringToDrawing testDecls
|
||||
let
|
||||
textDrawings = fmap (\t -> alignL $ textBox t False 0) testDecls
|
||||
textDrawings = fmap (\t -> alignL $ textBox t False 0 (toName "")) testDecls
|
||||
vCattedDrawings = vsep 1 $ zipWith (===) (fmap alignL drawings) textDrawings
|
||||
pure vCattedDrawings
|
||||
|
||||
|
3
todo.txt
3
todo.txt
@ -9,6 +9,9 @@
|
||||
Fix the arrowheads being too big for SyntaxGraph darwings.
|
||||
|
||||
-- Visual todos:
|
||||
Pick the best port angle
|
||||
Fix the port angle of the function port of nested apply. It should be [1/4, 3/4], not [1/2]
|
||||
|
||||
-- Consider putting the function name in nested apply and pattern apply in a colored box.
|
||||
-- Make an icon font/library with labeled ports. E.g. the apply icon would have text labels "function", "result", "arg 0", "arg 1", etc.
|
||||
-- Fix rotation missing edges to nested diagrams.
|
||||
|
Loading…
Reference in New Issue
Block a user