Give lines a shadow effect.

This commit is contained in:
Robbie Gleichman 2019-01-19 11:41:54 -08:00
parent 54ed0dda18
commit b21ff534e8
2 changed files with 17 additions and 6 deletions

View File

@ -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)

View File

@ -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.