Clean up and test recursive drawings.

app/Icons.hs

@@ -30,7 +30,8 @@ data Icon = Apply0Icon | ResultIcon | TextBoxIcon String | LambdaRegionIcon Int
 iconToDiagram Apply0Icon _ = apply0Dia
 iconToDiagram ResultIcon _ = resultIcon
 iconToDiagram (TextBoxIcon s) _ = textBox s
-iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap = lambdaRegion n dia
+iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
+  lambdaRegion n dia
   where
     dia = fromMaybe (error "iconToDiagram: subdiagram not found") $ lookup diagramName nameToSubdiagramMap
 

app/Main.hs

@@ -11,13 +11,15 @@ import Data.GraphViz.Commands
 import Data.Map((!))
 import Data.Maybe (fromMaybe)
 
+import Data.Typeable(Typeable)
+
 import Lib
 import Icons
 import Rendering
 
 -- 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.
+-- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
 
 applyDia = apply0Dia
 -- --apply0A = "A" .>> applyDia
@@ -63,17 +65,18 @@ d0Edges =
   iconToPort "bar" "A" 3
   ]
 
+drawing0 = Drawing d0Icons d0Edges []
+d0Name = toName "d0"
+
 superEdges =
   [
   portToPort ("lam0" .> "A") 1 "lam0" 0,
   iconToIcon "y" "lam0",
   iconToIcon "z" "lam0",
-  iconToIcon "q" "lam0"
+  iconToIcon "q" "lam0",
+  iconToIcon "A" "z"
   ]
 
-drawing0 = Drawing d0Icons d0Edges []
-d0Name = toName "d0"
-
 superIcons = toNames [
   ("lam0", LambdaRegionIcon 3 d0Name),
   ("y", TextBoxIcon "y"),
@@ -84,6 +87,35 @@ superIcons = toNames [
 --superDrawing = Drawing [((toName "lam0"), LambdaRegionIcon 3 (toName"d0"))] superEdges [((toName "d0"), drawing0)]
 superDrawing = Drawing superIcons superEdges [(d0Name, drawing0)]
 
+super2Icons = toNames [
+  ("lam0", LambdaRegionIcon 1 d0Name),
+  --("y", TextBoxIcon "y"),
+  ("lam1", LambdaRegionIcon 2 d0Name)
+  ]
+
+super2Edges =
+  [
+  iconToIcon "lam0" "lam1"
+  --iconToIcon "y" "lam0"
+  ]
+
+super2Drawing = Drawing super2Icons super2Edges [(d0Name, drawing0)]
+super2Name = toName "s2"
+
+super3Icons = toNames [
+  ("lam0", LambdaRegionIcon 3 d1Name),
+  --("y", TextBoxIcon "y"),
+  ("lam1", LambdaRegionIcon 4 d1Name)
+  ]
+
+super3Edges =
+  [
+--  iconToIcon "lam0" "lam1",
+  iconToIcon "lam0" "A"
+  ]
+d1Name = toName "d1"
+super3Drawing = Drawing super3Icons super3Edges [(d1Name, super2Drawing)]
+
 -- This is left commented out for a future test of the manual connect functions.
 -- connectNodes g =
 --   g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
@@ -94,7 +126,7 @@ superDrawing = Drawing superIcons superEdges [(d0Name, drawing0)]
 
 main1 :: IO ()
 main1 = do
-  placedNodes <- renderDrawing superDrawing (0.1 :: Double)
+  placedNodes <- renderDrawing superDrawing (0.7 :: Double)
   mainWith (placedNodes # bgFrame 0.1 black)
 
 main :: IO ()

app/Rendering.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
+
 module Rendering (
   Drawing(..),
   portToPort,
@@ -10,6 +11,7 @@ module Rendering (
 
 import Diagrams.Prelude
 import Diagrams.TwoD.GraphViz
+import Diagrams.Backend.SVG(B)
 
 import Data.GraphViz
 --import qualified Data.GraphViz.Attributes.Complete as GVA
@@ -19,24 +21,36 @@ import Data.Maybe (fromMaybe)
 
 import Icons
 
+-- | 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
-type Edge = (Name, Maybe Int, Name, Maybe Int)
 data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)]
 
+-- | Convert a map of names and icons, to a list of names and diagrams.
+-- The subDiagramMap
+makeNamedMap :: IsName name => [(Name, Diagram B)] -> [(name, Icon)] -> [(name, Diagram B)]
 makeNamedMap subDiagramMap =
-  map (\(label, dia) -> (label, iconToDiagram dia subDiagramMap # nameDiagram label))
+  map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap # nameDiagram name))
 
+mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
 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)
+
+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)
+
+iconToIcon :: (IsName a, IsName c) => a -> c -> (Name, Maybe b, Name, Maybe d)
 iconToIcon a   c   = (toName a, Nothing, toName c, Nothing)
 
-edgesToGraph labels edges = mkGraph labels simpleEdges
+edgesToGraph names edges = mkGraph names simpleEdges
   where
     simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges
 
@@ -46,28 +60,23 @@ makeConnections edges = applyAll connections
   where
     connections = map (uncurry4 connectMaybePorts) edges
 
-placeNodes scaleFactor layoutResult labelDiagramMap = mconcat placedNodes
+placeNodes scaleFactor layoutResult nameDiagramMap = mconcat placedNodes
   where
     (positionMap, _) = getGraph layoutResult
-    placedNodes = map mapper labelDiagramMap
-    mapper (label, diagram) = placedNode
-      where
-        --maybeDiagram = lookup label labelDiagramMap
-        placedNode = place
-          diagram
-          --(fromMaybe (error ("placeNodes: label not in map: " ++ (show (map fst labelDiagramMap)))) maybeDiagram)
-          (scaleFactor *^ (positionMap ! label))
+    placedNodes = map placeNode nameDiagramMap
+    placeNode (name, diagram) = place diagram (scaleFactor *^ (positionMap ! name))
 
-doGraphLayout scaleFactor graph labelDiagramMap connectNodes = do
+doGraphLayout scaleFactor graph nameDiagramMap connectNodes = do
   layoutResult <- layoutGraph Neato graph
-  return $ placeNodes scaleFactor layoutResult labelDiagramMap # connectNodes
+  return $ placeNodes scaleFactor layoutResult nameDiagramMap # connectNodes
 
 renderDrawing (Drawing nameIconMap edges subDrawings) scaleFactor = do
   subDiagramMap <- mapM subDrawingMapper subDrawings
   let diagramMap = makeNamedMap subDiagramMap nameIconMap
-  doGraphLayout scaleFactor (edgesToGraph iconNames edges) diagramMap $ makeConnections edges
+  --mapM_ (putStrLn . (++"\n") . show . (map fst) . names . snd) diagramMap
+  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)
+    subDrawingMapper (name, subDrawing) = do
+      subDiagram <- renderDrawing subDrawing (0.2 * scaleFactor)
+      return (name, subDiagram)