module Wumpus.Basic.Arrows
(
cline
, arrowTri90
, arrowTri60
, arrowTri45
, arrowOTri90
, arrowOTri60
, arrowOTri45
, arrowBarb90
, arrowBarb60
, arrowBarb45
, arrowPerp
, arrowRBracket
) where
import Wumpus.Basic.Arrows.Tips
import Wumpus.Basic.Graphic
import Wumpus.Basic.Paths
import Wumpus.Basic.Utils.Intersection ( langle )
import Wumpus.Core
import Control.Applicative
import Data.Monoid
liftConnector :: Connector u -> ConnDrawingR u (Path u)
liftConnector pF p1 p2 = pure $ pF p1 p2
cline :: Num u => Connector u -> ConnImage u (Path u)
cline pathF = intoConnImage (liftConnector pathF) (pathGraphic pathF)
pathGraphic :: Num u => Connector u -> ConnGraphic u
pathGraphic bpath = \p1 p2 -> openStroke $ toPrimPathU $ bpath p1 p2
lineTipR :: Num u => Path u -> Graphic u -> Graphic u
lineTipR bpath arrtip = openStroke (toPrimPathU bpath) `mappend` arrtip
rightPathProps :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnDrawingR u (Path u,Radian)
rightPathProps pathF p1 p2 =
(\h sw -> (shortenPath h sw, calcTheta h))
<$> markHeight <*> lineWidth
where
long_path = pathF p1 p2
shortenPath lxh sw = shortenR (lxh + (realToFrac sw)) long_path
calcTheta lxh = directionR $ shortenR (0.5*lxh) long_path
triTipRight :: (Real u, Floating u, FromPtSize u)
=> Connector u -> (Radian -> LocGraphic u) -> ConnImage u (Path u)
triTipRight pathF tipF p1 p2 =
rightPathProps pathF p1 p2 >>= \(shortF,theta) ->
lineTipR shortF (tipF theta p2) >>= \arrow_pic ->
return (pathF p1 p2, arrow_pic)
barbTipRight :: (Real u, Floating u, FromPtSize u)
=> Connector u -> (Radian -> LocGraphic u) -> ConnImage u (Path u)
barbTipRight pathF tipF p1 p2 =
rightPathProps pathF p1 p2 >>= \(_,theta) ->
lineTipR path_zero (tipF theta p2) >>= \arrow_pic ->
return (path_zero, arrow_pic)
where
path_zero = pathF p1 p2
arrowTri90 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowTri90 pathF = triTipRight pathF tri90
arrowTri60 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowTri60 pathF = triTipRight pathF tri60
arrowTri45 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowTri45 pathF = triTipRight pathF tri45
arrowOTri90 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowOTri90 pathF = triTipRight pathF otri90
arrowOTri60 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowOTri60 pathF = triTipRight pathF otri60
arrowOTri45 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowOTri45 pathF = triTipRight pathF otri45
arrowBarb90 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowBarb90 pathF = barbTipRight pathF barb90
arrowBarb60 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowBarb60 pathF = barbTipRight pathF barb60
arrowBarb45 :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowBarb45 pathF = barbTipRight pathF barb45
arrowPerp :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowPerp pathF p1 p2 =
lineTipR path_zero perp_tip >>= \arrow_pic -> return (path_zero, arrow_pic)
where
path_zero = pathF p1 p2
theta = langle p1 p2
perp_tip = perp theta p2
arrowRBracket :: (Real u, Floating u, FromPtSize u)
=> Connector u -> ConnImage u (Path u)
arrowRBracket pathF p1 p2 =
lineTipR path_zero perp_tip >>= \arrow_pic -> return (path_zero, arrow_pic)
where
path_zero = pathF p1 p2
theta = langle p1 p2
perp_tip = rbracket theta p2