```{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Basic.Arrows.Tips
-- Copyright   :  (c) Stephen Tetley 2010
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Anchor points on shapes.
--
-- \*\* WARNING \*\* this module is an experiment, and may
-- change significantly or even be dropped from future revisions.
--
--------------------------------------------------------------------------------

module Wumpus.Basic.Arrows.Tips
(

tri90
, tri60
, tri45
, otri90
, otri60
, otri45

, barb90
, barb60
, barb45

, perp

, rbracket

) where

import Wumpus.Basic.Graphic

import Wumpus.Core                      -- package: wumpus-core

import Data.AffineSpace                 -- package: vector-space

import Control.Applicative

-- | Tiplen is length of the tip \*along the line it follows\*.
--
-- > |\
-- > | \
-- > | /
-- > |/
-- >
-- > |  |  -- tip len
--

-- | Tip width is the distance between upper and lower
-- arrow points.
--
-- >       __
-- > |\
-- > | \   tip
-- > | /   width
-- > |/    __
-- >

-- | This one is for triangular tips defined by their tip angle
-- e.g. 90deg, 60deg, 45deg.
--
-- The tip width will be variable (tip length should be the
-- markHeight).
--
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        -- theta in the opposite direction
vec_to_upper = avec (circularModulo \$ rtheta - halfang) hypo_len
vec_to_lower = avec (circularModulo \$ rtheta + halfang) hypo_len

-- | This one is for triangles when the tip height and tip width
-- are known.
--
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        -- theta in the opposite direction
vec_to_upper = avec (circularModulo \$ rtheta - halfang) hypo_len
vec_to_lower = avec (circularModulo \$ rtheta + halfang) hypo_len

--------------------------------------------------------------------------------

-- | Tripoints takes the \*tip length\* is the mark height.
--
-- This means that the 90deg tip has a tip width greater-than the
-- mark height (but that is okay - seemingly this is how TikZ
-- does it!).
--
tripointsByAngle :: (Floating u, FromPtSize 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

-- width = xchar_height
-- filled with stroke colour!

triAng :: (Floating u, Real u, FromPtSize u)
-> (PrimPath u -> Graphic u)
-> LocGraphic u
triAng triang theta gf pt =
tripointsByAngle triang theta pt >>= \(u,v) ->
localize bothStrokeColour (gf \$  vertexPath [pt,u,v])

-- TODO - maybe filling needs to use swapColours

tri90 :: (Floating u, Real u, FromPtSize u)
tri90 theta = triAng (pi/2) theta filledPath

tri60 :: (Floating u, Real u, FromPtSize u)
tri60 theta = triAng (pi/3) theta filledPath

tri45 :: (Floating u, Real u, FromPtSize u)
tri45 theta = triAng (pi/4) theta filledPath

otri90 :: (Floating u, Real u, FromPtSize u)
otri90 theta = triAng (pi/2) theta closedStroke

otri60 :: (Floating u, Real u, FromPtSize u)
otri60 theta = triAng (pi/3) theta closedStroke

otri45 :: (Floating u, Real u, FromPtSize u)
otri45 theta = triAng (pi/4) theta closedStroke

barbAng :: (Floating u, Real u, FromPtSize u)
barbAng ang theta pt =
tripointsByAngle ang theta pt >>= \(u,v) ->
openStroke (vertexPath [u,pt,v])

barb90 :: (Floating u, Real u, FromPtSize u)
barb90 = barbAng (pi/2)

barb60 :: (Floating u, Real u, FromPtSize u)
barb60 = barbAng (pi/3)

barb45 :: (Floating u, Real u, FromPtSize 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])

```