{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Parametric.Adjust
-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Tools for adjusting the length of parametric objects such as
-- segments and trails.
--
-----------------------------------------------------------------------------
module Diagrams.Parametric.Adjust
    ( adjust
    , AdjustOpts(_adjMethod, _adjSide, _adjEps)
    , adjMethod, adjSide, adjEps
    , AdjustMethod(..), AdjustSide(..)

    ) where

import           Control.Lens        (Lens', generateSignatures, lensRules, makeLensesWith, (&),
                                      (.~), (^.))
import           Data.Proxy

import           Data.Default.Class

import           Diagrams.Core.V
import           Diagrams.Parametric

-- | What method should be used for adjusting a segment, trail, or
--   path?
data AdjustMethod n = ByParam n     -- ^ Extend by the given parameter value
                                    --   (use a negative parameter to shrink)
                    | ByAbsolute n  -- ^ Extend by the given arc length
                                    --   (use a negative length to shrink)
                    | ToAbsolute n  -- ^ Extend or shrink to the given
                                    --   arc length

-- | Which side of a segment, trail, or path should be adjusted?
data AdjustSide = Start  -- ^ Adjust only the beginning
                | End    -- ^ Adjust only the end
                | Both   -- ^ Adjust both sides equally
  deriving (Int -> AdjustSide -> ShowS
[AdjustSide] -> ShowS
AdjustSide -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdjustSide] -> ShowS
$cshowList :: [AdjustSide] -> ShowS
show :: AdjustSide -> String
$cshow :: AdjustSide -> String
showsPrec :: Int -> AdjustSide -> ShowS
$cshowsPrec :: Int -> AdjustSide -> ShowS
Show, ReadPrec [AdjustSide]
ReadPrec AdjustSide
Int -> ReadS AdjustSide
ReadS [AdjustSide]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AdjustSide]
$creadListPrec :: ReadPrec [AdjustSide]
readPrec :: ReadPrec AdjustSide
$creadPrec :: ReadPrec AdjustSide
readList :: ReadS [AdjustSide]
$creadList :: ReadS [AdjustSide]
readsPrec :: Int -> ReadS AdjustSide
$creadsPrec :: Int -> ReadS AdjustSide
Read, AdjustSide -> AdjustSide -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdjustSide -> AdjustSide -> Bool
$c/= :: AdjustSide -> AdjustSide -> Bool
== :: AdjustSide -> AdjustSide -> Bool
$c== :: AdjustSide -> AdjustSide -> Bool
Eq, Eq AdjustSide
AdjustSide -> AdjustSide -> Bool
AdjustSide -> AdjustSide -> Ordering
AdjustSide -> AdjustSide -> AdjustSide
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AdjustSide -> AdjustSide -> AdjustSide
$cmin :: AdjustSide -> AdjustSide -> AdjustSide
max :: AdjustSide -> AdjustSide -> AdjustSide
$cmax :: AdjustSide -> AdjustSide -> AdjustSide
>= :: AdjustSide -> AdjustSide -> Bool
$c>= :: AdjustSide -> AdjustSide -> Bool
> :: AdjustSide -> AdjustSide -> Bool
$c> :: AdjustSide -> AdjustSide -> Bool
<= :: AdjustSide -> AdjustSide -> Bool
$c<= :: AdjustSide -> AdjustSide -> Bool
< :: AdjustSide -> AdjustSide -> Bool
$c< :: AdjustSide -> AdjustSide -> Bool
compare :: AdjustSide -> AdjustSide -> Ordering
$ccompare :: AdjustSide -> AdjustSide -> Ordering
Ord, AdjustSide
forall a. a -> a -> Bounded a
maxBound :: AdjustSide
$cmaxBound :: AdjustSide
minBound :: AdjustSide
$cminBound :: AdjustSide
Bounded, Int -> AdjustSide
AdjustSide -> Int
AdjustSide -> [AdjustSide]
AdjustSide -> AdjustSide
AdjustSide -> AdjustSide -> [AdjustSide]
AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
$cenumFromThenTo :: AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
enumFromTo :: AdjustSide -> AdjustSide -> [AdjustSide]
$cenumFromTo :: AdjustSide -> AdjustSide -> [AdjustSide]
enumFromThen :: AdjustSide -> AdjustSide -> [AdjustSide]
$cenumFromThen :: AdjustSide -> AdjustSide -> [AdjustSide]
enumFrom :: AdjustSide -> [AdjustSide]
$cenumFrom :: AdjustSide -> [AdjustSide]
fromEnum :: AdjustSide -> Int
$cfromEnum :: AdjustSide -> Int
toEnum :: Int -> AdjustSide
$ctoEnum :: Int -> AdjustSide
pred :: AdjustSide -> AdjustSide
$cpred :: AdjustSide -> AdjustSide
succ :: AdjustSide -> AdjustSide
$csucc :: AdjustSide -> AdjustSide
Enum)

