Add Apply0N, extract types to Types.hs, add end options to Edge type.

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

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

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

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)]

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