module Wumpus.Basic.Arrows.Tips
(
Arrowhead(..)
, arrowheadTip
, tri90
, tri60
, tri45
, otri90
, otri60
, otri45
, barb90
, barb60
, barb45
, perp
, rbracket
) where
import Wumpus.Basic.Graphic
import Wumpus.Core
import Data.AffineSpace
import Control.Applicative
data Arrowhead u = Arrowhead
{ retract_dist :: DrawingR u
, arrow_draw :: ThetaLocGraphic u
}
arrowheadTip :: Arrowhead u -> Radian -> LocGraphic u
arrowheadTip (Arrowhead _ gf) theta = gf theta
triVecsByAngle :: Floating u => u -> Radian -> Radian -> (Vec2 u, Vec2 u)
triVecsByAngle tiplen halfang theta = (vec_to_upper, vec_to_lower)
where
hypo_len = tiplen / (fromRadian $ cos halfang)
rtheta = pi + theta
vec_to_upper = avec (circularModulo $ rtheta halfang) hypo_len
vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len
mark_height_plus_line_width :: (Fractional u, FromPtSize u) => DrawingR u
mark_height_plus_line_width =
(\h lw -> h + realToFrac lw) <$> markHeight <*> lineWidth
tripointsByAngle :: (Floating u, FromPtSize u)
=> Radian -> ThetaLocDrawingR u (Point2 u, Point2 u)
tripointsByAngle triang theta tip =
(\h -> let (vupper,vlower) = triVecsByAngle h (0.5*triang) theta
in (tip .+^ vupper, tip .+^ vlower))
<$> markHeight
triAng :: (Floating u, Real u, FromPtSize u)
=> Radian -> (PrimPath u -> Graphic u) -> ThetaLocGraphic u
triAng triang gf theta pt =
tripointsByAngle triang theta pt >>= \(u,v) ->
localize bothStrokeColour (gf $ vertexPath [pt,u,v])
tri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
tri90 = Arrowhead markHeight (triAng (pi/2) filledPath)
tri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
tri60 = Arrowhead markHeight (triAng (pi/3) filledPath)
tri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
tri45 = Arrowhead markHeight (triAng (pi/4) filledPath)
otri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
otri90 = Arrowhead mark_height_plus_line_width (triAng (pi/2) closedStroke)
otri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
otri60 = Arrowhead mark_height_plus_line_width (triAng (pi/3) closedStroke)
otri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
otri45 = Arrowhead mark_height_plus_line_width (triAng (pi/4) closedStroke)
barbAng :: (Floating u, Real u, FromPtSize u) => Radian -> ThetaLocGraphic u
barbAng ang theta pt =
tripointsByAngle ang theta pt >>= \(u,v) ->
openStroke (vertexPath [u,pt,v])
barb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
barb90 = Arrowhead (pure 0) (barbAng (pi/2))
barb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
barb60 = Arrowhead (pure 0) (barbAng (pi/3))
barb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
barb45 = Arrowhead (pure 0) (barbAng (pi/4))
perpAng :: (Floating u, FromPtSize u) => ThetaLocGraphic u
perpAng theta pt =
markHeight >>= \ h ->
let v = makeV h in openStroke $ vertexPath [ pt .+^ v, pt .-^ v]
where
makeV h = avec (theta + pi/2) (0.5 * h)
perp :: (Floating u, FromPtSize u) => Arrowhead u
perp = Arrowhead (pure 0) perpAng
rbracketAng :: (Floating u, FromPtSize u) => ThetaLocGraphic u
rbracketAng theta pt = markHalfHeight >>= \hh ->
runDirection theta $
displacePerp hh pt >>= \p1 ->
displacePara (hh) p1 >>= \p0 ->
displacePerp (hh) pt >>= \p2 ->
displacePara (hh) p2 >>= \p3 ->
return (openStroke $ vertexPath [p0,p1,p2,p3])
rbracket :: (Floating u, FromPtSize u) => Arrowhead u
rbracket = Arrowhead (pure 0) rbracketAng