From 8fbf4f1909a643af3a9b5b944ed4923b7a22f683 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Thu, 8 May 2014 21:36:40 -0400 Subject: [PATCH 1/8] Rewrite arrowheads to be a function of head length --- src/Diagrams/TwoD/Arrow.hs | 14 ++- src/Diagrams/TwoD/Arrowheads.hs | 162 ++++++++++++-------------------- 2 files changed, 69 insertions(+), 107 deletions(-) diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index 7499b001..60653e7b 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -281,13 +281,17 @@ xWidth p = a + b b = fromMaybe 0 (magnitude <$> traceV origin unit_X p) -- | Get the line color from the shaft to use as the fill color for the joint. +-- And set the opacity of the shaft to the current opacity. colorJoint :: Style R2 -> Style R2 colorJoint sStyle = - let c = fmap getLineColor . getAttr $ sStyle in - case c of - Nothing -> fillColor (black :: Colour Double) -- default color for joints - $ mempty - Just c' -> fillColor c' $ mempty + let c = fmap getLineColor . getAttr $ sStyle + o = fmap getOpacity . getAttr $ sStyle + in + case (c, o) of + (Nothing, Nothing) -> fillColor (black :: Colour Double) $ mempty + (Just c', Nothing) -> fillColor c' $ mempty + (Nothing, Just o') -> opacity o' $ mempty + (Just c', Just o') -> opacity o' . fillColor c' $ mempty -- | Get line width from a style. widthOfJoint :: Style v -> Double -> Double -> Double diff --git a/src/Diagrams/TwoD/Arrowheads.hs b/src/Diagrams/TwoD/Arrowheads.hs index 95357789..8167a02c 100644 --- a/src/Diagrams/TwoD/Arrowheads.hs +++ b/src/Diagrams/TwoD/Arrowheads.hs @@ -22,7 +22,6 @@ module Diagrams.TwoD.Arrowheads , dart , spike , thorn - , missile , lineHead , noHead @@ -34,7 +33,6 @@ module Diagrams.TwoD.Arrowheads , arrowheadDart , arrowheadSpike , arrowheadThorn - , arrowheadMissile -- * Arrow tails -- ** Standard arrow tails @@ -42,7 +40,6 @@ module Diagrams.TwoD.Arrowheads , dart' , spike' , thorn' - , missile' , lineTail , noTail , quill @@ -57,7 +54,7 @@ module Diagrams.TwoD.Arrowheads , ArrowHT ) where -import Control.Lens ((&), (.~)) +import Control.Lens ((&), (.~), (^.)) import Data.AffineSpace import Data.Default.Class import Data.Functor ((<$>)) @@ -67,10 +64,13 @@ import Data.VectorSpace import Diagrams.Angle import Diagrams.Core + +import Diagrams.Coordinates ((^&)) import Diagrams.CubicSpline (cubicSpline) import Diagrams.Path import Diagrams.Segment import Diagrams.Trail +import Diagrams.TrailLike (fromOffsets) import Diagrams.TwoD.Align import Diagrams.TwoD.Arc (arc') import Diagrams.TwoD.Path () @@ -78,7 +78,7 @@ import Diagrams.TwoD.Polygons import Diagrams.TwoD.Shapes import Diagrams.TwoD.Transform import Diagrams.TwoD.Types -import Diagrams.TwoD.Vector (e, unitX, unit_X) +import Diagrams.TwoD.Vector (fromDirection, direction, e, unitX, unit_X) import Diagrams.Util (( # )) ----------------------------------------------------------------------------- @@ -91,9 +91,6 @@ htRadius = 0.5 scaleR :: (Transformable t, Scalar (V t) ~ Double) => t -> t scaleR = scale htRadius -unit_X2 :: R2 -unit_X2 = scaleR unit_X - closedPath :: (Floating (Scalar v), Ord (Scalar v), InnerSpace v) => Trail v -> Path v closedPath = pathFromTrail . closeTrail @@ -112,105 +109,78 @@ closedPath = pathFromTrail . closeTrail arrowheadTriangle :: Angle -> ArrowHT arrowheadTriangle theta = aHead where - aHead size _ = (p, mempty) + aHead len _ = (p, mempty) where + psi = pi - (theta ^. rad) + r = len / (1 + cos psi) p = polygon (def & polyType .~ PolyPolar [theta, (negateV 2 *^ theta)] - (repeat (htRadius * size)) & polyOrient .~ NoOrient) # alignL + (repeat r) & polyOrient .~ NoOrient) # alignL + -- | Isoceles triangle with linear concave base. Inkscape type 1 - dart like. arrowheadDart :: Angle -> ArrowHT -arrowheadDart theta = aHead +arrowheadDart theta len shaftWidth = (hd # scale size, jt) where - aHead size shaftWidth = (dartP # moveOriginTo (dartVertices !! 2), joint) - where - r = htRadius * size - dartP = polygon - ( def & polyType .~ PolyPolar [theta, (1/2 @@ turn) ^-^ theta, (1/2 @@ turn) ^-^ theta] - [r, r, 0.1 * size, r] - & polyOrient .~ NoOrient - ) - dartVertices = (concat . pathVertices) $ dartP - m = magnitude (dartVertices !! 1 .-. dartVertices !! 3) - s = 1 - shaftWidth / m - v1 = if s > 0 then (dartVertices !! 1 .-. dartVertices !! 2) # scale s else zeroV - v2 = if s > 0 then (dartVertices !! 3 .-. dartVertices !! 2) # scale s else zeroV - joint = (closedPath $ trailFromVertices [ dartVertices !! 2 - , dartVertices !! 1 .-^ v1 - , dartVertices !! 3 .-^ v2 - , dartVertices !! 2 ]) # alignR + hd = snugL . pathFromTrail . glueTrail $ fromOffsets [t1, t2, b2, b1] + jt = pathFromTrail . glueTrail $ j <> reflectY j + j = closeTrail $ fromOffsets [(-jLength ^& 0), (0 ^& shaftWidth / 2)] + v = fromDirection theta + (t1, t2) = (unit_X ^+^ v, (-0.5 ^& 0) ^-^ v) + [b1, b2] = map (reflectY . negateV) [t1, t2] + psi = pi - (direction . negateV $ t2) ^. rad + jLength = shaftWidth / (2 * tan psi) + + -- If the shaft if too wide, set the size to a default value of 1. + size = max 1 ((len - jLength) / (1.5)) -- | Isoceles triangle with curved concave base. Inkscape type 2. -arrowheadSpike :: Angle -> ArrowHT -arrowheadSpike theta = aHead +arrowheadSpike :: ArrowHT +arrowheadSpike len shaftWidth = (hd # scale r, jt # scale r) where - aHead size shaftWidth = (barb # moveOriginBy (m *^ unit_X) , joint) - where - a = e theta # scaleR - a' = reflectY a - l1 = trailFromSegments [straight (unit_X2 ^+^ a)] - l2 = trailFromSegments [reverseSegment . straight $ (unit_X2 ^+^ a')] - c = reflectX $ arc' htRadius theta (negateV theta) - barb = (closedPath $ (l1 <> c <> l2)) # scale size - m = xWidth barb - sinb = (shaftWidth / 2) / (htRadius * size) - b = if sinb < 1 then asin sinb @@ rad else pi/2 @@ rad - c' = arc' htRadius (negateV b) b # scale size - joint = (closedPath $ (c')) # centerY # alignR - xWidth p = pa + pb - where - pa = fromMaybe 0 (magnitude <$> traceV origin unitX p) - pb = fromMaybe 0 (magnitude <$> traceV origin unit_X p) + hd = snugL . closedPath $ l1 <> c <> l2 + jt = alignR . centerY . pathFromTrail + . closeTrail $ arc' 1 (negateV phi) phi + l1 = trailFromSegments [straight $ unit_X ^+^ v] + l2 = trailFromSegments [reverseSegment . straight $ (unit_X ^+^ (reflectY v))] + c = reflectX $ arc' 1 (a @@ rad) (-a @@ rad) + v = fromDirection (a @@ rad) + a = 2 * pi / 3 + x = shaftWidth / 2 + + -- If the shaft is too wide for the head, we default the radius r to + -- 2/3 * len by setting d=1 and phi=pi/2. + d = max 1 (len^2 - 3 * x^2) + r = 1/3 * (sqrt d + 2 * len) + phi = asin (min 1 (x/r)) @@ rad -- | Curved sides, linear concave base. Illustrator CS5 #3 -arrowheadThorn :: Angle -> Double -> ArrowHT -arrowheadThorn theta r = aHead +arrowheadThorn :: Angle -> ArrowHT +arrowheadThorn theta len shaftWidth = (hd # scale size, jt) where - aHead size shaftWidth = (thornP # moveOriginTo (thornVertices !! 2), joint) - where - a = e theta # scaleR - c1 = curvedSide theta - l1 = straight $ (reflectY a) ^-^ (unit_X2 # scale r) - l2 = straight $ unit_X2 # scale r ^-^ a - c2 = c1 # rotate (negateV theta) - thornP = (closedPath $ trailFromSegments [c1, l1, l2, c2]) # scale size - thornVertices = (concat . pathVertices) $ thornP - m = magnitude (thornVertices !! 1 .-. thornVertices !! 3) - s = 1 - shaftWidth / m - v1 = if s > 0 then (thornVertices !! 1 .-. thornVertices !! 2) # scale s else zeroV - v2 = if s > 0 then (thornVertices !! 3 .-. thornVertices !! 2) # scale s else zeroV - joint = (closedPath $ trailFromVertices [ thornVertices !! 2 - , thornVertices !! 1 .-^ v1 - , thornVertices !! 3 .-^ v2 - , thornVertices !! 2 ]) # alignR + hd = snugL . pathFromTrail . glueTrail $ hTop <> reflectY hTop + hTop = closeTrail . trailFromSegments $ [c, l] + jt = pathFromTrail . glueTrail $ j <> reflectY j + j = closeTrail $ fromOffsets [(-jLength ^& 0), (0 ^& shaftWidth / 2)] + c = curvedSide theta + v = fromDirection theta + l = reverseSegment . straight $ t + t = v ^-^ (-0.5 ^& 0) + psi = pi - (direction . negateV $ t) ^. rad + jLength = shaftWidth / (2 * tan psi) + + -- If the shaft if too wide, set the size to a default value of 1. + size = max 1 ((len - jLength) / (1.5)) -- | Make a side for the thorn head. curvedSide :: Angle -> Segment Closed R2 curvedSide theta = bezier3 ctrl1 ctrl2 end where - v0 = scaleR unit_X - v1 = e theta # scaleR - ctrl1 = v0 # scaleR - ctrl2 = v0 ^+^ (v1 # scaleR) + v0 = unit_X + v1 = fromDirection theta + ctrl1 = v0 + ctrl2 = v0 ^+^ v1 end = v0 ^+^ v1 --- | Transform an arrowhead/tail by fitting a cubic spline to it's vertices. --- XXX Rear vertices of the arrowhead will extend outside of the unit circle. --- XXX and the joint is a rectancgle as opposed to the correct shape. -smoothArrowhead :: ArrowHT -> ArrowHT -smoothArrowhead f = aHead - where - aHead size shaftWidth = (h, j) - where - (h', _) = f size shaftWidth - h = smooth $ pathVertices h' - -- XXX replace square joint with actual shape - j = square shaftWidth # scaleX 0.25 alignR - smooth [] = mempty - smooth (x:xs) = cubicSpline True x <> smooth xs - -arrowheadMissile :: Angle -> ArrowHT -arrowheadMissile theta = smoothArrowhead $ arrowheadDart theta - -- Standard heads --------------------------------------------------------- -- | A line the same width as the shaft. lineHead :: ArrowHT @@ -229,13 +199,13 @@ tri = arrowheadTriangle (1/3 @@ turn) -- > spikeEx = drawHead spike spike :: ArrowHT -spike = arrowheadSpike (3/8 @@ turn) +spike = arrowheadSpike -- | <> -- > thornEx = drawHead thorn thorn :: ArrowHT -thorn = arrowheadThorn (3/8 @@ turn) 1 +thorn = arrowheadThorn (3/8 @@ turn) -- | <> @@ -243,12 +213,6 @@ thorn = arrowheadThorn (3/8 @@ turn) 1 dart :: ArrowHT dart = arrowheadDart (2/5 @@ turn) --- | <> - --- > missileEx = drawHead missile -missile :: ArrowHT -missile = arrowheadMissile (2/5 @@ turn) - -- Tails ------------------------------------------------------------------ -- > drawTail t = arrowAt' (with & arrowTail .~ t & shaftStyle %~ lw 0 & arrowHead .~ noHead) -- > origin (r2 (0.001, 0)) @@ -331,12 +295,6 @@ thorn' = headToTail thorn dart' :: ArrowHT dart' = headToTail dart --- | <> - --- > missile'Ex = drawTail missile' -missile' :: ArrowHT -missile' = headToTail missile - -- | <> -- > quillEx = drawTail quill From 656c46efe152c95d478fc3824ee92683efb3a964 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Sat, 10 May 2014 10:34:32 -0400 Subject: [PATCH 2/8] generalize spike to arbitrary angles --- src/Diagrams/TwoD/Arrowheads.hs | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/Diagrams/TwoD/Arrowheads.hs b/src/Diagrams/TwoD/Arrowheads.hs index 8167a02c..b882190b 100644 --- a/src/Diagrams/TwoD/Arrowheads.hs +++ b/src/Diagrams/TwoD/Arrowheads.hs @@ -57,8 +57,6 @@ module Diagrams.TwoD.Arrowheads import Control.Lens ((&), (.~), (^.)) import Data.AffineSpace import Data.Default.Class -import Data.Functor ((<$>)) -import Data.Maybe (fromMaybe) import Data.Monoid (mempty, (<>)) import Data.VectorSpace @@ -66,7 +64,6 @@ import Diagrams.Angle import Diagrams.Core import Diagrams.Coordinates ((^&)) -import Diagrams.CubicSpline (cubicSpline) import Diagrams.Path import Diagrams.Segment import Diagrams.Trail @@ -78,7 +75,7 @@ import Diagrams.TwoD.Polygons import Diagrams.TwoD.Shapes import Diagrams.TwoD.Transform import Diagrams.TwoD.Types -import Diagrams.TwoD.Vector (fromDirection, direction, e, unitX, unit_X) +import Diagrams.TwoD.Vector (fromDirection, direction, e, unit_X) import Diagrams.Util (( # )) ----------------------------------------------------------------------------- @@ -134,24 +131,31 @@ arrowheadDart theta len shaftWidth = (hd # scale size, jt) size = max 1 ((len - jLength) / (1.5)) -- | Isoceles triangle with curved concave base. Inkscape type 2. -arrowheadSpike :: ArrowHT -arrowheadSpike len shaftWidth = (hd # scale r, jt # scale r) +arrowheadSpike :: Angle -> ArrowHT +arrowheadSpike theta len shaftWidth = (hd # scale r, jt # scale r) where hd = snugL . closedPath $ l1 <> c <> l2 jt = alignR . centerY . pathFromTrail . closeTrail $ arc' 1 (negateV phi) phi l1 = trailFromSegments [straight $ unit_X ^+^ v] l2 = trailFromSegments [reverseSegment . straight $ (unit_X ^+^ (reflectY v))] - c = reflectX $ arc' 1 (a @@ rad) (-a @@ rad) - v = fromDirection (a @@ rad) - a = 2 * pi / 3 - x = shaftWidth / 2 + c = reflectX $ arc' 1 theta (negateV theta) + v = fromDirection theta + + -- The length of the head without its joint is, -2r cos theta and + -- the length of the joint is r - sqrt (r^2 - y^2). So the total + -- length of the arrow head is given by r(1 - 2 cos theta)-sqrt (r^2-y^2). + -- Solving the quadratic gives two roots, we want the larger one. + + -- 1/4 turn < theta < 2/3 turn. + a = 1 - 2 * cos (theta ^. rad) + y = shaftWidth / 2 -- If the shaft is too wide for the head, we default the radius r to -- 2/3 * len by setting d=1 and phi=pi/2. - d = max 1 (len^2 - 3 * x^2) - r = 1/3 * (sqrt d + 2 * len) - phi = asin (min 1 (x/r)) @@ rad + d = max 1 (len**2 + (1 - a**2) * y**2) + r = (a * len + sqrt d) / (a**2 -1) + phi = asin (min 1 (y/r)) @@ rad -- | Curved sides, linear concave base. Illustrator CS5 #3 arrowheadThorn :: Angle -> ArrowHT @@ -199,7 +203,7 @@ tri = arrowheadTriangle (1/3 @@ turn) -- > spikeEx = drawHead spike spike :: ArrowHT -spike = arrowheadSpike +spike = arrowheadSpike (3/8 @@ turn) -- | <> From b3dd2b8a813032bfea9c7b10b2f097e19e98d755 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Sat, 10 May 2014 11:10:01 -0400 Subject: [PATCH 3/8] convert tails to be a function of length --- src/Diagrams/TwoD/Arrowheads.hs | 43 ++++++++++++++------------------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/src/Diagrams/TwoD/Arrowheads.hs b/src/Diagrams/TwoD/Arrowheads.hs index b882190b..c3756a2b 100644 --- a/src/Diagrams/TwoD/Arrowheads.hs +++ b/src/Diagrams/TwoD/Arrowheads.hs @@ -75,34 +75,28 @@ import Diagrams.TwoD.Polygons import Diagrams.TwoD.Shapes import Diagrams.TwoD.Transform import Diagrams.TwoD.Types -import Diagrams.TwoD.Vector (fromDirection, direction, e, unit_X) +import Diagrams.TwoD.Vector (fromDirection, direction, unit_X) import Diagrams.Util (( # )) ----------------------------------------------------------------------------- type ArrowHT = Double -> Double -> (Path R2, Path R2) -htRadius :: Double -htRadius = 0.5 - -scaleR :: (Transformable t, Scalar (V t) ~ Double) => t -> t -scaleR = scale htRadius - closedPath :: (Floating (Scalar v), Ord (Scalar v), InnerSpace v) => Trail v -> Path v closedPath = pathFromTrail . closeTrail -- Heads ------------------------------------------------------------------ --- > drawHead h = arrowAt' (with & arrowHead .~ h & shaftStyle %~ lw 0) +-- > drawHead h = arrowAt' (with & arrowHead .~ h & shaftStyle %~ lw none) -- > origin (r2 (0.001, 0)) --- > <> square 0.5 # alignL # lw 0 +-- > <> square 0.5 # alignL # lw none -- | Isoceles triangle style. The above example specifies an angle of `2/5 Turn`. -- | <> --- > tri25Ex = arrowAt' (with & arrowHead .~ arrowheadTriangle (2/5 \@\@ turn) & shaftStyle %~ lw 0) +-- > tri25Ex = arrowAt' (with & arrowHead .~ arrowheadTriangle (2/5 \@\@ turn) & shaftStyle %~ lw none) -- > origin (r2 (0.001, 0)) --- > <> square 0.6 # alignL # lw 0 +-- > <> square 0.6 # alignL # lw none arrowheadTriangle :: Angle -> ArrowHT arrowheadTriangle theta = aHead where @@ -218,9 +212,9 @@ dart :: ArrowHT dart = arrowheadDart (2/5 @@ turn) -- Tails ------------------------------------------------------------------ --- > drawTail t = arrowAt' (with & arrowTail .~ t & shaftStyle %~ lw 0 & arrowHead .~ noHead) +-- > drawTail t = arrowAt' (with & arrowTail .~ t & shaftStyle %~ lw none & arrowHead .~ noHead) -- > origin (r2 (0.001, 0)) --- > <> square 0.5 # alignL # lw 0 +-- > <> square 0.5 # alignL # lw none -- | Utility function to convert any arrowhead to an arrowtail, i.e. -- attached at the start of the trail. @@ -236,29 +230,28 @@ headToTail hd = tl arrowtailBlock :: Angle -> ArrowHT arrowtailBlock theta = aTail where - aTail size _ = (t, mempty) + aTail len _ = (t, mempty) where - t = square 1 # scaleX x # scaleY y # scale size # alignR - a' = e theta # scaleR + t = rect len (len * x) # alignR + a' = fromDirection theta a = a' ^-^ (reflectY a') - y = magnitude a - b = a' ^-^ (reflectX a') - x = magnitude b + x = magnitude a -- | The angle is where the top left corner intersects the circle. arrowtailQuill :: Angle -> ArrowHT -arrowtailQuill theta =aTail +arrowtailQuill theta = aTail where - aTail size shaftWidth = (t, j) + aTail len shaftWidth = (t, j) where t = ( closedPath $ trailFromVertices [v0, v1, v2, v3, v4, v5, v0] ) # scale size # alignR + size = len / 0.6 v0 = p2 (0.5, 0) - v2 = p2 (unr2 $ e theta # scaleR) - v1 = v2 # translateX (5/4 * htRadius) + v2 = p2 (unr2 $ fromDirection theta # scale 0.5) + v1 = v2 # translateX (5/8) v3 = p2 (-0.1, 0) v4 = v2 # reflectY - v5 = v4 # translateX (5/4 * htRadius) + v5 = v4 # translateX (5/8) s = 1 - shaftWidth / magnitude (v1 .-. v5) n1 = v0 # translateY (0.5 * shaftWidth) n2 = v1 .-^ ((v1 .-. v0) # scale s) @@ -309,4 +302,4 @@ quill = arrowtailQuill (2/5 @@ turn) -- > blockEx = drawTail block block :: ArrowHT -block = arrowtailBlock (2/5 @@ turn) +block = arrowtailBlock (7/16 @@ turn) From c3abc9ba33884e7349f6c9c41de2f0478cffe043 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Sat, 10 May 2014 11:22:56 -0400 Subject: [PATCH 4/8] added lengths travesal --- src/Diagrams/TwoD.hs | 5 +++-- src/Diagrams/TwoD/Arrow.hs | 26 ++++++++++++++++---------- 2 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/Diagrams/TwoD.hs b/src/Diagrams/TwoD.hs index 2dd61430..e5c7d5ee 100644 --- a/src/Diagrams/TwoD.hs +++ b/src/Diagrams/TwoD.hs @@ -156,8 +156,9 @@ module Diagrams.TwoD , shaftColor , shaftTexture , shaftStyle - , headSize - , tailSize + , headLength + , tailLength + , lengths -- * Text , text, topLeftText, alignedText, baselineText diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index 60653e7b..8efb9a2d 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -83,11 +83,12 @@ module Diagrams.TwoD.Arrow , headColor , headTexture , headStyle - , headSize + , headLength , tailColor , tailTexture , tailStyle - , tailSize + , tailLength + , lengths , shaftColor , shaftTexture , shaftStyle @@ -138,9 +139,9 @@ data ArrowOpts , _headGap :: Measure R2 , _tailGap :: Measure R2 , _headStyle :: Style R2 - , _headSize :: Measure R2 + , _headLength :: Measure R2 , _tailStyle :: Style R2 - , _tailSize :: Measure R2 + , _tailLength :: Measure R2 , _shaftStyle :: Style R2 } @@ -158,9 +159,9 @@ instance Default ArrowOpts where -- See note [Default arrow style attributes] , _headStyle = mempty - , _headSize = normal + , _headLength = normal , _tailStyle = mempty - , _tailSize = normal + , _tailLength = normal , _shaftStyle = mempty } @@ -202,10 +203,15 @@ tailStyle :: Lens' ArrowOpts (Style R2) shaftStyle :: Lens' ArrowOpts (Style R2) -- | The radius of the circumcircle around the head. -headSize :: Lens' ArrowOpts (Measure R2) +headLength :: Lens' ArrowOpts (Measure R2) -- | The radius of the circumcircle around the tail. -tailSize :: Lens' ArrowOpts (Measure R2) +tailLength :: Lens' ArrowOpts (Measure R2) + +-- | Set both the @headLength@ and @tailLength@ simultaneously. +lengths :: Traversal' ArrowOpts (Measure R2) +lengths f opts = (\h t -> opts & headLength .~ h & tailLength .~ t) <$> f (opts ^. headLength) + <*> f (opts ^. tailLength) -- | A lens for setting or modifying the color of an arrowhead. For -- example, one may write @... (with & headColor .~ blue)@ to get an @@ -432,8 +438,8 @@ arrow' opts len = mkQD' (DelayedLeaf delayedArrow) -- The head size, tail size, head gap, and tail gap are obtained -- from the style and converted to output units. - hSize = fromMeasure gToO nToO (opts ^. headSize) - tSize = fromMeasure gToO nToO (opts ^. tailSize) + hSize = fromMeasure gToO nToO (opts ^. headLength) + tSize = fromMeasure gToO nToO (opts ^. tailLength) hGap = fromMeasure gToO nToO (opts ^. headGap) tGap = fromMeasure gToO nToO (opts ^. tailGap) From fecd9349035cd8767411f76f8ce3692392b27b54 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Sat, 10 May 2014 11:24:17 -0400 Subject: [PATCH 5/8] fix haddock diagrams --- src/Diagrams/TwoD/Arrow.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index 8efb9a2d..bf950190 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -27,13 +27,13 @@ module Diagrams.TwoD.Arrow -- -- > -- Connecting two diagrams at their origins. -- > --- > sq = square 2 # showOrigin # lc darkgray # lw 0.07 +-- > sq = square 2 # showOrigin # lc darkgray # lw none.07 -- > ds = (sq # named "left") ||| strutX 3 ||| (sq # named "right") -- > -- > shaft = cubicSpline False ( map p2 [(0, 0), (1, 0), (1, 0.2), (2, 0.2)]) -- > -- > example1 = ds # connect' (with & arrowHead .~ dart & arrowTail .~ quill --- > & shaftStyle %~ lw 0.02 & arrowShaft .~ shaft) +-- > & shaftStyle %~ lw none.02 & arrowShaft .~ shaft) -- > "left" "right" # pad 1.1 -- ** Example 2 @@ -42,7 +42,7 @@ module Diagrams.TwoD.Arrow -- -- > -- Comparing connect, connectPerim, and arrowAt. -- > --- > oct = octagon 1 # lc darkgray # lw 0.050 # showOrigin +-- > oct = octagon 1 # lc darkgray # lw none.050 # showOrigin -- > dias = oct # named "first" ||| strut 3 ||| oct # named "second" -- > -- > -- Connect two diagrams and two points on their trails. From 53cec4a621988f9aa14097ce3f3e032397815353 Mon Sep 17 00:00:00 2001 From: Jeffrey Rosenbluth Date: Sat, 10 May 2014 11:26:50 -0400 Subject: [PATCH 6/8] more haddock diagram corrections --- src/Diagrams/TwoD/Arrow.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index bf950190..df07c4f5 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -27,13 +27,13 @@ module Diagrams.TwoD.Arrow -- -- > -- Connecting two diagrams at their origins. -- > --- > sq = square 2 # showOrigin # lc darkgray # lw none.07 +-- > sq = square 2 # showOrigin # lc darkgray # lwG 0.07 -- > ds = (sq # named "left") ||| strutX 3 ||| (sq # named "right") -- > -- > shaft = cubicSpline False ( map p2 [(0, 0), (1, 0), (1, 0.2), (2, 0.2)]) -- > -- > example1 = ds # connect' (with & arrowHead .~ dart & arrowTail .~ quill --- > & shaftStyle %~ lw none.02 & arrowShaft .~ shaft) +-- > & shaftStyle %~ lwG 0.02 & arrowShaft .~ shaft) -- > "left" "right" # pad 1.1 -- ** Example 2 @@ -42,7 +42,7 @@ module Diagrams.TwoD.Arrow -- -- > -- Comparing connect, connectPerim, and arrowAt. -- > --- > oct = octagon 1 # lc darkgray # lw none.050 # showOrigin +-- > oct = octagon 1 # lc darkgray # lwG 0.050 # showOrigin -- > dias = oct # named "first" ||| strut 3 ||| oct # named "second" -- > -- > -- Connect two diagrams and two points on their trails. From da9076757103f25fe16a8949adf4cd3f79283985 Mon Sep 17 00:00:00 2001 From: jeffrey rosenbluth Date: Tue, 13 May 2014 21:54:10 -0400 Subject: [PATCH 7/8] fixed documentation --- src/Diagrams/TwoD/Arrow.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index df07c4f5..fa2bfe07 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -27,13 +27,13 @@ module Diagrams.TwoD.Arrow -- -- > -- Connecting two diagrams at their origins. -- > --- > sq = square 2 # showOrigin # lc darkgray # lwG 0.07 +-- > sq = square 2 # showOrigin # lc darkgray # lw ultraThick -- > ds = (sq # named "left") ||| strutX 3 ||| (sq # named "right") -- > -- > shaft = cubicSpline False ( map p2 [(0, 0), (1, 0), (1, 0.2), (2, 0.2)]) -- > -- > example1 = ds # connect' (with & arrowHead .~ dart & arrowTail .~ quill --- > & shaftStyle %~ lwG 0.02 & arrowShaft .~ shaft) +-- > & arrowShaft .~ shaft) -- > "left" "right" # pad 1.1 -- ** Example 2 @@ -42,7 +42,7 @@ module Diagrams.TwoD.Arrow -- -- > -- Comparing connect, connectPerim, and arrowAt. -- > --- > oct = octagon 1 # lc darkgray # lwG 0.050 # showOrigin +-- > oct = octagon 1 # lc darkgray # lw ultraThick # showOrigin -- > dias = oct # named "first" ||| strut 3 ||| oct # named "second" -- > -- > -- Connect two diagrams and two points on their trails. @@ -202,10 +202,10 @@ tailStyle :: Lens' ArrowOpts (Style R2) -- | Style to apply to the shaft. See `headStyle`. shaftStyle :: Lens' ArrowOpts (Style R2) --- | The radius of the circumcircle around the head. +-- | The length from the start of the joint to the tip of the head. headLength :: Lens' ArrowOpts (Measure R2) --- | The radius of the circumcircle around the tail. +-- | The length of the tail plus its joint. tailLength :: Lens' ArrowOpts (Measure R2) -- | Set both the @headLength@ and @tailLength@ simultaneously. From 54577cd4ca11164b6b9068b66ba1911482f59a56 Mon Sep 17 00:00:00 2001 From: jeffrey rosenbluth Date: Wed, 14 May 2014 08:21:43 -0400 Subject: [PATCH 8/8] small adjustments --- src/Diagrams/TwoD/Arrow.hs | 8 +++++--- src/Diagrams/TwoD/Attributes.hs | 6 +++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index fa2bfe07..e7e68f4f 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -33,7 +33,8 @@ module Diagrams.TwoD.Arrow -- > shaft = cubicSpline False ( map p2 [(0, 0), (1, 0), (1, 0.2), (2, 0.2)]) -- > -- > example1 = ds # connect' (with & arrowHead .~ dart & arrowTail .~ quill --- > & arrowShaft .~ shaft) +-- > & arrowShaft .~ shaft +-- > & headLength .~ huge & tailLength .~ veryLarge) -- > "left" "right" # pad 1.1 -- ** Example 2 @@ -46,8 +47,9 @@ module Diagrams.TwoD.Arrow -- > dias = oct # named "first" ||| strut 3 ||| oct # named "second" -- > -- > -- Connect two diagrams and two points on their trails. --- > ex12 = dias # connect "first" "second" --- > # connectPerim "first" "second" (15/16 \@\@ turn) (9/16 \@\@ turn) +-- > ex12 = dias # connect' (with & lengths .~ veryLarge) "first" "second" +-- > # connectPerim (with & lengths .~ veryLarge) +-- > "first" "second" (15/16 \@\@ turn) (9/16 \@\@ turn) -- > -- > -- Place an arrow at (0,0) the size and direction of (0,1). -- > ex3 = arrowAt origin unit_Y diff --git a/src/Diagrams/TwoD/Attributes.hs b/src/Diagrams/TwoD/Attributes.hs index ffe959d8..6f806a61 100644 --- a/src/Diagrams/TwoD/Attributes.hs +++ b/src/Diagrams/TwoD/Attributes.hs @@ -105,11 +105,11 @@ ultraThick = Normalized 0.02 `atLeast` Output 0.5 tiny = Normalized 0.01 verySmall = Normalized 0.015 -small = Normalized 0.0225 +small = Normalized 0.023 normal = Normalized 0.035 large = Normalized 0.05 -veryLarge = Normalized 0.10 -huge = Normalized 0.15 +veryLarge = Normalized 0.07 +huge = Normalized 0.10 ----------------------------------------------------------------- -- Line Width -------------------------------------------------