diff --git a/app/Icons.hs b/app/Icons.hs index 6fd65ee..3195496 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -10,7 +10,9 @@ module Icons connectPorts, connectIconToPort, connectIconToIcon, - textBox + textBox, + enclosure, + lambdaRegion ) where import Diagrams.Prelude @@ -78,11 +80,10 @@ apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams apply0Icon :: Icon B apply0Icon = Icon apply0Dia verts +makePort x = mempty # named (PortName x) + makePortDiagrams points = atPoints points (map makePort [0,1..]) - where - --makePort x = (circle 0.2 # fc green) # named (PortName x) - makePort x = mempty # named (PortName x) verts = map p2 [ (circleRadius + apply0LineWidth + triangleWidth, 0), @@ -97,11 +98,30 @@ verts = map p2 [ textBoxFontSize = 1 monoLetterWidthToHeightFraction = 0.6 textBoxHeightFactor = 1.1 + textBox :: String -> Diagram B -textBox t = - text t # fc white # font "freemono" # bold # fontSize (local textBoxFontSize) - <> rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) # lc white +textBox = coloredTextBox white $ opaque white + +-- Since the normal SVG text has no size, some hackery is needed to determine +-- the size of the text's bounding box. +coloredTextBox textColor boxColor t = + text t # fc textColor # font "freemono" # bold # fontSize (local textBoxFontSize) + <> rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) # lcA boxColor where rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction * fromIntegral (length t) + (textBoxFontSize * 0.2) + +-- ENCLOSING REGION -- +enclosure dia = dia <> boundingRect (dia # frame 0.5) # lc red # lwG defaultLineWidth + +-- LAMBDA ICON -- +-- Don't use === here to put the port under the text box since mempty will stay +-- at the origin of the text box. +lambdaIcon x = coloredTextBox lime transparent "λ" # alignB <> makePort x + +-- LAMBDA REGION -- + +-- | lambdaRegion takes as an argument the numbers of parameters to the lambda, +-- and draws the diagram inside a region with the lambda icons on top. +lambdaRegion n dia = hsep 0.4 (take n (map lambdaIcon [0,1..])) # center === enclosure dia diff --git a/app/Main.hs b/app/Main.hs index 45cadc5..11d18cf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,7 +19,13 @@ fromAtoB = ex3 # connectPorts "A" (PortName 0) "B" (PortName 2) ex4 = apply0A ||| textBox "hello world" === textBox "1" === textBox "gpq" === textBox ['A'..'Z'] ex5 = textBox "baz" # named "baz"||| hrule 1 ||| fromAtoB ||| hrule 1 ||| textBox "foo" # named "foo" === vrule 1 === textBox "bar" # named "bar" ex6 = ex5 # connectIconToPort "baz" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0) - # connectIconToPort "bar" "B" (PortName 3) + # connectIconToPort "bar" "B" (PortName 3) # centerXY +ex7 = ex6 # center # showOrigin # showEnvelope +--ex8 = ex6 <> boundingRect (ex6 # frame 0.5) # lc blue # lw veryThick +ex8 = enclosure ex6 +ex9 = lambdaRegion 3 ex6 # nameDiagram "lam0" +ex10 = ex9 # connectPorts ("lam0" .> "A") (PortName 1) "lam0" (PortName 0) + # connectPorts ("lam0" .> "B") (PortName 1) "lam0" (PortName 2) main :: IO () -main = mainWith (ex6 # frame 0.1 # bg black) +main = mainWith (ex10 # bgFrame 0.1 black) diff --git a/notes.txt b/notes.txt index 2edb5e9..e9a03fe 100644 --- a/notes.txt +++ b/notes.txt @@ -1,9 +1,10 @@ to run: Using Atom, in a terminal run -stack exec glance-exe -- -l -s app/Main.hs -o circle.svg +cd app +stack exec glance-exe -- -l -s Main.hs -o ../output.svg or if that does not work -stack build --exec "glance-exe -o circle.svg -w 500" +stack build --exec "glance-exe -o output.svg -w 500" View circle.svg with svg-preview plug-in.