mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-16 18:30:36 +03:00
Recursive layout for lambdas.
This commit is contained in:
parent
ca1caa96b2
commit
f0fdb5829a
53
app/Icons.hs
53
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
|
||||
|
100
app/Main.hs
100
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
|
||||
|
Loading…
Reference in New Issue
Block a user