    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies     #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.TwoD.Shapes
    -- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Various two-dimensional shapes.
    --
    -----------------------------------------------------------------------------

    module Diagrams.TwoD.Shapes
           (
             -- * Miscellaneous
             hrule, vrule

             -- * Regular polygons

           , regPoly
           , triangle
           , eqTriangle
           , square
           , pentagon
           , hexagon
           , septagon
           , octagon
           , nonagon
           , decagon
           , hendecagon
           , dodecagon

             -- * Other special polygons
           , unitSquare
           , rect

             -- * Other shapes

           , roundedRect
           , RoundedRectOpts(..)
           , roundedRect'
           ) where

    import           Diagrams.Core

    import           Diagrams.Coordinates
    import           Diagrams.Located        (at)
    import           Diagrams.Path
    import           Diagrams.Segment
    import           Diagrams.Trail
    import           Diagrams.TrailLike
    import           Diagrams.TwoD.Arc
    import           Diagrams.TwoD.Polygons
    import           Diagrams.TwoD.Transform
    import           Diagrams.TwoD.Types

    import           Diagrams.Util

    import           Data.Default.Class
    import           Data.Semigroup

    -- | Create a centered horizontal (L-R) line of the given length.
    --
    --   <<diagrams/hruleEx.svg#diagram=hruleEx&width=300>>
    --
    --   > hruleEx = vcat' with {sep = 0.2} (map hrule [1..5])
    --   >         # centerXY # pad 1.1
    hrule :: (TrailLike t, V t ~ R2) => Double -> t
    hrule d = trailLike $ trailFromSegments [straight (d & 0)] `at` (p2 (-d/2,0))

    -- | Create a centered vertical (T-B) line of the given length.
    --
    --   <<diagrams/vruleEx.svg#diagram=vruleEx&height=100>>
    --
    --   > vruleEx = hcat' with {sep = 0.2} (map vrule [1, 1.2 .. 2])
    --   >         # centerXY # pad 1.1
    vrule :: (TrailLike t, V t ~ R2) => Double -> t
    vrule d = trailLike $ trailFromSegments [straight (0 & (-d))] `at` (p2 (0,d/2))

    -- | A square with its center at the origin and sides of length 1,
    --   oriented parallel to the axes.
    --
    --   <<diagrams/unitSquareEx.svg#diagram=unitSquareEx&width=100>>
    unitSquare :: (TrailLike t, V t ~ R2) => t
    unitSquare = polygon with { polyType   = PolyRegular 4 (sqrt 2 / 2)
                              , polyOrient = OrientH }

    -- > unitSquareEx = unitSquare # pad 1.1 # showOrigin

    -- | A square with its center at the origin and sides of the given
    --   length, oriented parallel to the axes.
    --
    --   <<diagrams/squareEx.svg#diagram=squareEx&width=200>>
    square :: (TrailLike t, Transformable t, V t ~ R2) => Double -> t
    square d = rect d d

    -- > squareEx = hcat' with {sep = 0.5} [square 1, square 2, square 3]
    -- >          # centerXY # pad 1.1 # lw 0.03

    -- | @rect w h@ is an axis-aligned rectangle of width @w@ and height
    --   @h@, centered at the origin.
    --
    --   <<diagrams/rectEx.svg#diagram=rectEx&width=150>>
    rect :: (TrailLike t, Transformable t, V t ~ R2) => Double -> Double -> t
    rect w h = trailLike . head . pathTrails $ unitSquare # scaleX w # scaleY h

    -- > rectEx = rect 1 0.7 # pad 1.1

        -- The above may seem a bit roundabout.  In fact, we used to have
        --
        --   rect w h = unitSquare # scaleX w # scaleY h
        --
        -- since unitSquare can produce any TrailLike.  The current code
        -- instead uses (unitSquare # scaleX w # scaleY h) to specifically
        -- produce a Path, which is then deconstructed and passed back into
        -- 'trailLike' to create any TrailLike.
        --
        -- The difference is that while scaling by zero works fine for
        -- Path it does not work very well for, say, Diagrams (leading to
        -- NaNs or worse).  This way, we force the scaling to happen on a
        -- Path, where we know it will behave properly, and then use the
        -- resulting geometry to construct an arbitrary TrailLike.
        --
        -- See https://github.com/diagrams/diagrams-lib/issues/43 .

    ------------------------------------------------------------
    --  Regular polygons
    ------------------------------------------------------------

    -- | Create a regular polygon. The first argument is the number of
    --   sides, and the second is the /length/ of the sides. (Compare to the
    --   'polygon' function with a 'PolyRegular' option, which produces
    --   polygons of a given /radius/).
    --
    --   The polygon will be oriented with one edge parallel to the x-axis.
    regPoly :: (TrailLike t, V t ~ R2) => Int -> Double -> t
    regPoly n l = polygon with { polyType =
                                   PolySides
                                     (repeat (1/ fromIntegral n :: Turn))
                                     (replicate (n-1) l)
                               , polyOrient = OrientH
                               }

    -- > shapeEx sh   = sh 1 # pad 1.1
    -- > triangleEx   = shapeEx triangle
    -- > pentagonEx   = shapeEx pentagon
    -- > hexagonEx    = shapeEx hexagon
    -- > septagonEx   = shapeEx septagon
    -- > octagonEx    = shapeEx octagon
    -- > nonagonEx    = shapeEx nonagon
    -- > decagonEx    = shapeEx decagon
    -- > hendecagonEx = shapeEx hendecagon
    -- > dodecagonEx  = shapeEx dodecagon

    -- | A synonym for 'triangle', provided for backwards compatibility.
    eqTriangle :: (TrailLike t, V t ~ R2) => Double -> t
    eqTriangle = triangle

    -- | An equilateral triangle, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/triangleEx.svg#diagram=triangleEx&width=100>>
    triangle :: (TrailLike t, V t ~ R2) => Double -> t
    triangle = regPoly 3

    -- | A regular pentagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/pentagonEx.svg#diagram=pentagonEx&width=100>>
    pentagon :: (TrailLike t, V t ~ R2) => Double -> t
    pentagon = regPoly 5

    -- | A regular hexagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/hexagonEx.svg#diagram=hexagonEx&width=100>>
    hexagon :: (TrailLike t, V t ~ R2) => Double -> t
    hexagon = regPoly 6

    -- | A regular septagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/septagonEx.svg#diagram=septagonEx&width=100>>
    septagon :: (TrailLike t, V t ~ R2) => Double -> t
    septagon = regPoly 7

    -- | A regular octagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/octagonEx.svg#diagram=octagonEx&width=100>>
    octagon :: (TrailLike t, V t ~ R2) => Double -> t
    octagon = regPoly 8

    -- | A regular nonagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/nonagonEx.svg#diagram=nonagonEx&width=100>>
    nonagon :: (TrailLike t, V t ~ R2) => Double -> t
    nonagon = regPoly 9

    -- | A regular decagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/decagonEx.svg#diagram=decagonEx&width=100>>
    decagon :: (TrailLike t, V t ~ R2) => Double -> t
    decagon = regPoly 10

    -- | A regular hendecagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/hendecagonEx.svg#diagram=hendecagonEx&width=100>>
    hendecagon :: (TrailLike t, V t ~ R2) => Double -> t
    hendecagon = regPoly 11

    -- | A regular dodecagon, with sides of the given length and base
    --   parallel to the x-axis.
    --
    --   <<diagrams/dodecagonEx.svg#diagram=dodecagonEx&width=100>>
    dodecagon :: (TrailLike t, V t ~ R2) => Double -> t
    dodecagon = regPoly 12

    ------------------------------------------------------------
    --  Other shapes  ------------------------------------------
    ------------------------------------------------------------

    -- | @roundedRect w h r@ generates a closed trail, or closed path
    --   centered at the origin, of an axis-aligned rectangle with width
    --   @w@, height @h@, and circular rounded corners of radius @r@.  If
    --   @r@ is negative the corner will be cut out in a reverse arc. If
    --   the size of @r@ is larger than half the smaller dimension of @w@
    --   and @h@, then it will be reduced to fit in that range, to prevent
    --   the corners from overlapping.  The trail or path begins with the
    --   right edge and proceeds counterclockwise.  If you need to specify
    --   a different radius for each corner individually, use
    --   'roundedRect'' instead.
    --
    --   <<diagrams/roundedRectEx.svg#diagram=roundedRectEx&width=400>>
    --
    --   > roundedRectEx = pad 1.1 . centerXY $ hcat' with { sep = 0.2 }
    --   >   [ roundedRect  0.5 0.4 0.1
    --   >   , roundedRect  0.5 0.4 (-0.1)
    --   >   , roundedRect' 0.7 0.4 with { radiusTL = 0.2
    --   >                               , radiusTR = -0.2
    --   >                               , radiusBR = 0.1 }
    --   >   ]

    roundedRect :: (TrailLike t, V t ~ R2) => Double -> Double -> Double -> t
    roundedRect w h r = roundedRect' w h (with { radiusTL = r,
                                                 radiusBR = r,
                                                 radiusTR = r,
                                                 radiusBL = r})

    -- | @roundedRect'@ works like @roundedRect@ but allows you to set the radius of
    --   each corner indivually, using @RoundedRectOpts@. The default corner radius is 0.
    --   Each radius can also be negative, which results in the curves being reversed
    --   to be inward instead of outward.
    roundedRect' :: (TrailLike t, V t ~ R2) => Double -> Double -> RoundedRectOpts -> t
    roundedRect' w h opts
       = trailLike
       . (`at` (p2 (w/2, abs rBR - h/2)))
       . wrapTrail
       . glueLine
       $ seg (0, h - abs rTR - abs rBR)
       <> mkCorner 0 rTR
       <> seg (abs rTR + abs rTL - w, 0)
       <> mkCorner 1 rTL
       <> seg (0, abs rTL + abs rBL - h)
       <> mkCorner 2 rBL
       <> seg (w - abs rBL - abs rBR, 0)
       <> mkCorner 3 rBR
      where seg   = lineFromOffsets . (:[]) . r2
            diag  = sqrt (w * w + h * h)
            -- to clamp corner radius, need to compare with other corners that share an
            -- edge. If the corners overlap then reduce the largest corner first, as far
            -- as 50% of the edge in question.
            rTL                 = clampCnr radiusTR radiusBL radiusBR radiusTL
            rBL                 = clampCnr radiusBR radiusTL radiusTR radiusBL
            rTR                 = clampCnr radiusTL radiusBR radiusBL radiusTR
            rBR                 = clampCnr radiusBL radiusTR radiusTL radiusBR
            clampCnr rx ry ro r = let (rx',ry',ro',r') = (rx opts, ry opts, ro opts, r opts)
                                    in clampDiag ro' . clampAdj h ry' . clampAdj w rx' $ r'
            -- prevent curves of adjacent corners from overlapping
            clampAdj len adj r  = if abs r > len/2
                                    then sign r * max (len/2) (min (len - abs adj) (abs r))
                                    else r
            -- prevent inward curves of diagonally opposite corners from intersecting
            clampDiag opp r     = if r < 0 && opp < 0 && abs r > diag / 2
                                    then sign r * max (diag / 2) (min (abs r) (diag + opp))
                                    else r
            sign n = if n < 0 then -1 else 1
            mkCorner k r | r == 0    = mempty
                         | r < 0     = doArc 3 2
                         | otherwise = doArc 0 1
                         where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: Turn)

    data RoundedRectOpts = RoundedRectOpts { radiusTL :: Double
                                           , radiusTR :: Double
                                           , radiusBL :: Double
                                           , radiusBR :: Double
                                           }
    instance Default RoundedRectOpts where
      def = RoundedRectOpts 0 0 0 0