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

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Basic.Paths.RoundCorners
-- Copyright   :  (c) Stephen Tetley 2010
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Drawing round cornered polygons.
--
--------------------------------------------------------------------------------

module Wumpus.Basic.Paths.RoundCorners
(
cornerCurve
, illustratePath
, roundEvery

) where

import Wumpus.Basic.Colour.SVGColours
import Wumpus.Basic.Graphic
import Wumpus.Basic.Paths.Base hiding ( length )
import Wumpus.Basic.Utils.Intersection

import Wumpus.Core                              -- package: wumpus-core

import Data.AffineSpace                         -- package: vector-space

import Data.Monoid

-- | The length of the control-point vector wants to be slighly
-- longer than half of /d/ (d - being the distance between the
-- /truncated/ points and the corner).
--
cornerCurve :: (Real u, Floating u)
=> Point2 u -> Point2 u -> Point2 u -> Path u
cornerCurve p1 p2 p3 = curve p1 cp1 cp2 p3
where
len1 = 0.6 *  (vlength \$ pvec p1 p2)
len2 = 0.6 *  (vlength \$ pvec p3 p2)
cp1  = p1 .+^ (avec (langle p1 p2) len1)
cp2  = p3 .+^ (avec (langle p3 p2) len2)

-- | 'roundEvery' throws a runtime error if the input list has
-- less than 3 eleemnts.
--
roundEvery :: (Real u, Floating u)
=> u -> [Point2 u] -> Path u
roundEvery u (start:b:c:xs) = step (twoParts u start b c) (b:c:xs)
where
step acc (m:n:o:ps)     = step (acc `append` twoParts u m n o) (n:o:ps)
step acc [n,o]          = acc `append` twoParts u n o start
`append` twoParts u o start b
step acc _              = acc

roundEvery _ _              = error "roundEvery - input list too short."

-- | Two parts - line and corner curve...
--
twoParts :: (Real u, Floating u)
=> u ->  Point2 u -> Point2 u -> Point2 u -> Path u
twoParts u a b c = line p1 p2 `append` cornerCurve p2 b p3
where
p1 = a .+^ (avec (direction \$ pvec a b) u)
p2 = b .+^ (avec (direction \$ pvec b a) u)
p3 = b .+^ (avec (direction \$ pvec b c) u)

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

-- This needs moving outside of the Path modules as it has
-- dependencies on SVGColour and Graphic (the Path modules should
-- be /neutral/ to wards depenedencies on other parts of
-- Wumpus-Basic).
--

illustratePath :: Fractional u => Path u -> Graphic u
illustratePath = localize (strokeColour black) . step1 . pathViewL
where
step1 (PathOneL e)  = drawPath1 e
step1 (e :<< se)    = drawPathBoth e `mappend` rest (pathViewL se)

rest (PathOneL e)   = drawPath1 e
rest (e :<< se)     = drawPath1 e `mappend` rest (pathViewL se)

drawPathBoth :: Fractional u => PathSegment u -> Graphic u
drawPathBoth pa@(Line1 p1 _)      = drawPath1 pa `mappend` pathPoint p1
drawPathBoth pa@(Curve1 p1 _ _ _) = drawPath1 pa `mappend` pathPoint p1

drawPath1 :: Fractional u => PathSegment u -> Graphic u
drawPath1 (Line1 p1 p2)        =
straightLineBetween p1 p2 `mappend` pathPoint p2

drawPath1 (Curve1 p1 p2 p3 p4) =
mconcat [bezierCtrl p1 p2, bezierCtrl p4 p3, curveBetween p1 p2 p3 p4
, pathPoint p4 ]

bezierCtrl :: Fractional u => Point2 u -> Point2 u -> Graphic u
bezierCtrl p1 p2 =
localize (strokeColour light_steel_blue . fillColour red) \$
straightLineBetween p1 p2 `mappend` filledDisk 1 p2

pathPoint :: Num u => Point2 u -> Graphic u
pathPoint = localize bothStrokeColour . filledDisk 1

```