clean up

app/Icons.hs

@@ -6,12 +6,8 @@ module Icons
     iconToDiagram,
     --drawIconAndPorts,
     --drawIconsAndPortNumbers,
-    PortName(..),
     nameDiagram,
     connectMaybePorts,
-    connectPorts,
-    connectIconToPort,
-    connectIcons,
     textBox,
     enclosure,
     lambdaRegion,
@@ -19,15 +15,18 @@ module Icons
     ) where
 
 import Diagrams.Prelude
-import Diagrams.Backend.SVG.CmdLine
+import Diagrams.Backend.SVG(B)
 import Data.Maybe (fromMaybe)
 
+-- TYPES --
 -- | 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
 
+-- FUNCTIONS --
+
 iconToDiagram Apply0Icon _ = apply0Dia
 iconToDiagram ResultIcon _ = resultIcon
 iconToDiagram (TextBoxIcon s) _ = textBox s
@@ -35,13 +34,6 @@ iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap = lambdaRegio
   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.
-instance IsName PortName
-newtype PortName = PortName Int deriving (Show, Ord, Eq)
-
-defaultLineWidth = 0.15
-
 -- | Names the diagram and puts all sub-names in the namespace of the top level name.
 nameDiagram name dia = name .>> (dia # named name)
 
@@ -59,51 +51,33 @@ connectMaybePorts icon0 (Just port0) icon1 Nothing =
 connectMaybePorts icon0 Nothing icon1 Nothing =
   connectOutside' arrowOptions icon0 icon1
 
-connectPorts icon0 port0 icon1 port1 =
-  connectMaybePorts icon0 (Just port0) icon1 (Just port1)
+makePort :: Int -> Diagram B
+makePort x = mempty # named x
 
-connectIconToPort icon0 icon1 port1 =
-  connectMaybePorts icon0 (Nothing :: Maybe PortName) icon1 (Just port1)
 
-connectIcons icon0 icon1 =
-  connectMaybePorts icon0 (Nothing:: Maybe PortName) icon1 (Nothing :: Maybe PortName)
+makePortDiagrams points =
+  atPoints points (map makePort [0,1..])
 
--- | 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
+-- CONSTANTS --
+defaultLineWidth = 0.15
 
 -- APPLY0 ICON --
 circleRadius = 0.5
 apply0LineWidth = defaultLineWidth
 
-resultCircle :: Diagram B
+--resultCircle :: Diagram B
 resultCircle = circle circleRadius # fc red # lw none
 
-apply0Triangle :: Diagram B
+--apply0Triangle :: Diagram B
 apply0Triangle = eqTriangle (2 * circleRadius) # rotateBy (-1/12) # fc red # lw none
 
-apply0Line :: Diagram B
+--apply0Line :: Diagram B
 apply0Line = rect apply0LineWidth (2 * circleRadius) # fc white # lw none
 
-apply0Dia :: Diagram B
-apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams verts
+--apply0Dia :: Diagram B
+apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams apply0PortLocations
 
-makePort x = mempty # named (PortName x)
-
-makePortDiagrams points =
-  atPoints points (map makePort [0,1..])
-
-verts = map p2 [
+apply0PortLocations = map p2 [
   (circleRadius + apply0LineWidth + triangleWidth, 0),
   (lineCenter,circleRadius),
   (-circleRadius,0),
@@ -117,7 +91,7 @@ textBoxFontSize = 1
 monoLetterWidthToHeightFraction = 0.6
 textBoxHeightFactor = 1.1
 
-textBox :: String -> Diagram B
+--textBox :: String -> Diagram B
 textBox = coloredTextBox white $ opaque white
 
 -- Since the normal SVG text has no size, some hackery is needed to determine
@@ -142,7 +116,9 @@ 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 = centerXY $ hsep 0.4 (take n (map lambdaIcon [0,1..])) # centerX === (enclosure dia # centerX)
+lambdaRegion n dia =
+  centerXY $ lambdaIcons # centerX === (enclosure dia # centerX)
+  where lambdaIcons = hsep 0.4 (take n (map lambdaIcon [0,1..]))
 
 -- RESULT ICON --
 resultIcon = unitSquare # lw none # fc lime

app/Main.hs

@@ -15,8 +15,6 @@ import Lib
 import Icons
 import Rendering
 
--- todo: Clean up. Put renderDrawing code in a new file.
-
 -- 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.
@@ -94,8 +92,9 @@ superDrawing = Drawing superIcons superEdges [(d0Name, drawing0)]
 
 --main1 = mainWith (ex11 # bgFrame 0.1 black)
 
+main1 :: IO ()
 main1 = do
-  placedNodes <- renderDrawing superDrawing 0.1
+  placedNodes <- renderDrawing superDrawing (0.1 :: Double)
   mainWith (placedNodes # bgFrame 0.1 black)
 
 main :: IO ()

app/Rendering.hs

@@ -12,8 +12,8 @@ import Diagrams.Prelude
 import Diagrams.TwoD.GraphViz
 
 import Data.GraphViz
-import qualified Data.GraphViz.Attributes.Complete as GVA
-import Data.GraphViz.Commands
+--import qualified Data.GraphViz.Attributes.Complete as GVA
+--import Data.GraphViz.Commands
 import Data.Map((!))
 import Data.Maybe (fromMaybe)
 
@@ -21,7 +21,8 @@ import Icons
 
 -- | 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)]
+type Edge = (Name, Maybe Int, Name, Maybe Int)
+data Drawing = Drawing [(Name, Icon)] [Edge] [(Name, Drawing)]
 
 makeNamedMap subDiagramMap =
   map (\(label, dia) -> (label, iconToDiagram dia subDiagramMap # nameDiagram label))
@@ -31,8 +32,8 @@ mapFst f = map (\(x, y) -> (f x, y))
 toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
 toNames = mapFst toName
 
-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)
+portToPort a b c d = (toName a, Just b, toName c, Just d)
+iconToPort a   c d = (toName a, Nothing, toName c, Just d)
 iconToIcon a   c   = (toName a, Nothing, toName c, Nothing)
 
 edgesToGraph labels edges = mkGraph labels simpleEdges
@@ -55,7 +56,7 @@ placeNodes scaleFactor layoutResult labelDiagramMap = mconcat placedNodes
         placedNode = place
           diagram
           --(fromMaybe (error ("placeNodes: label not in map: " ++ (show (map fst labelDiagramMap)))) maybeDiagram)
-          (scaleFactor * positionMap ! label)
+          (scaleFactor *^ (positionMap ! label))
 
 doGraphLayout scaleFactor graph labelDiagramMap connectNodes = do
   layoutResult <- layoutGraph Neato graph

glance.cabal

@@ -32,7 +32,7 @@ executable glance-exe
                      , graphviz
                      , containers
   default-language:    Haskell2010
-  Other-modules: Icons
+  Other-modules: Icons, Rendering
 
 test-suite glance-test
   type:                exitcode-stdio-1.0