-- | How should a segment, trail, or path be adjusted?
data AdjustOpts n = AO { forall n. AdjustOpts n -> AdjustMethod n
_adjMethod    :: AdjustMethod n
                       , forall n. AdjustOpts n -> AdjustSide
_adjSide      :: AdjustSide
                       , forall n. AdjustOpts n -> n
_adjEps       :: n
                       , forall n. AdjustOpts n -> Proxy n
adjOptsvProxy :: Proxy n
                       }

-- See Diagrams.Combinators for reasoning behind 'Proxy'.

makeLensesWith (lensRules & generateSignatures .~ False) ''AdjustOpts

-- | Which method should be used for adjusting?
adjMethod :: Lens' (AdjustOpts n) (AdjustMethod n)

-- | Which end(s) of the object should be adjusted?
adjSide :: Lens' (AdjustOpts n) AdjustSide

-- | Tolerance to use when doing adjustment.
adjEps :: Lens' (AdjustOpts n) n

instance Fractional n => Default (AdjustMethod n) where
  def :: AdjustMethod n
def = forall n. n -> AdjustMethod n
ByParam n
0.2

instance Default AdjustSide where
  def :: AdjustSide
def = AdjustSide
Both

instance Fractional n => Default (AdjustOpts n) where
  def :: AdjustOpts n
def = AO { _adjMethod :: AdjustMethod n
_adjMethod    = forall a. Default a => a
def
           , _adjSide :: AdjustSide
_adjSide      = forall a. Default a => a
def
           , _adjEps :: n
_adjEps       = forall a. Fractional a => a
stdTolerance
           , adjOptsvProxy :: Proxy n
adjOptsvProxy = forall {k} (t :: k). Proxy t
Proxy
           }

-- | Adjust the length of a parametric object such as a segment or
--   trail.  The second parameter is an option record which controls how
--   the adjustment should be performed; see 'AdjustOpts'.
adjust :: (N t ~ n, Sectionable t, HasArcLength t, Fractional n)
       => t -> AdjustOpts n -> t
adjust :: forall t n.
(N t ~ n, Sectionable t, HasArcLength t, Fractional n) =>
t -> AdjustOpts n -> t
adjust t
s AdjustOpts n
opts = forall p. Sectionable p => p -> N p -> N p -> p
section t
s
  (if AdjustOpts n
optsforall s a. s -> Getting a s a -> a
^.forall n. Lens' (AdjustOpts n) AdjustSide
adjSide forall a. Eq a => a -> a -> Bool
== AdjustSide
End   then forall p. DomainBounds p => p -> N p
domainLower t
s else t -> n
getParam t
s)
  (if AdjustOpts n
optsforall s a. s -> Getting a s a -> a
^.forall n. Lens' (AdjustOpts n) AdjustSide
adjSide forall a. Eq a => a -> a -> Bool
== AdjustSide
Start then forall p. DomainBounds p => p -> N p
domainUpper t
s else forall p. DomainBounds p => p -> N p
domainUpper t
s forall a. Num a => a -> a -> a
- t -> n
getParam (forall p. Sectionable p => p -> p
reverseDomain t
s))
 where
  getParam :: t -> n
getParam t
seg = case AdjustOpts n
optsforall s a. s -> Getting a s a -> a
^.forall n. Lens' (AdjustOpts n) (AdjustMethod n)
adjMethod of
    ByParam n
p -> -n
p forall a. Num a => a -> a -> a
* n
bothCoef
    ByAbsolute n
len -> N t -> N t
param (-n
len forall a. Num a => a -> a -> a
* n
bothCoef)
    ToAbsolute n
len -> N t -> N t
param (n -> n
absDelta n
len forall a. Num a => a -> a -> a
* n
bothCoef)
   where
    param :: N t -> N t
param        = forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam n
eps t
seg
    absDelta :: n -> n
absDelta n
len = forall p. HasArcLength p => N p -> p -> N p
arcLength n
eps t
s forall a. Num a => a -> a -> a
- n
len
  bothCoef :: n
bothCoef = if AdjustOpts n
optsforall s a. s -> Getting a s a -> a
^.forall n. Lens' (AdjustOpts n) AdjustSide
adjSide forall a. Eq a => a -> a -> Bool
== AdjustSide
Both then n
0.5 else n
1
  eps :: n
eps = AdjustOpts n
optsforall s a. s -> Getting a s a -> a
^.forall n. Lens' (AdjustOpts n) n
adjEps