module Wumpus.Basic.Arrows.Tips
(
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
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
triVecsByDist :: (Real u, Floating u)
=> u -> u -> Radian -> (Vec2 u, Vec2 u)
triVecsByDist tiplen half_tipwidth theta = (vec_to_upper, vec_to_lower)
where
hypo_len = sqrt $ (tiplen*tiplen) + (half_tipwidth*half_tipwidth)
halfang = toRadian $ atan (half_tipwidth / tiplen)
rtheta = pi + theta
vec_to_upper = avec (circularModulo $ rtheta halfang) hypo_len
vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len
tripointsByAngle :: (Floating u, FromPtSize u)
=> Radian -> Radian -> LocDrawingR 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
tripointsByDist :: (Real u, Floating u, FromPtSize u)
=> (u -> u) -> (u -> u) -> Radian
-> LocDrawingR u (Point2 u, Point2 u)
tripointsByDist lenF halfwidthF theta tip =
(\h -> let (vup,vlo) = triVecsByDist (lenF h) (halfwidthF $ 0.5*h) theta
in (tip .+^ vup, tip .+^ vlo))
<$> markHeight
triAng :: (Floating u, Real u, FromPtSize u)
=> Radian
-> Radian
-> (PrimPath u -> Graphic u)
-> LocGraphic u
triAng triang theta gf pt =
tripointsByAngle triang theta pt >>= \(u,v) ->
localize bothStrokeColour (gf $ vertexPath [pt,u,v])
tri90 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
tri90 theta = triAng (pi/2) theta filledPath
tri60 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
tri60 theta = triAng (pi/3) theta filledPath
tri45 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
tri45 theta = triAng (pi/4) theta filledPath
otri90 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
otri90 theta = triAng (pi/2) theta closedStroke
otri60 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
otri60 theta = triAng (pi/3) theta closedStroke
otri45 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
otri45 theta = triAng (pi/4) theta closedStroke
barbAng :: (Floating u, Real u, FromPtSize u)
=> Radian -> Radian -> LocGraphic u
barbAng ang theta pt =
tripointsByAngle ang theta pt >>= \(u,v) ->
openStroke (vertexPath [u,pt,v])
barb90 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
barb90 = barbAng (pi/2)
barb60 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
barb60 = barbAng (pi/3)
barb45 :: (Floating u, Real u, FromPtSize u)
=> Radian -> LocGraphic u
barb45 = barbAng (pi/4)
perp :: (Floating u, FromPtSize u) => Radian -> LocGraphic u
perp 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)
rbracket :: (Floating u, FromPtSize u) => Radian -> LocGraphic u
rbracket 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])