rgleichman/glance
1
1
Fork 0
mirror of https://github.com/rgleichman/glance.git synced 2024-09-11 23:17:21 +03:00
Code Issues Projects Releases Wiki Activity

Embed lambda nodes in apply parents.

Browse Source
This commit is contained in:
Robbie Gleichman 2019-03-12 22:43:58 -07:00
parent 96aaaa2319
commit 2d74cb2fd1
3 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
app/GraphAlgorithms.hs
View File

@ -41,13 +41,12 @@ syntaxNodeIsEmbeddable :: ParentType
-> Maybe Port -> Maybe Port
-> Maybe Port -> Maybe Port
-> Bool -> Bool
syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
= case (parentType, n) of = case (parentType, syntaxNode) of
(ApplyParent, ApplyNode _ _ _) -> parentPortNotResult (ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
(ApplyParent, LiteralNode _) -> parentPortNotResult (ApplyParent, LiteralNode _) -> parentPortNotResult
-- TODO Embedded FunctionDefNodes are missing their enclosures. (ApplyParent, FunctionDefNode _ _)
-- (ApplyParent, FunctionDefNode _ _) -> isInput mParentPort && isResult mChildPort
-- -> isInput mParentPort && isResult mChildPort
(CaseParent, LiteralNode _) -> parentPortNotResult (CaseParent, LiteralNode _) -> parentPortNotResult
(CaseParent, ApplyNode _ _ _) (CaseParent, ApplyNode _ _ _)

30
app/Rendering.hs
View File

@ -6,6 +6,7 @@ module Rendering (
renderIngSyntaxGraph renderIngSyntaxGraph
) where ) where
import qualified Diagrams.Prelude as DIA
import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
, arrowTail, arrowHead, scale, r2, bezier3 , arrowTail, arrowHead, scale, r2, bezier3
, fromSegments, Angle, P2, V2, Point, Name, ArrowOpts, N , fromSegments, Angle, P2, V2, Point, Name, ArrowOpts, N
@ -17,7 +18,6 @@ import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
, connectOutside', connect', with, (%~), lengths, (^+^) , connectOutside', connect', with, (%~), lengths, (^+^)
, (.~)) , (.~))
import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph') import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
import qualified Diagrams.Prelude as DIA
import qualified Data.GraphViz as GV import qualified Data.GraphViz as GV
import qualified Data.GraphViz.Attributes.Complete as GVA import qualified Data.GraphViz.Attributes.Complete as GVA
@ -27,7 +27,7 @@ import Data.Function(on)
import qualified Data.Graph.Inductive as ING import qualified Data.Graph.Inductive as ING
import Data.Graph.Inductive.PatriciaTree (Gr) import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.List(find, minimumBy) import Data.List(find, minimumBy)
import Data.Maybe(isNothing, fromMaybe) import Data.Maybe(catMaybes, isNothing, fromMaybe)
import Data.Typeable(Typeable) import Data.Typeable(Typeable)
--import qualified Data.GraphViz.Types --import qualified Data.GraphViz.Types
@ -353,20 +353,26 @@ rotateNodes positionMap graph
-- END rotateNodes -- -- END rotateNodes --
drawLambdaRegions :: SpecialBackend b Double => drawLambdaRegions :: forall b . SpecialBackend b Double =>
[(NamedIcon, SpecialQDiagram b Double)] [(NamedIcon, SpecialQDiagram b Double)]
-> SpecialQDiagram b Double -> SpecialQDiagram b Double
drawLambdaRegions placedNodes drawLambdaRegions placedNodes
= mconcat $ fmap (drawRegion . niIcon . fst) placedNodes = mconcat $ fmap (drawRegion [] . fst) placedNodes
where where
drawRegion (FlatLambdaIcon _ enclosedNames) findDia :: NodeName -> SpecialQDiagram b Double
= regionRect enclosedDias findDia n1
where = maybe mempty snd
enclosedDias = fmap findDia enclosedNames (find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes)
findDia n1
= maybe mempty snd -- Also draw the region around the icon the lambda is in.
(find (\(NamedIcon n2 _, _) -> n1 == n2) placedNodes) drawRegion :: [NodeName] -> NamedIcon -> SpecialQDiagram b Double
drawRegion _ = mempty 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 -- TODO Use something better than a rectangle
regionRect dias regionRect dias

1
todo.md
View File

@ -2,7 +2,6 @@
## Todo Now ## Todo Now
* Remove port number magic numbers in GraphAlgorithms.hs. * 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 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.. * Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..