mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 23:17:21 +03:00
Embed lambda nodes in apply parents.
This commit is contained in:
parent
96aaaa2319
commit
2d74cb2fd1
@ -41,13 +41,12 @@ syntaxNodeIsEmbeddable :: ParentType
|
||||
-> Maybe Port
|
||||
-> Maybe Port
|
||||
-> Bool
|
||||
syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort
|
||||
= case (parentType, n) of
|
||||
syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
|
||||
= case (parentType, syntaxNode) of
|
||||
(ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
|
||||
(ApplyParent, LiteralNode _) -> parentPortNotResult
|
||||
-- TODO Embedded FunctionDefNodes are missing their enclosures.
|
||||
-- (ApplyParent, FunctionDefNode _ _)
|
||||
-- -> isInput mParentPort && isResult mChildPort
|
||||
(ApplyParent, FunctionDefNode _ _)
|
||||
-> isInput mParentPort && isResult mChildPort
|
||||
|
||||
(CaseParent, LiteralNode _) -> parentPortNotResult
|
||||
(CaseParent, ApplyNode _ _ _)
|
||||
|
@ -6,6 +6,7 @@ module Rendering (
|
||||
renderIngSyntaxGraph
|
||||
) where
|
||||
|
||||
import qualified Diagrams.Prelude as DIA
|
||||
import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
|
||||
, arrowTail, arrowHead, scale, r2, bezier3
|
||||
, fromSegments, Angle, P2, V2, Point, Name, ArrowOpts, N
|
||||
@ -17,7 +18,6 @@ import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
|
||||
, connectOutside', connect', with, (%~), lengths, (^+^)
|
||||
, (.~))
|
||||
import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
|
||||
import qualified Diagrams.Prelude as DIA
|
||||
|
||||
import qualified Data.GraphViz as GV
|
||||
import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||
@ -27,7 +27,7 @@ import Data.Function(on)
|
||||
import qualified Data.Graph.Inductive as ING
|
||||
import Data.Graph.Inductive.PatriciaTree (Gr)
|
||||
import Data.List(find, minimumBy)
|
||||
import Data.Maybe(isNothing, fromMaybe)
|
||||
import Data.Maybe(catMaybes, isNothing, fromMaybe)
|
||||
import Data.Typeable(Typeable)
|
||||
|
||||
--import qualified Data.GraphViz.Types
|
||||
@ -353,20 +353,26 @@ rotateNodes positionMap graph
|
||||
|
||||
-- END rotateNodes --
|
||||
|
||||
drawLambdaRegions :: SpecialBackend b Double =>
|
||||
drawLambdaRegions :: forall b . SpecialBackend b Double =>
|
||||
[(NamedIcon, SpecialQDiagram b Double)]
|
||||
-> SpecialQDiagram b Double
|
||||
drawLambdaRegions placedNodes
|
||||
= mconcat $ fmap (drawRegion . niIcon . fst) placedNodes
|
||||
= mconcat $ fmap (drawRegion [] . fst) placedNodes
|
||||
where
|
||||
drawRegion (FlatLambdaIcon _ enclosedNames)
|
||||
= regionRect enclosedDias
|
||||
where
|
||||
enclosedDias = fmap findDia enclosedNames
|
||||
findDia n1
|
||||
= maybe mempty snd
|
||||
(find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes)
|
||||
drawRegion _ = mempty
|
||||
findDia :: NodeName -> SpecialQDiagram b Double
|
||||
findDia n1
|
||||
= maybe mempty snd
|
||||
(find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes)
|
||||
|
||||
-- Also draw the region around the icon the lambda is in.
|
||||
drawRegion :: [NodeName] -> NamedIcon -> SpecialQDiagram b Double
|
||||
drawRegion parentNames icon = case icon of
|
||||
NamedIcon _ (FlatLambdaIcon _ enclosedNames)
|
||||
-> regionRect $ fmap findDia (parentNames <> enclosedNames)
|
||||
NamedIcon parentName (NestedApply _ headIcon icons)
|
||||
-> mconcat
|
||||
$ drawRegion (parentName:parentNames) <$> catMaybes (headIcon:icons)
|
||||
_ -> mempty
|
||||
|
||||
-- TODO Use something better than a rectangle
|
||||
regionRect dias
|
||||
|
1
todo.md
1
todo.md
@ -2,7 +2,6 @@
|
||||
|
||||
## Todo Now
|
||||
* Remove port number magic numbers in GraphAlgorithms.hs.
|
||||
* Fix embedded lambdas missing their enclosures.
|
||||
* Add command line flags for color style, embedding, and whether to draw arrowheads.
|
||||
* Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user