From d5e0b6bf6306c41e800a8e7fe3aac8f05d002b3b Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Wed, 20 Jan 2016 16:48:30 -0800 Subject: [PATCH] Add Apply0N, extract types to Types.hs, add end options to Edge type. --- app/Icons.hs | 37 ++++++++++++++++++++++++------------- app/Main.hs | 23 +++++++++++++---------- app/Rendering.hs | 39 ++++++++++++++++++++++----------------- app/Types.hs | 26 ++++++++++++++++++++++++++ glance.cabal | 3 ++- 5 files changed, 87 insertions(+), 41 deletions(-) create mode 100644 app/Types.hs diff --git a/app/Icons.hs b/app/Icons.hs index 8305c39..d148ac4 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -13,24 +13,19 @@ module Icons lambdaRegion, resultIcon, guardIcon, + apply0NDia ) where import Diagrams.Prelude import Diagrams.Backend.SVG(B) import Data.Maybe (fromMaybe) --- TYPES -- --- | A datatype that represents an icon. --- The BranchIcon is used as a branching point for a line. --- The TextBoxIcon's data is the text that appears in the text box. --- The LambdaRegionIcon's data is the number of lambda ports, and the name of it's --- subdrawing. -data Icon = Apply0Icon | ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int - | LambdaRegionIcon Int Name +import Types(Icon(..), Edge(..)) -- FUNCTIONS -- iconToDiagram Apply0Icon _ = apply0Dia +iconToDiagram (Apply0NIcon n) _ = apply0NDia n iconToDiagram ResultIcon _ = resultIcon iconToDiagram BranchIcon _ = branchIcon iconToDiagram (TextBoxIcon s) _ = textBox s @@ -45,16 +40,17 @@ nameDiagram name dia = name .>> (dia # named name) arrowOptions = with & arrowHead .~ noHead & shaftStyle %~ lwG defaultLineWidth . lc white -connectMaybePorts icon0 (Just port0) icon1 (Just port1) = +connectMaybePorts :: Edge -> Diagram B -> Diagram B +connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) _) = connect' arrowOptions (icon0 .> port0) (icon1 .> port1) -connectMaybePorts icon0 Nothing icon1 (Just port1) = +connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) _) = connectOutside' arrowOptions icon0 (icon1 .> port1) -connectMaybePorts icon0 (Just port0) icon1 Nothing = +connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) _) = connectOutside' arrowOptions (icon0 .> port0) icon1 -connectMaybePorts icon0 Nothing icon1 Nothing = +connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) _) = connectOutside' arrowOptions icon0 icon1 -- | Make an port with an integer name. Always use <> to add a ports (not === or |||) @@ -85,7 +81,7 @@ apply0Triangle = eqTriangle (2 * circleRadius) # rotateBy (-1/12) # fc red # lw apply0Line = rect apply0LineWidth (2 * circleRadius) # fc white # lw none --apply0Dia :: Diagram B -apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams apply0PortLocations +apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams apply0PortLocations # centerXY apply0PortLocations = map p2 [ (circleRadius + apply0LineWidth + triangleWidth, 0), @@ -96,6 +92,21 @@ apply0PortLocations = map p2 [ triangleWidth = circleRadius * sqrt 3 lineCenter = circleRadius + (apply0LineWidth / 2.0) +-- apply0N Icon-- + +apply0NDia :: Int -> Diagram B +apply0NDia n = finalDia # centerXY where + seperation = 0.6 + trianglePortsCircle = hcat [ + reflectX apply0Triangle, + hcat $ take n $ map (\x -> makePort x <> strutX seperation) [2,3..], + makePort 1 <> alignR (circle circleRadius # fc red # lwG defaultLineWidth # lc red) + ] + allPorts = makePort 0 <> alignL trianglePortsCircle + topAndBottomLineWidth = width allPorts - circleRadius + topAndBottomLine = hrule topAndBottomLineWidth # lc red # lwG defaultLineWidth # alignL + finalDia = topAndBottomLine === allPorts === topAndBottomLine + -- TEXT ICON -- textBoxFontSize = 1 monoLetterWidthToHeightFraction = 0.6 diff --git a/app/Main.hs b/app/Main.hs index 18572ac..861d833 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -14,8 +14,9 @@ import Data.Maybe (fromMaybe) import Data.Typeable(Typeable) import Lib -import Icons -import Rendering +import Icons(apply0Dia, apply0NDia) +import Rendering(toNames, portToPort, iconToPort, iconToIcon, renderDrawing) +import Types(Icon(..), Drawing(..)) -- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly -- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg") @@ -24,6 +25,7 @@ import Rendering -- todo: add port to bottom of guard. -- todo: use constants for icon name strings in Main -- todo: figure out local vs. global icon positions +-- todo: replace hrule and vrule with strutX and strutY applyDia = apply0Dia -- --apply0A = "A" .>> applyDia @@ -131,8 +133,9 @@ fact0Icons = toNames ("-1Ap", Apply0Icon), ("*", TextBoxIcon "*"), ("recurAp", Apply0Icon), - ("*Ap1", Apply0Icon), - ("*Ap2", Apply0Icon), + ("*Ap", Apply0NIcon 2), + --("*Ap1", Apply0Icon), + --("*Ap2", Apply0Icon), ("arg", BranchIcon), ("res", ResultIcon) ] @@ -141,14 +144,14 @@ fact0Edges = [ iconToPort "eq0" "eq0Ap" 0, portToPort "eq0Ap" 2 "g0" 1, iconToPort "-1" "-1Ap" 0, - iconToPort "*" "*Ap1" 0, + iconToPort "*" "*Ap" 0, iconToPort "one" "g0" 2, - portToPort "*Ap2" 2 "g0" 4, - portToPort "*Ap1" 2 "*Ap2" 0, - portToPort "recurAp" 2 "*Ap1" 1, + portToPort "*Ap" 1 "g0" 4, + --portToPort "*Ap" 3 "recurAp" 0, + portToPort "recurAp" 2 "*Ap" 3, iconToPort "arg" "eq0Ap" 1, iconToPort "arg" "-1Ap" 1, - iconToPort "arg" "*Ap2" 1, + iconToPort "arg" "*Ap" 2, portToPort "-1Ap" 2 "recurAp" 1, iconToPort "res" "g0" 0 ] @@ -183,7 +186,7 @@ main1 = do placedNodes <- renderDrawing factLam0Drawing mainWith (placedNodes # bgFrame 0.1 black) -main2 = mainWith (guardIcon 3 # bgFrame 0.1 black) +main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black) main :: IO () main = main1 diff --git a/app/Rendering.hs b/app/Rendering.hs index 93e94cb..abb5766 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -21,16 +21,11 @@ import Data.Maybe(fromMaybe, isJust) import qualified Debug.Trace import Data.List(minimumBy) import Data.Function(on) +import Data.Graph.Inductive.PatriciaTree (Gr) import Icons +import Types(Edge(..), Connection, Drawing(..), EdgeEndType(..)) --- | An Edge has an name of the source icon, and its optional port number, --- and the name of the destination icon, and its optional port number. -type Edge = (Name, Maybe Int, Name, Maybe Int) - --- | A drawing is a map from names to Icons, a list of edges, --- and a map of names to subDrawings -data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)] -- | Convert a map of names and icons, to a list of names and diagrams. -- The subDiagramMap @@ -44,27 +39,32 @@ mapFst f = map (\(x, y) -> (f x, y)) toNames :: (IsName a) => [(a, b)] -> [(Name, b)] toNames = mapFst toName -portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> (Name, Maybe b, Name, Maybe d) -portToPort a b c d = (toName a, Just b, toName c, Just d) +noEnds = (NoEnd, NoEnd) -iconToPort :: (IsName a, IsName c) => a -> c -> d -> (Name, Maybe b, Name, Maybe d) -iconToPort a c d = (toName a, Nothing, toName c, Just d) +--portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> Edge +portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge +portToPort a b c d = Edge (toName a, Just b, toName c, Just d) noEnds -iconToIcon :: (IsName a, IsName c) => a -> c -> (Name, Maybe b, Name, Maybe d) -iconToIcon a c = (toName a, Nothing, toName c, Nothing) +iconToPort :: (IsName a, IsName b) => a -> b -> Int -> Edge +iconToPort a c d = Edge (toName a, Nothing, toName c, Just d) noEnds +iconToIcon :: (IsName a, IsName b) => a -> b -> Edge +iconToIcon a c = Edge (toName a, Nothing, toName c, Nothing) noEnds + +edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v () edgesToGraph names edges = mkGraph names simpleEdges where simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges uncurry4 f (a, b, c, d) = f a b c d +makeConnections :: [Edge] -> Diagram B -> Diagram B makeConnections edges = applyAll connections where - connections = map (uncurry4 connectMaybePorts) edges + connections = map connectMaybePorts edges -- | Returns [(myport, other node, other node's port)] -connectedPorts :: [Edge] -> Name -> [(Int, Name, Maybe Int)] +connectedPorts :: [Connection] -> Name -> [(Int, Name, Maybe Int)] connectedPorts edges name = map edgeToPort $ filter nameInEdge edges where nameInEdge (n1, p1, n2, p2) = (name == n1 && isJust p1) || (name == n2 && isJust p2) @@ -100,12 +100,14 @@ angleWithMinDist myLocation edges = -- constant scaleFactor = 0.02 +getFromMapAndScale :: (Fractional a, Functor f, Ord k) => Map.Map k (f a) -> k -> f a getFromMapAndScale posMap name = scaleFactor *^ (posMap Map.! name) -- | rotateNodes rotates the nodes such that the distance of its connecting lines -- are minimized. -- Precondition: the diagrams are already centered -- todo: confirm precondition (or use a newtype) +rotateNodes :: Map.Map Name (Point V2 Double) -> [(Name, Diagram B)] -> [Connection] -> [(Name, Diagram B)] rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap where rotateDiagram (name, dia) = (name, diaToUse) @@ -139,6 +141,7 @@ placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes -- todo: Not sure if the diagrams should already be centered at this point. placeNode (name, diagram) = place (diagram # centerXY) (scaleFactor *^ (positionMap Map.! name)) +doGraphLayout :: Gr Name e -> [(Name, Diagram B)] -> (Diagram B -> r) -> [Connection] -> IO r doGraphLayout graph nameDiagramMap connectNodes edges = do layoutResult <- layoutGraph' layoutParams Neato graph return $ placeNodes layoutResult nameDiagramMap edges # connectNodes @@ -147,7 +150,7 @@ doGraphLayout graph nameDiagramMap connectNodes edges = do layoutParams = defaultParams{ globalAttributes = [ NodeAttrs [shape Circle] - , GraphAttrs [GVA.Overlap GVA.ScaleXYOverlaps] + , GraphAttrs [GVA.Overlap GVA.ScaleXYOverlaps, GVA.Splines GVA.LineEdges] ], fmtEdge = const [arrowTo noArrow], fmtNode = nodeAttribute @@ -163,12 +166,14 @@ doGraphLayout graph nameDiagramMap connectNodes edges = do -- to name the nodes in order (_, dia) = nameDiagramMap !! nodeInt +renderDrawing :: Drawing -> IO (Diagram B) renderDrawing (Drawing nameIconMap edges subDrawings) = do subDiagramMap <- mapM subDrawingMapper subDrawings let diagramMap = makeNamedMap subDiagramMap nameIconMap --mapM_ (putStrLn . (++"\n") . show . (map fst) . names . snd) diagramMap - doGraphLayout (edgesToGraph iconNames edges) diagramMap (makeConnections edges) edges + doGraphLayout (edgesToGraph iconNames connections) diagramMap (makeConnections edges) connections where + connections = map edgeConnection edges iconNames = map fst nameIconMap subDrawingMapper (name, subDrawing) = do subDiagram <- renderDrawing subDrawing diff --git a/app/Types.hs b/app/Types.hs new file mode 100644 index 0000000..42a3fb5 --- /dev/null +++ b/app/Types.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-} + +module Types where + +import Diagrams.Prelude(Name) + +-- TYPES -- +-- | A datatype that represents an icon. +-- The BranchIcon is used as a branching point for a line. +-- The TextBoxIcon's data is the text that appears in the text box. +-- The LambdaRegionIcon's data is the number of lambda ports, and the name of it's +-- subdrawing. +data Icon = Apply0Icon | ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int + | LambdaRegionIcon Int Name | Apply0NIcon Int + +type Connection = (Name, Maybe Int, Name, Maybe Int) + +-- | An Edge has an name of the source icon, and its optional port number, +-- and the name of the destination icon, and its optional port number. +data Edge = Edge {edgeConnection :: Connection, edgeEnds :: (EdgeEndType, EdgeEndType)} + +data EdgeEndType = Ap1Result | Ap1Arg | NoEnd + +-- | A drawing is a map from names to Icons, a list of edges, +-- and a map of names to subDrawings +data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)] diff --git a/glance.cabal b/glance.cabal index 681528a..cb1476a 100644 --- a/glance.cabal +++ b/glance.cabal @@ -31,8 +31,9 @@ executable glance-exe , diagrams-graphviz , graphviz , containers + , fgl default-language: Haskell2010 - Other-modules: Icons, Rendering + Other-modules: Icons, Rendering, Types test-suite glance-test type: exitcode-stdio-1.0