mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-16 18:30:36 +03:00
Add Apply0N, extract types to Types.hs, add end options to Edge type.
This commit is contained in:
parent
e311a9b38f
commit
d5e0b6bf63
37
app/Icons.hs
37
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
|
||||
|
23
app/Main.hs
23
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
|
||||
|
@ -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
|
||||
|
26
app/Types.hs
Normal file
26
app/Types.hs
Normal file
@ -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)]
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user