mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-27 03:02:44 +03:00
Use arrow heads and tails for factorial.
This commit is contained in:
Robbie Gleichman
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
|
||||
|
||||
-- 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
|
||||
|
||||
49
app/Main.hs
49
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)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user