mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-16 18:30:36 +03:00
clean up main. Make arrows slightly smaller.
This commit is contained in:
parent
e2e541a5dc
commit
b68a9c88d1
199
app/Main.hs
199
app/Main.hs
@ -3,24 +3,17 @@ module Main where
|
||||
|
||||
import Diagrams.Prelude
|
||||
import Diagrams.Backend.SVG.CmdLine
|
||||
import Diagrams.TwoD.GraphViz
|
||||
|
||||
import Data.GraphViz
|
||||
import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||
import Data.GraphViz.Commands
|
||||
import Data.Map((!))
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import Data.Typeable(Typeable)
|
||||
|
||||
import Lib
|
||||
import Icons(apply0Dia, apply0NDia, guardIcon, colorScheme, ColorStyle(..))
|
||||
import Icons(guardIcon, colorScheme, ColorStyle(..))
|
||||
import Rendering(toNames, portToPort, iconToPort, iconToIcon,
|
||||
iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
|
||||
import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||
|
||||
-- TODO Now --
|
||||
-- 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: consider moving portToPort etc. to a new file
|
||||
|
||||
@ -33,83 +26,58 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||
-- todo: layout and rotate considering external connections.
|
||||
-- todo: figure out local vs. global icon positions
|
||||
|
||||
|
||||
applyDia = apply0Dia
|
||||
-- --apply0A = "A" .>> applyDia
|
||||
-- apply0A = applyDia # nameDiagram "A"
|
||||
-- apply0B = applyDia # nameDiagram "B"
|
||||
-- result = resultIcon # named "res"
|
||||
-- fooBox = textBox "foo" # named "foo"
|
||||
-- barBox = textBox "bar" # named "bar"
|
||||
|
||||
-- ex1 = drawIconAndPorts apply0Icon
|
||||
-- ex2 = drawIconsAndPortNumbers apply0Icon
|
||||
--ex3 = atPoints (map p2 [(0,0), (3,0)]) [apply0A, apply0B]
|
||||
|
||||
-- fromAtoB = ex3 # connectPorts "A" (PortName 0) "B" (PortName 2)
|
||||
--ex4 = apply0A ||| textBox "hello world" === textBox "1" === textBox "gpq" === textBox ['A'..'Z']
|
||||
|
||||
-- ex5 = resultIcon # named "res"||| hrule 1 ||| fromAtoB ||| hrule 1 ||| textBox "foo" # named "foo" === vrule 1 === textBox "bar" # named "bar"
|
||||
-- ex6 = ex5 # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
|
||||
-- # connectIconToPort "bar" "B" (PortName 3) # centerXY
|
||||
--
|
||||
-- ex7 = ex6 # center # showOrigin # showEnvelope
|
||||
-- ex8 = enclosure ex6
|
||||
-- ex9 = lambdaRegion 3 ex6 "lam0"
|
||||
-- ex10 = ex9 # connectPorts ("lam0" .> "A") (PortName 1) "lam0" (PortName 0)
|
||||
-- # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2)
|
||||
-- ex11 = connectIcons "lam0" "y" $ ex10 === vrule 2 === textBox "y" # named "y"
|
||||
|
||||
(d0A, d0B, d0Res, d0Foo, d0Bar) = ("A", "B", "res", "foo", "bar")
|
||||
d0Icons = toNames
|
||||
[("A", Apply0Icon),
|
||||
("B", Apply0Icon),
|
||||
("res", ResultIcon),
|
||||
("foo", TextBoxIcon "foo"),
|
||||
("bar", TextBoxIcon "bar")
|
||||
[(d0A, Apply0Icon),
|
||||
(d0B, Apply0Icon),
|
||||
(d0Res, ResultIcon),
|
||||
(d0Foo, TextBoxIcon d0Foo),
|
||||
(d0Bar, TextBoxIcon d0Bar)
|
||||
]
|
||||
|
||||
d0Edges =
|
||||
[
|
||||
portToPort "A" 0 "B" 2,
|
||||
iconToPort "foo" "B" 0,
|
||||
iconToPort "res" "A" 2,
|
||||
iconToPort "foo" "B" 0,
|
||||
iconToPort "bar" "B" 3,
|
||||
iconToPort "bar" "A" 3
|
||||
portToPort d0A 0 d0B 2,
|
||||
iconToPort d0Foo d0B 0,
|
||||
iconToPort d0Res d0A 2,
|
||||
iconToPort d0Foo d0B 0,
|
||||
iconToPort d0Bar d0B 3,
|
||||
iconToPort d0Bar d0A 3
|
||||
]
|
||||
|
||||
drawing0 = Drawing d0Icons d0Edges []
|
||||
d0Name = toName "d0"
|
||||
|
||||
superEdges =
|
||||
[
|
||||
portToPort ("lam0" .> "A") 1 "lam0" 0,
|
||||
iconToIcon "y" "lam0",
|
||||
iconToIcon "z" "lam0",
|
||||
iconToIcon "q" "lam0",
|
||||
iconToIcon "A" "z",
|
||||
iconToPort ("lam0" .> "foo" .> "foo") "lam0" 0
|
||||
(s1Lam, s1y, s1z, s1q) = ("lam0", "y", "z", "q")
|
||||
superIcons = toNames [
|
||||
(s1Lam, LambdaRegionIcon 3 d0Name),
|
||||
(s1y, TextBoxIcon s1y),
|
||||
(s1z, TextBoxIcon s1z),
|
||||
(s1q, TextBoxIcon s1q)
|
||||
]
|
||||
|
||||
superIcons = toNames [
|
||||
("lam0", LambdaRegionIcon 3 d0Name),
|
||||
("y", TextBoxIcon "y"),
|
||||
("z", TextBoxIcon "z"),
|
||||
("q", TextBoxIcon "q")
|
||||
superEdges =
|
||||
[
|
||||
portToPort (s1Lam .> d0A) 1 s1Lam 0,
|
||||
iconToIcon s1y s1Lam,
|
||||
iconToIcon s1z s1Lam,
|
||||
iconToIcon s1q s1Lam,
|
||||
iconToIcon d0A s1z,
|
||||
iconToPort (s1Lam .> d0Foo .> d0Foo) s1Lam 0
|
||||
]
|
||||
|
||||
--superDrawing = Drawing [((toName "lam0"), LambdaRegionIcon 3 (toName"d0"))] superEdges [((toName "d0"), drawing0)]
|
||||
superDrawing = Drawing superIcons superEdges [(d0Name, drawing0)]
|
||||
|
||||
super2Icons = toNames [
|
||||
("lam0", LambdaRegionIcon 1 d0Name),
|
||||
(s1Lam, LambdaRegionIcon 1 d0Name),
|
||||
--("y", TextBoxIcon "y"),
|
||||
("lam1", LambdaRegionIcon 2 d0Name)
|
||||
]
|
||||
|
||||
super2Edges =
|
||||
[
|
||||
iconToIcon "lam0" "lam1"
|
||||
iconToIcon s1Lam "lam1"
|
||||
--iconToIcon "y" "lam0"
|
||||
]
|
||||
|
||||
@ -117,47 +85,50 @@ super2Drawing = Drawing super2Icons super2Edges [(d0Name, drawing0)]
|
||||
super2Name = toName "s2"
|
||||
|
||||
super3Icons = toNames [
|
||||
("lam0", LambdaRegionIcon 3 d1Name),
|
||||
(s1Lam, LambdaRegionIcon 3 super2Name),
|
||||
--("y", TextBoxIcon "y"),
|
||||
("lam1", LambdaRegionIcon 4 d1Name)
|
||||
("lam1", LambdaRegionIcon 4 super2Name)
|
||||
]
|
||||
|
||||
super3Edges =
|
||||
[
|
||||
-- iconToIcon "lam0" "lam1",
|
||||
iconToIcon "lam0" "A"
|
||||
iconToIcon s1Lam "A"
|
||||
]
|
||||
d1Name = toName "d1"
|
||||
super3Drawing = Drawing super3Icons super2Edges [(d1Name, super2Drawing)]
|
||||
|
||||
super3Drawing = Drawing super3Icons super2Edges [(super2Name, super2Drawing)]
|
||||
|
||||
(fG0, fOne, fEq0, fMinus1, fEq0Ap, fMinus1Ap, fTimes, fRecurAp, fTimesAp, fArg, fRes) =
|
||||
("g0", "one", "eq0", "-1", "eq0Ap", "-1Ap", "*", "recurAp", "*Ap", "arg", "res")
|
||||
|
||||
fact0Icons = toNames
|
||||
[
|
||||
("g0", GuardIcon 2),
|
||||
("one", TextBoxIcon "1"),
|
||||
("eq0", TextBoxIcon "== 0"),
|
||||
("-1", TextBoxIcon "-1"),
|
||||
("eq0Ap", Apply0Icon),
|
||||
("-1Ap", Apply0Icon),
|
||||
("*", TextBoxIcon "*"),
|
||||
("recurAp", Apply0Icon),
|
||||
("*Ap", Apply0NIcon 2),
|
||||
("arg", BranchIcon),
|
||||
("res", ResultIcon)
|
||||
(fG0, GuardIcon 2),
|
||||
(fOne, TextBoxIcon "1"),
|
||||
(fEq0, TextBoxIcon "== 0"),
|
||||
(fMinus1, TextBoxIcon fMinus1),
|
||||
(fEq0Ap, Apply0Icon),
|
||||
(fMinus1Ap, Apply0Icon),
|
||||
(fTimes, TextBoxIcon fTimes),
|
||||
(fRecurAp, Apply0Icon),
|
||||
(fTimesAp, Apply0NIcon 2),
|
||||
(fArg, BranchIcon),
|
||||
(fRes, ResultIcon)
|
||||
]
|
||||
|
||||
fact0Edges = [
|
||||
iconToPort "eq0" "eq0Ap" 0,
|
||||
portToPort "eq0Ap" 2 "g0" 3,
|
||||
iconToPort "-1" "-1Ap" 0,
|
||||
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
|
||||
iconToPort fEq0 fEq0Ap 0,
|
||||
portToPort fEq0Ap 2 fG0 3,
|
||||
iconToPort fMinus1 fMinus1Ap 0,
|
||||
iconToPort fTimes fTimesAp 0,
|
||||
iconToPort fOne fG0 2,
|
||||
portToPort fTimesAp 1 fG0 4,
|
||||
portToPort fRecurAp 2 fTimesAp 3,
|
||||
iconToPort fArg fEq0Ap 1,
|
||||
iconToPort fArg fMinus1Ap 1,
|
||||
iconToPort fArg fTimesAp 2,
|
||||
portToPort fMinus1Ap 2 fRecurAp 1,
|
||||
iconToPort fRes fG0 0
|
||||
]
|
||||
|
||||
fact0Drawing = Drawing fact0Icons fact0Edges []
|
||||
@ -169,8 +140,8 @@ factLam0Icons = toNames [
|
||||
]
|
||||
|
||||
factLam0Edges = [
|
||||
iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0,
|
||||
iconToPort "lam0" ("lam0" .> "recurAp") 0,
|
||||
iconToPort ("lam0" .> fArg .> fArg) "lam0" 0,
|
||||
iconToPort "lam0" ("lam0" .> fRecurAp) 0,
|
||||
iconToIcon "lam0" "fac"
|
||||
]
|
||||
|
||||
@ -178,42 +149,34 @@ 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)
|
||||
(fG0, GuardIcon 2),
|
||||
(fOne, TextBoxIcon "1"),
|
||||
(fEq0, TextBoxIcon "== 0"),
|
||||
(fMinus1, TextBoxIcon fMinus1),
|
||||
(fTimes, TextBoxIcon fTimes),
|
||||
(fRecurAp, Apply0Icon),
|
||||
(fTimesAp, Apply0NIcon 2),
|
||||
(fArg, BranchIcon),
|
||||
(fRes, ResultIcon)
|
||||
]
|
||||
|
||||
fact1Edges = [
|
||||
iconToIconEnds "arg" EndNone "eq0" EndAp1Arg,
|
||||
iconTailToPort "eq0" EndAp1Result "g0" 3,
|
||||
iconToIconEnds "arg" EndNone "-1" EndAp1Arg,
|
||||
iconTailToPort "-1" EndAp1Result "recurAp" 1,
|
||||
iconToPort "*" "*Ap" 0,
|
||||
iconToPort "one" "g0" 2,
|
||||
portToPort "*Ap" 1 "g0" 4,
|
||||
portToPort "recurAp" 2 "*Ap" 3,
|
||||
iconToPort "arg" "*Ap" 2,
|
||||
iconToPort "res" "g0" 0
|
||||
iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
|
||||
iconTailToPort fEq0 EndAp1Result fG0 3,
|
||||
iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
|
||||
iconTailToPort fMinus1 EndAp1Result fRecurAp 1,
|
||||
iconToPort fTimes fTimesAp 0,
|
||||
iconToPort fOne fG0 2,
|
||||
portToPort fTimesAp 1 fG0 4,
|
||||
portToPort fRecurAp 2 fTimesAp 3,
|
||||
iconToPort fArg fTimesAp 2,
|
||||
iconToPort fRes fG0 0
|
||||
]
|
||||
|
||||
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)
|
||||
-- # connectIconToPort "bar" "B" (PortName 3) # connectPorts "A" (PortName 0) "B" (PortName 2)
|
||||
-- # connectIconToPort "bar" "A" (PortName 3)
|
||||
|
||||
--main1 = mainWith (ex11 # bgFrame 0.1 black)
|
||||
|
||||
main1 :: IO ()
|
||||
main1 = do
|
||||
placedNodes <- renderDrawing factLam1Drawing
|
||||
|
@ -86,7 +86,7 @@ getArrowOpts (t, h) = arrowOptions
|
||||
arrowOptions =
|
||||
with & arrowHead .~ noHead
|
||||
& arrowTail .~ noTail
|
||||
& lengths .~ large
|
||||
& lengths .~ normalized 0.04
|
||||
& shaftStyle %~ lwG defaultLineWidth . lc (lineC colorScheme)
|
||||
& lookupEnd t & lookupEnd h
|
||||
|
||||
|
File diff suppressed because one or more lines are too long
Before Width: | Height: | Size: 24 KiB After Width: | Height: | Size: 24 KiB |
Loading…
Reference in New Issue
Block a user