{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Basic.Arrows-- Copyright : (c) Stephen Tetley 2010-- License : BSD3---- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>-- Stability : highly unstable-- Portability : GHC with TypeFamilies and more---- Anchor points on shapes.---- \*\* WARNING \*\* this module is an experiment, and may -- change significantly or even be dropped from future revisions.-- --------------------------------------------------------------------------------moduleWumpus.Basic.Arrows(line,arrowTri90,arrowTri60,arrowTri45,arrowOTri90,arrowOTri60,arrowOTri45,arrowBarb90,arrowBarb60,arrowBarb45,arrowPerp)whereimportWumpus.Basic.Arrows.TipsimportWumpus.Basic.GraphicimportWumpus.Basic.PathsimportWumpus.Basic.Paths.BaseimportWumpus.Basic.Utils.Intersection(langle)importWumpus.Core-- package: wumpus-coreimportControl.ApplicativeimportData.MonoidliftPathF::PathFu->ConnDrawingFu(Pathu)liftPathFpFp1p2=pureDF$pFp1p2line::Numu=>PathFu->ConnImageu(Pathu)linepathF=intoConnImage(liftPathFpathF)(pathGraphicpathF)-- Here the path is already shortened - we have accounted for the-- points already, so it is just a graphic. lineTipR::Numu=>Pathu->Graphicu->GraphiculineTipRbpathtip=openStroke(toPrimPathUbpath)`mappend`tip-- | Returns two items:-- -- 1. Shorten the line by the line width - this stops the path-- tip puncturing the arrow head (particulary visible on open -- triangle tips).-- -- 2. Calculate the direction back along the line at half the -- lower_x_height - this gets a good angle for the tip on curved-- path segments.--rightPathProps::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnDrawingFu(Pathu,Radian)rightPathPropspathFp1p2=(\hsw->(shortenPathhsw,calcThetah))<$>asksDFlowerxHeight<*>asksDF(line_width.stroke_props)wherelong_path=pathFp1p2shortenPathlxhsw=shortenR(lxh+(realToFracsw))long_pathcalcThetalxh=directionR$shortenR(0.5*lxh)long_pathtriTipRight::(Realu,Floatingu,FromPtSizeu)=>PathFu->(Radian->LocGraphicu)->ConnImageu(Pathu)triTipRightpathFtipFp1p2=rightPathPropspathFp1p2>>=\(shortF,theta)->lineTipRshortF(tipFthetap2)>>=\arrow_pic->return(pathFp1p2,arrow_pic)-- This version does not /retract/ the path...--barbTipRight::(Realu,Floatingu,FromPtSizeu)=>PathFu->(Radian->LocGraphicu)->ConnImageu(Pathu)barbTipRightpathFtipFp1p2=rightPathPropspathFp1p2>>=\(_,theta)->lineTipRpath_zero(tipFthetap2)>>=\arrow_pic->return(path_zero,arrow_pic)wherepath_zero=pathFp1p2arrowTri90::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowTri90pathF=triTipRightpathFtri90arrowTri60::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowTri60pathF=triTipRightpathFtri60arrowTri45::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowTri45pathF=triTipRightpathFtri45arrowOTri90::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowOTri90pathF=triTipRightpathFotri90arrowOTri60::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowOTri60pathF=triTipRightpathFotri60arrowOTri45::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowOTri45pathF=triTipRightpathFotri45arrowBarb90::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowBarb90pathF=barbTipRightpathFbarb90arrowBarb60::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowBarb60pathF=barbTipRightpathFbarb60arrowBarb45::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowBarb45pathF=barbTipRightpathFbarb45arrowPerp::(Realu,Floatingu,FromPtSizeu)=>PathFu->ConnImageu(Pathu)arrowPerppathFp1p2=lineTipRpath_zeroperp_tip>>=\arrow_pic->return(path_zero,arrow_pic)wherepath_zero=pathFp1p2theta=langlep1p2perp_tip=perpthetap2