mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Use arrow heads and tails for factorial.
This commit is contained in:
parent
9cf6722241
commit
90cbfbc1f1
11
app/Icons.hs
11
app/Icons.hs
@ -134,17 +134,18 @@ branchIcon :: Diagram B
|
|||||||
branchIcon = circle 0.3 # fc white # lc white
|
branchIcon = circle 0.3 # fc white # lc white
|
||||||
|
|
||||||
-- GUARD ICON --
|
-- GUARD ICON --
|
||||||
|
guardSize = 0.7
|
||||||
guardTriangle :: Int -> Diagram B
|
guardTriangle :: Int -> Diagram B
|
||||||
guardTriangle x = triangleAndPort # alignL
|
guardTriangle x = ((triangleAndPort ||| (hrule (guardSize * 0.8) # lc white # lwG defaultLineWidth)) # alignR) <> (makePort x) # alignL
|
||||||
where
|
where
|
||||||
triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [1, 1])
|
triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize])
|
||||||
# rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR <> (makePort x # showOrigin)
|
# rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR
|
||||||
|
|
||||||
guardLBracket :: Int -> Diagram B
|
guardLBracket :: Int -> Diagram B
|
||||||
guardLBracket x = ell # alignT # alignL <> makePort x
|
guardLBracket x = ell # alignT # alignL <> makePort x
|
||||||
where
|
where
|
||||||
-- todo: use a path or trail here so that the corner is rounded correctly
|
-- 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:
|
-- | The ports of the guard icon are as follows:
|
||||||
-- Port 0: The top port for the result
|
-- 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..]
|
lBrackets = map guardLBracket [1,3..]
|
||||||
trianglesAndBrackets =
|
trianglesAndBrackets =
|
||||||
zipWith zipper trianglesWithPorts lBrackets
|
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
|
where
|
||||||
verticalLine = vrule 0.4 # lc white # lwG defaultLineWidth
|
verticalLine = vrule 0.4 # lc white # lwG defaultLineWidth
|
||||||
|
49
app/Main.hs
49
app/Main.hs
@ -15,11 +15,14 @@ import Data.Typeable(Typeable)
|
|||||||
|
|
||||||
import Lib
|
import Lib
|
||||||
import Icons(apply0Dia, apply0NDia)
|
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(..))
|
import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||||
|
|
||||||
-- TODO Now --
|
-- TODO Now --
|
||||||
|
-- todo: add example goal and status drawings for factorial to readme.
|
||||||
-- todo: replace hrule and vrule with strutX and strutY
|
-- todo: replace hrule and vrule with strutX and strutY
|
||||||
|
-- todo: consolidate colors to one place
|
||||||
-- todo: add port to bottom of guard.
|
-- todo: add port to bottom of guard.
|
||||||
-- todo: use constants for icon name strings in Main
|
-- todo: use constants for icon name strings in Main
|
||||||
-- todo: figure out how to deal with the difference between arrow heads and arrow tails
|
-- 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 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: 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: 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: layout and rotate considering external connections.
|
||||||
-- todo: figure out local vs. global icon positions
|
-- todo: figure out local vs. global icon positions
|
||||||
|
|
||||||
@ -151,14 +155,12 @@ fact0Edges = [
|
|||||||
iconToPort "*" "*Ap" 0,
|
iconToPort "*" "*Ap" 0,
|
||||||
iconToPort "one" "g0" 2,
|
iconToPort "one" "g0" 2,
|
||||||
portToPort "*Ap" 1 "g0" 4,
|
portToPort "*Ap" 1 "g0" 4,
|
||||||
--portToPort "*Ap" 3 "recurAp" 0,
|
|
||||||
portToPort "recurAp" 2 "*Ap" 3,
|
portToPort "recurAp" 2 "*Ap" 3,
|
||||||
iconToPort "arg" "eq0Ap" 1,
|
iconToPort "arg" "eq0Ap" 1,
|
||||||
iconToPort "arg" "-1Ap" 1,
|
iconToPort "arg" "-1Ap" 1,
|
||||||
iconToPort "arg" "*Ap" 2,
|
iconToPort "arg" "*Ap" 2,
|
||||||
portToPort "-1Ap" 2 "recurAp" 1,
|
portToPort "-1Ap" 2 "recurAp" 1,
|
||||||
iconToPort "res" "g0" 0
|
iconToPort "res" "g0" 0
|
||||||
--iconToIconEnds "-1" Ap1Result "eq0" Ap1Arg
|
|
||||||
]
|
]
|
||||||
|
|
||||||
fact0Drawing = Drawing fact0Icons fact0Edges []
|
fact0Drawing = Drawing fact0Icons fact0Edges []
|
||||||
@ -172,12 +174,49 @@ factLam0Icons = toNames [
|
|||||||
factLam0Edges = [
|
factLam0Edges = [
|
||||||
iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0,
|
iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0,
|
||||||
iconToPort "lam0" ("lam0" .> "recurAp") 0,
|
iconToPort "lam0" ("lam0" .> "recurAp") 0,
|
||||||
--portToPort "lam0" 0 ("lam0" .> "*Ap2") 3,
|
|
||||||
iconToIcon "lam0" "fac"
|
iconToIcon "lam0" "fac"
|
||||||
]
|
]
|
||||||
|
|
||||||
factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)]
|
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.
|
-- This is left commented out for a future test of the manual connect functions.
|
||||||
-- connectNodes g =
|
-- connectNodes g =
|
||||||
-- g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
|
-- g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
|
||||||
@ -188,7 +227,7 @@ factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)
|
|||||||
|
|
||||||
main1 :: IO ()
|
main1 :: IO ()
|
||||||
main1 = do
|
main1 = do
|
||||||
placedNodes <- renderDrawing factLam0Drawing
|
placedNodes <- renderDrawing factLam1Drawing
|
||||||
mainWith (placedNodes # bgFrame 0.1 black)
|
mainWith (placedNodes # bgFrame 0.1 black)
|
||||||
|
|
||||||
main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black)
|
main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black)
|
||||||
|
@ -6,6 +6,8 @@ module Rendering (
|
|||||||
iconToPort,
|
iconToPort,
|
||||||
iconToIcon,
|
iconToIcon,
|
||||||
iconToIconEnds,
|
iconToIconEnds,
|
||||||
|
iconHeadToPort,
|
||||||
|
iconTailToPort,
|
||||||
toNames,
|
toNames,
|
||||||
renderDrawing
|
renderDrawing
|
||||||
) where
|
) where
|
||||||
@ -41,7 +43,7 @@ mapFst f = map (\(x, y) -> (f x, y))
|
|||||||
toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
|
toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
|
||||||
toNames = mapFst toName
|
toNames = mapFst toName
|
||||||
|
|
||||||
noEnds = (NoEnd, NoEnd)
|
noEnds = (EndNone, EndNone)
|
||||||
|
|
||||||
--portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> Edge
|
--portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> Edge
|
||||||
portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> 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 :: (IsName a, IsName b) => a -> EdgeEnd -> b -> EdgeEnd -> Edge
|
||||||
iconToIconEnds a b c d = Edge (toName a, Nothing, toName c, Nothing) (b, d)
|
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 :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v ()
|
||||||
edgesToGraph names edges = mkGraph names simpleEdges
|
edgesToGraph names edges = mkGraph names simpleEdges
|
||||||
where
|
where
|
||||||
@ -73,27 +79,28 @@ getArrowOpts :: (RealFloat n, Typeable n) => (EdgeEnd, EdgeEnd) -> ArrowOpts n
|
|||||||
getArrowOpts (t, h) = arrowOptions
|
getArrowOpts (t, h) = arrowOptions
|
||||||
where
|
where
|
||||||
lookupEnd :: (RealFloat n, Typeable n) => EdgeEnd -> ArrowOpts n -> ArrowOpts n
|
lookupEnd :: (RealFloat n, Typeable n) => EdgeEnd -> ArrowOpts n -> ArrowOpts n
|
||||||
lookupEnd NoEnd = id
|
lookupEnd EndNone = id
|
||||||
lookupEnd Ap1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan)
|
lookupEnd EndAp1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan)
|
||||||
lookupEnd Ap1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan)
|
lookupEnd EndAp1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan)
|
||||||
arrowOptions =
|
arrowOptions =
|
||||||
with & arrowHead .~ noHead
|
with & arrowHead .~ noHead
|
||||||
& arrowTail .~ noTail
|
& arrowTail .~ noTail
|
||||||
|
& lengths .~ large
|
||||||
& shaftStyle %~ lwG defaultLineWidth . lc white
|
& shaftStyle %~ lwG defaultLineWidth . lc white
|
||||||
& (lookupEnd t) & (lookupEnd h)
|
& (lookupEnd t) & (lookupEnd h)
|
||||||
|
|
||||||
plainLine = getArrowOpts (NoEnd, NoEnd)
|
plainLine = getArrowOpts (EndNone, EndNone)
|
||||||
|
|
||||||
connectMaybePorts :: Edge -> Diagram B -> Diagram B
|
connectMaybePorts :: Edge -> Diagram B -> Diagram B
|
||||||
connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) _) =
|
connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) ends) =
|
||||||
connect'
|
connect'
|
||||||
plainLine
|
(getArrowOpts ends)
|
||||||
(icon0 .> port0)
|
(icon0 .> port0)
|
||||||
(icon1 .> port1)
|
(icon1 .> port1)
|
||||||
connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) _) =
|
connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) ends) =
|
||||||
connectOutside' plainLine icon0 (icon1 .> port1)
|
connectOutside' (getArrowOpts ends) icon0 (icon1 .> port1)
|
||||||
connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) _) =
|
connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) ends) =
|
||||||
connectOutside' plainLine (icon0 .> port0) icon1
|
connectOutside' (getArrowOpts ends) (icon0 .> port0) icon1
|
||||||
connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) ends) =
|
connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) ends) =
|
||||||
connectOutside' (getArrowOpts ends) icon0 icon1
|
connectOutside' (getArrowOpts ends) icon0 icon1
|
||||||
|
|
||||||
|
@ -19,7 +19,7 @@ type Connection = (Name, Maybe Int, Name, Maybe Int)
|
|||||||
-- and the name of the destination icon, and its optional port number.
|
-- and the name of the destination icon, and its optional port number.
|
||||||
data Edge = Edge {edgeConnection :: Connection, edgeEnds :: (EdgeEnd, EdgeEnd)}
|
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,
|
-- | A drawing is a map from names to Icons, a list of edges,
|
||||||
-- and a map of names to subDrawings
|
-- and a map of names to subDrawings
|
||||||
|
Loading…
Reference in New Issue
Block a user