mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-29 21:40:48 +03:00
Give lines a shadow effect.
This commit is contained in:
parent
54ed0dda18
commit
b21ff534e8
@ -17,6 +17,7 @@ import Diagrams.Prelude(toName, shaftStyle, global, arrowShaft, noTail
|
|||||||
, connectOutside', connect', with, (%~), lengths, (^+^)
|
, connectOutside', connect', with, (%~), lengths, (^+^)
|
||||||
, (.~))
|
, (.~))
|
||||||
import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
|
import Diagrams.TwoD.GraphViz(mkGraph, getGraph, layoutGraph')
|
||||||
|
import qualified Diagrams.Prelude as DIA
|
||||||
|
|
||||||
import qualified Data.GraphViz as GV
|
import qualified Data.GraphViz as GV
|
||||||
import qualified Data.GraphViz.Attributes.Complete as GVA
|
import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||||
@ -94,12 +95,12 @@ getArrowOpts :: (RealFloat n, Typeable n) =>
|
|||||||
-> [EdgeOption]
|
-> [EdgeOption]
|
||||||
-> (Angle n, Angle n)
|
-> (Angle n, Angle n)
|
||||||
-> NameAndPort
|
-> NameAndPort
|
||||||
-> ArrowOpts n
|
-> (ArrowOpts n, DIA.Colour Double)
|
||||||
getArrowOpts (t, h)
|
getArrowOpts (t, h)
|
||||||
_
|
_
|
||||||
(fromAngle, toAngle)
|
(fromAngle, toAngle)
|
||||||
(NameAndPort (NodeName nodeNum) mPort)
|
(NameAndPort (NodeName nodeNum) mPort)
|
||||||
= arrowOptions
|
= (arrowOptions, shaftColor)
|
||||||
where
|
where
|
||||||
-- shaftColor = if EdgeInPattern `elem` opts
|
-- shaftColor = if EdgeInPattern `elem` opts
|
||||||
-- then patternC colorScheme
|
-- then patternC colorScheme
|
||||||
@ -121,7 +122,6 @@ getArrowOpts (t, h)
|
|||||||
arrowTail .~ noTail $
|
arrowTail .~ noTail $
|
||||||
arrowShaft .~ bezierShaft fromAngle toAngle $
|
arrowShaft .~ bezierShaft fromAngle toAngle $
|
||||||
lengths .~ global 0.75 $
|
lengths .~ global 0.75 $
|
||||||
shaftStyle %~ (lwG (2 * defaultLineWidth) . lc shaftColor) $
|
|
||||||
lookupHead h $ lookupTail t with
|
lookupHead h $ lookupTail t with
|
||||||
|
|
||||||
-- | Given an Edge, return a transformation on Diagrams that will draw a line.
|
-- | Given an Edge, return a transformation on Diagrams that will draw a line.
|
||||||
@ -132,8 +132,21 @@ connectMaybePorts portAngles
|
|||||||
opts
|
opts
|
||||||
ends
|
ends
|
||||||
(fromNamePort@(NameAndPort name0 mPort1), NameAndPort name1 mPort2))
|
(fromNamePort@(NameAndPort name0 mPort1), NameAndPort name1 mPort2))
|
||||||
= connectFunc (getArrowOpts ends opts portAngles fromNamePort) qPort0 qPort1
|
-- In order to give arrows a "shadow" effect, draw a thicker semi-transparent
|
||||||
|
-- line shaft the same color as the background underneath the normal line
|
||||||
|
-- shaft.
|
||||||
|
= connectFunc normalOpts qPort0 qPort1
|
||||||
|
. connectFunc arrOptsShadow qPort0 qPort1
|
||||||
where
|
where
|
||||||
|
lineWidth = 2 * defaultLineWidth
|
||||||
|
(baseArrOpts, shaftCol) = getArrowOpts ends opts portAngles fromNamePort
|
||||||
|
normalOpts = (shaftStyle %~ (lwG lineWidth . lc shaftCol))
|
||||||
|
baseArrOpts
|
||||||
|
arrOptsShadow = (shaftStyle
|
||||||
|
%~ (lwG (1.9 * lineWidth)
|
||||||
|
. DIA.lcA
|
||||||
|
$ DIA.withOpacity (backgroundC colorScheme) 0.5))
|
||||||
|
baseArrOpts
|
||||||
(connectFunc, qPort0, qPort1) = case (mPort1, mPort2) of
|
(connectFunc, qPort0, qPort1) = case (mPort1, mPort2) of
|
||||||
(Just port0, Just port1) -> (connect', name0 .> port0, name1 .> port1)
|
(Just port0, Just port1) -> (connect', name0 .> port0, name1 .> port1)
|
||||||
(Nothing, Just port1) -> (connectOutside', toName name0, name1 .> port1)
|
(Nothing, Just port1) -> (connectOutside', toName name0, name1 .> port1)
|
||||||
|
2
todo.md
2
todo.md
@ -19,8 +19,6 @@
|
|||||||
|
|
||||||
* Make an icon font/library with labeled ports. E.g. the apply icon would have text labels "function", "result", "arg 0", "arg 1", etc.
|
* Make an icon font/library with labeled ports. E.g. the apply icon would have text labels "function", "result", "arg 0", "arg 1", etc.
|
||||||
|
|
||||||
* Try giving lines a black border to make line crossings easier to see.
|
|
||||||
|
|
||||||
### Translate todos
|
### Translate todos
|
||||||
* Fix applyComposeScore in Translate.hs not counting expressions that nest via reference. May need to move compose generation to after translate.
|
* Fix applyComposeScore in Translate.hs not counting expressions that nest via reference. May need to move compose generation to after translate.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user