mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Add lambda icons and lambda regions.
This commit is contained in:
parent
0baabe8573
commit
65e4a49d05
34
app/Icons.hs
34
app/Icons.hs
@ -10,7 +10,9 @@ module Icons
|
|||||||
connectPorts,
|
connectPorts,
|
||||||
connectIconToPort,
|
connectIconToPort,
|
||||||
connectIconToIcon,
|
connectIconToIcon,
|
||||||
textBox
|
textBox,
|
||||||
|
enclosure,
|
||||||
|
lambdaRegion
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Diagrams.Prelude
|
import Diagrams.Prelude
|
||||||
@ -78,11 +80,10 @@ apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams
|
|||||||
apply0Icon :: Icon B
|
apply0Icon :: Icon B
|
||||||
apply0Icon = Icon apply0Dia verts
|
apply0Icon = Icon apply0Dia verts
|
||||||
|
|
||||||
|
makePort x = mempty # named (PortName x)
|
||||||
|
|
||||||
makePortDiagrams points =
|
makePortDiagrams points =
|
||||||
atPoints points (map makePort [0,1..])
|
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 [
|
verts = map p2 [
|
||||||
(circleRadius + apply0LineWidth + triangleWidth, 0),
|
(circleRadius + apply0LineWidth + triangleWidth, 0),
|
||||||
@ -97,11 +98,30 @@ verts = map p2 [
|
|||||||
textBoxFontSize = 1
|
textBoxFontSize = 1
|
||||||
monoLetterWidthToHeightFraction = 0.6
|
monoLetterWidthToHeightFraction = 0.6
|
||||||
textBoxHeightFactor = 1.1
|
textBoxHeightFactor = 1.1
|
||||||
|
|
||||||
textBox :: String -> Diagram B
|
textBox :: String -> Diagram B
|
||||||
textBox t =
|
textBox = coloredTextBox white $ opaque white
|
||||||
text t # fc white # font "freemono" # bold # fontSize (local textBoxFontSize)
|
|
||||||
<> rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) # lc 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
|
where
|
||||||
rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction
|
rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction
|
||||||
* fromIntegral (length t)
|
* fromIntegral (length t)
|
||||||
+ (textBoxFontSize * 0.2)
|
+ (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
|
||||||
|
10
app/Main.hs
10
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']
|
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"
|
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)
|
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 :: IO ()
|
||||||
main = mainWith (ex6 # frame 0.1 # bg black)
|
main = mainWith (ex10 # bgFrame 0.1 black)
|
||||||
|
@ -1,9 +1,10 @@
|
|||||||
to run:
|
to run:
|
||||||
Using Atom, in a terminal 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
|
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.
|
View circle.svg with svg-preview plug-in.
|
||||||
|
Loading…
Reference in New Issue
Block a user