Recursive layout for lambdas.

app/Icons.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
 module Icons
     (
-    apply0Icon,
     Icon(..),
-    drawIconAndPorts,
-    drawIconsAndPortNumbers,
+    apply0Dia,
+    iconToDiagram,
+    --drawIconAndPorts,
+    --drawIconsAndPortNumbers,
     PortName(..),
     nameDiagram,
     connectMaybePorts,
@@ -19,11 +20,20 @@ module Icons
 
 import Diagrams.Prelude
 import Diagrams.Backend.SVG.CmdLine
+import Data.Maybe (fromMaybe)
 
--- | An icon is a Diagram and a list of points for the ports to the diagram.
--- The first portection is the right most (ie. 0 degrees), and other ports
--- proceed counterclockwise.
-data Icon a = Icon {iconDia :: Diagram a, ports :: [P2 Double]}
+-- | A datatype that represents an icon.
+-- 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 | TextBoxIcon String | LambdaRegionIcon Int Name
+
+iconToDiagram Apply0Icon _ = apply0Dia
+iconToDiagram ResultIcon _ = resultIcon
+iconToDiagram (TextBoxIcon s) _ = textBox s
+iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap = lambdaRegion n dia
+  where
+    dia = fromMaybe (error "iconToDiagram: subdiagram not found") $ lookup diagramName nameToSubdiagramMap
 
 -- | PortName is a simple wrapper around Int that is used for the diagram names
 -- of all the ports.
@@ -59,18 +69,18 @@ connectIcons icon0 icon1 =
   connectMaybePorts icon0 (Nothing:: Maybe PortName) icon1 (Nothing :: Maybe PortName)
 
 -- | Draw the icon with circles where the ports are
-drawIconAndPorts :: Icon B -> Diagram B
-drawIconAndPorts (Icon dia ports) =
-  vertCircles <> dia
-  where
-    vertCircles = atPoints ports $ repeat $ circle 0.05 # lw none # fc blue
-
-drawIconsAndPortNumbers :: Icon B -> Diagram B
-drawIconsAndPortNumbers (Icon dia ports) =
-  portNumbers <> dia
-  where
-    portNumbers = atPoints ports $ map makeNumDia [0,1..]
-    makeNumDia num = text (show num) # fontSize (local 0.1) # fc blue <> square 0.1 # fc white
+-- drawIconAndPorts :: Icon B -> Diagram B
+-- drawIconAndPorts (Icon dia ports) =
+--   vertCircles <> dia
+--   where
+--     vertCircles = atPoints ports $ repeat $ circle 0.05 # lw none # fc blue
+--
+-- drawIconsAndPortNumbers :: Icon B -> Diagram B
+-- drawIconsAndPortNumbers (Icon dia ports) =
+--   portNumbers <> dia
+--   where
+--     portNumbers = atPoints ports $ map makeNumDia [0,1..]
+--     makeNumDia num = text (show num) # fontSize (local 0.1) # fc blue <> square 0.1 # fc white
 
 -- APPLY 0 ICON --
 circleRadius = 0.5
@@ -88,9 +98,6 @@ apply0Line = rect apply0LineWidth (2 * circleRadius) # fc white # lw none
 apply0Dia :: Diagram B
 apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams verts
 
-apply0Icon :: Icon B
-apply0Icon = Icon apply0Dia verts
-
 makePort x = mempty # named (PortName x)
 
 makePortDiagrams points =
@@ -135,7 +142,7 @@ lambdaIcon x = coloredTextBox lime transparent "λ" # alignB <> makePort x
 
 -- | lambdaRegion takes as an argument the numbers of parameters to the lambda,
 -- and draws the diagram inside a region with the lambda icons on top.
-lambdaRegion n dia = hsep 0.4 (take n (map lambdaIcon [0,1..])) # center === enclosure dia
+lambdaRegion n dia = centerXY $ hsep 0.4 (take n (map lambdaIcon [0,1..])) # centerX === (enclosure dia # centerX)
 
 -- RESULT ICON --
 resultIcon = unitSquare # lw none # fc lime

app/Main.hs

@@ -14,9 +14,13 @@ import Data.Maybe (fromMaybe)
 import Lib
 import Icons
 
--- todo: Put
+-- todo: Clean up. Put renderDrawing code in a new file.
 
-applyDia = iconDia apply0Icon
+-- todo: Give graphviz info about the size of the nodes such that a variable scaleFactor
+-- todo: Test with more lambdas, (eg. two per layer, 3 or more layers)
+-- for subDiagrams is not necessary.
+
+applyDia = apply0Dia
 -- --apply0A = "A" .>> applyDia
 -- apply0A = applyDia # nameDiagram "A"
 -- apply0B = applyDia # nameDiagram "B"
@@ -42,23 +46,26 @@ applyDia = iconDia apply0Icon
 --   # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2)
 -- ex11 = connectIcons "lam0" "y" $ ex10 === vrule 2 === textBox "y" # named "y"
 
-makeNamedMap :: (IsName a) => [(a, Diagram B)] -> [(a, Diagram B)]
-makeNamedMap =
-  map (\(label, dia) -> (label, dia # nameDiagram label))
+-- | A drawing is a map from names to Icons, a list of edges, and a map of names to subDrawings
+data Drawing b = Drawing [(Name, Icon)] b [(Name, Drawing b)]
 
-labelDiagramMap = makeNamedMap
-  [("A", applyDia ),
-  ("B", applyDia),
-  ("res", resultIcon),
-  ("foo", textBox "foo"),
-  ("bar", textBox "bar")
+makeNamedMap subDiagramMap =
+  map (\(label, dia) -> (label, iconToDiagram dia subDiagramMap # nameDiagram label))
+
+mapFst f = map (\(x, y) -> (f x, y))
+toNames = mapFst toName
+
+rawDiagramMap = toNames $
+  [("A", Apply0Icon),
+  ("B", Apply0Icon),
+  ("res", ResultIcon),
+  ("foo", TextBoxIcon "foo"),
+  ("bar", TextBoxIcon "bar")
   ]
 
-labels = map fst labelDiagramMap
-
-portToPort a b c d = (a, Just $ PortName b, c, Just $ PortName d)
-iconToPort a   c d = (a, Nothing, c, Just $ PortName d)
-iconToIcon a   c   = (a, Nothing, c, Nothing)
+portToPort a b c d = (toName a, Just $ PortName b, toName c, Just $ PortName d)
+iconToPort a   c d = (toName a, Nothing, toName c, Just $ PortName d)
+iconToIcon a   c   = (toName a, Nothing, toName c, Nothing)
 
 edges =
   [
@@ -70,12 +77,31 @@ edges =
   iconToPort "bar" "A" 3
   ]
 
+superEdges =
+  [
+  portToPort ("lam0" .> "A") 1 "lam0" 0,
+  iconToIcon "y" "lam0",
+  iconToIcon "z" "lam0",
+  iconToIcon "q" "lam0"
+  ]
+
+drawing0 = Drawing rawDiagramMap edges []
+
+superIcons = toNames $ [
+  ("lam0", LambdaRegionIcon 3 (toName "d0")),
+  ("y", TextBoxIcon "y"),
+  ("z", TextBoxIcon "z"),
+  ("q", TextBoxIcon "q")
+  ]
+
+--superDrawing :: (IsName c) => Drawing Name c
+--superDrawing = Drawing [((toName "lam0"), LambdaRegionIcon 3 (toName"d0"))] superEdges [((toName "d0"), drawing0)]
+superDrawing = Drawing superIcons superEdges [(toName "d0", drawing0)]
+
 edgesToGraph labels edges = mkGraph labels simpleEdges
   where
     simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges
 
-graph = edgesToGraph labels edges
-
 uncurry4 f (a, b, c, d) = f a b c d
 
 makeConnections edges = applyAll connections
@@ -85,12 +111,13 @@ makeConnections edges = applyAll connections
 placeNodes scaleFactor layoutResult labelDiagramMap = mconcat placedNodes
   where
     (positionMap, _) = getGraph layoutResult
-    placedNodes = map mapper labels
-    mapper label = placedNode
+    placedNodes = map mapper labelDiagramMap
+    mapper (label, diagram) = placedNode
       where
-        maybeDiagram = lookup label labelDiagramMap
+        --maybeDiagram = lookup label labelDiagramMap
         placedNode = place
-          (fromMaybe (error "placeNodes: label not in map") maybeDiagram)
+          diagram
+          --(fromMaybe (error ("placeNodes: label not in map: " ++ (show (map fst labelDiagramMap)))) maybeDiagram)
           (scaleFactor * positionMap ! label)
 
 -- This is left commented out for a future test of the manual connect functions.
@@ -99,17 +126,34 @@ placeNodes scaleFactor layoutResult labelDiagramMap = mconcat placedNodes
 --   # connectIconToPort "bar" "B" (PortName 3) # connectPorts "A" (PortName 0) "B" (PortName 2)
 --   # connectIconToPort "bar" "A" (PortName 3)
 
-connectNodes = makeConnections edges
 
-doGraphLayout graph labelDiagramMap connectNodes = do
+doGraphLayout scaleFactor graph labelDiagramMap connectNodes = do
   layoutResult <- layoutGraph Neato graph
-  return $ placeNodes 0.04 layoutResult labelDiagramMap # connectNodes
+  return $ placeNodes scaleFactor layoutResult labelDiagramMap # connectNodes
+  --where
+    --diagramScaleConstant = 0.04
+    --diagramScaleConstant = 0.1
 
 --main1 = mainWith (ex11 # bgFrame 0.1 black)
 
-main0 = do
-  placedNodes <- doGraphLayout graph labelDiagramMap connectNodes
+--renderDrawing :: Drawing a -> IO (Diagram B)
+renderDrawing (Drawing nameIconMap edges subDrawings) scaleFactor = do
+  subDiagramMap <- mapM subDrawingMapper subDrawings
+  let diagramMap = makeNamedMap subDiagramMap nameIconMap
+  doGraphLayout scaleFactor (edgesToGraph iconNames edges) diagramMap $ makeConnections edges
+  where
+    iconNames = map fst nameIconMap
+    subDrawingMapper (label, subDrawing) = do
+      subDiagram <- renderDrawing subDrawing (0.4 * scaleFactor)
+      return (label, subDiagram)
+
+-- main0 = do
+--   placedNodes <- doGraphLayout graph labelDiagramMap connectNodes
+--   mainWith (placedNodes # bgFrame 0.1 black)
+
+main1 = do
+  placedNodes <- renderDrawing superDrawing 0.1
   mainWith (placedNodes # bgFrame 0.1 black)
 
 main :: IO ()
-main = main0
+main = main1