diff --git a/app/Icons.hs b/app/Icons.hs index 80675ac..9657143 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -134,17 +134,18 @@ branchIcon :: Diagram B branchIcon = circle 0.3 # fc white # lc white -- GUARD ICON -- +guardSize = 0.7 guardTriangle :: Int -> Diagram B -guardTriangle x = triangleAndPort # alignL +guardTriangle x = ((triangleAndPort ||| (hrule (guardSize * 0.8) # lc white # lwG defaultLineWidth)) # alignR) <> (makePort x) # alignL where - triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [1, 1]) - # rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR <> (makePort x # showOrigin) + triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize]) + # rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR guardLBracket :: Int -> Diagram B guardLBracket x = ell # alignT # alignL <> makePort x where -- todo: use a path or trail here so that the corner is rounded correctly - ell = (hrule 1 # lc orange # lwG defaultLineWidth # alignR) <> (vrule 1 # lc orange # lwG defaultLineWidth # alignT) + ell = (hrule guardSize # lc orange # lwG defaultLineWidth # alignR) <> (vrule guardSize # lc orange # lwG defaultLineWidth # alignT) -- | The ports of the guard icon are as follows: -- Port 0: The top port for the result @@ -158,6 +159,6 @@ guardIcon n = centerXY $ vcat (take n trianglesAndBrackets # alignT) <> makePort lBrackets = map guardLBracket [1,3..] trianglesAndBrackets = zipWith zipper trianglesWithPorts lBrackets - zipper tri lBrack = verticalLine === ((lBrack ||| hrule 0.4) # alignR <> (tri # alignL)) + zipper tri lBrack = verticalLine === ((lBrack ||| strut (guardSize * 0.4)) # alignR <> (tri # alignL)) where verticalLine = vrule 0.4 # lc white # lwG defaultLineWidth diff --git a/app/Main.hs b/app/Main.hs index c69b9b2..2910071 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -15,11 +15,14 @@ import Data.Typeable(Typeable) import Lib import Icons(apply0Dia, apply0NDia) -import Rendering(toNames, portToPort, iconToPort, iconToIcon, iconToIconEnds, renderDrawing) +import Rendering(toNames, portToPort, iconToPort, iconToIcon, + iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing) import Types(Icon(..), Drawing(..), EdgeEnd(..)) -- TODO Now -- +-- todo: add example goal and status drawings for factorial to readme. -- todo: replace hrule and vrule with strutX and strutY +-- todo: consolidate colors to one place -- todo: add port to bottom of guard. -- todo: use constants for icon name strings in Main -- todo: figure out how to deal with the difference between arrow heads and arrow tails @@ -29,6 +32,7 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..)) -- 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") -- todo: Rotate based on difference from ideal tangent angle, not line distance. +-- todo: Try using connectPerim for port ot port connections. Hopefully this will draw a spline. -- todo: layout and rotate considering external connections. -- todo: figure out local vs. global icon positions @@ -151,14 +155,12 @@ fact0Edges = [ iconToPort "*" "*Ap" 0, iconToPort "one" "g0" 2, 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" "*Ap" 2, portToPort "-1Ap" 2 "recurAp" 1, iconToPort "res" "g0" 0 - --iconToIconEnds "-1" Ap1Result "eq0" Ap1Arg ] fact0Drawing = Drawing fact0Icons fact0Edges [] @@ -172,12 +174,49 @@ factLam0Icons = toNames [ factLam0Edges = [ iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0, iconToPort "lam0" ("lam0" .> "recurAp") 0, - --portToPort "lam0" 0 ("lam0" .> "*Ap2") 3, iconToIcon "lam0" "fac" ] factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)] +fact1Icons = toNames + [ + ("g0", GuardIcon 2), + ("one", TextBoxIcon "1"), + ("eq0", TextBoxIcon "== 0"), + ("-1", TextBoxIcon "-1"), + ("*", TextBoxIcon "*"), + ("recurAp", Apply0Icon), + ("*Ap", Apply0NIcon 2), + ("arg", BranchIcon), + ("res", ResultIcon) + ] + +fact1Edges = [ + --iconToPort "eq0" "eq0Ap" 0, + --portToPort "eq0Ap" 2 "g0" 1, + --iconToPort "-1" "-1Ap" 0, + iconToIconEnds "arg" EndNone "eq0" EndAp1Arg, + iconTailToPort "eq0" EndAp1Result "g0" 1, + iconToIconEnds "arg" EndNone "-1" EndAp1Arg, + iconTailToPort "-1" EndAp1Result "recurAp" 1, + --iconHeadTo + iconToPort "*" "*Ap" 0, + iconToPort "one" "g0" 2, + portToPort "*Ap" 1 "g0" 4, + portToPort "recurAp" 2 "*Ap" 3, + --iconToPort "arg" "eq0Ap" 1, + --iconToPort "arg" "-1Ap" 1, + iconToPort "arg" "*Ap" 2, + --portToPort "-1Ap" 2 "recurAp" 1, + iconToPort "res" "g0" 0 + --iconToIconEnds "-1" Ap1Result "eq0" Ap1Arg + ] + +fact1Drawing = Drawing fact1Icons fact1Edges [] + +factLam1Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact1Drawing)] + -- 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) @@ -188,7 +227,7 @@ factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing) main1 :: IO () main1 = do - placedNodes <- renderDrawing factLam0Drawing + placedNodes <- renderDrawing factLam1Drawing mainWith (placedNodes # bgFrame 0.1 black) main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black) diff --git a/app/Rendering.hs b/app/Rendering.hs index c881d3f..bd808c5 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -6,6 +6,8 @@ module Rendering ( iconToPort, iconToIcon, iconToIconEnds, + iconHeadToPort, + iconTailToPort, toNames, renderDrawing ) where @@ -41,7 +43,7 @@ mapFst f = map (\(x, y) -> (f x, y)) toNames :: (IsName a) => [(a, b)] -> [(Name, b)] toNames = mapFst toName -noEnds = (NoEnd, NoEnd) +noEnds = (EndNone, EndNone) --portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> Edge portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge @@ -59,6 +61,10 @@ iconToIcon a c = Edge (toName a, Nothing, toName c, Nothing) noEnds iconToIconEnds :: (IsName a, IsName b) => a -> EdgeEnd -> b -> EdgeEnd -> Edge iconToIconEnds a b c d = Edge (toName a, Nothing, toName c, Nothing) (b, d) +iconHeadToPort a endHead c d = Edge (toName a, Nothing, toName c, Just d) (EndNone, endHead) + +iconTailToPort a endTail c d = Edge (toName a, Nothing, toName c, Just d) (endTail, EndNone) + edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v () edgesToGraph names edges = mkGraph names simpleEdges where @@ -73,27 +79,28 @@ getArrowOpts :: (RealFloat n, Typeable n) => (EdgeEnd, EdgeEnd) -> ArrowOpts n getArrowOpts (t, h) = arrowOptions where lookupEnd :: (RealFloat n, Typeable n) => EdgeEnd -> ArrowOpts n -> ArrowOpts n - lookupEnd NoEnd = id - lookupEnd Ap1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan) - lookupEnd Ap1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan) + lookupEnd EndNone = id + lookupEnd EndAp1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan) + lookupEnd EndAp1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan) arrowOptions = with & arrowHead .~ noHead & arrowTail .~ noTail + & lengths .~ large & shaftStyle %~ lwG defaultLineWidth . lc white & (lookupEnd t) & (lookupEnd h) -plainLine = getArrowOpts (NoEnd, NoEnd) +plainLine = getArrowOpts (EndNone, EndNone) connectMaybePorts :: Edge -> Diagram B -> Diagram B -connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) _) = +connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) ends) = connect' - plainLine + (getArrowOpts ends) (icon0 .> port0) (icon1 .> port1) -connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) _) = - connectOutside' plainLine icon0 (icon1 .> port1) -connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) _) = - connectOutside' plainLine (icon0 .> port0) icon1 +connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) ends) = + connectOutside' (getArrowOpts ends) icon0 (icon1 .> port1) +connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) ends) = + connectOutside' (getArrowOpts ends) (icon0 .> port0) icon1 connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) ends) = connectOutside' (getArrowOpts ends) icon0 icon1 diff --git a/app/Types.hs b/app/Types.hs index ca3d4da..515ef08 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -19,7 +19,7 @@ type Connection = (Name, Maybe Int, Name, Maybe Int) -- and the name of the destination icon, and its optional port number. data Edge = Edge {edgeConnection :: Connection, edgeEnds :: (EdgeEnd, EdgeEnd)} -data EdgeEnd = Ap1Result | Ap1Arg | NoEnd +data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone -- | A drawing is a map from names to Icons, a list of edges, -- and a map of names to subDrawings