-- | Predefined shapes.
module Geometry.Shapes (
      haskellLogo
    , regularPolygon
    , spiralPolygon
) where



import Geometry.Core



-- $setup
-- >>> import Draw as D
-- >>> import qualified Graphics.Rendering.Cairo as C



-- | Haskell logo, in the order @[left, lambda, upper dash, lower dash]@.
--
-- The logo is scaled so that the height of the logo is @1@.
--
-- Each polygon starts at the bottom/left corner in screen coordinates (i.e.
-- @(0,0)@ is at the top right, x extends to the right, and y extends
-- downwards).
--
-- The orientation is in mathematically positive direction, i.e. clockwise in
-- screen coordinates.
--
-- <<docs/haddock/Geometry/Shapes/haskell_logo.svg>>
--
-- === __(image code)__
-- >>> :{
-- haddockRender "Geometry/Shapes/haskell_logo.svg" 130 100 $ \_ -> do
--     coordinateSystem CairoStandard_ZeroTopLeft_XRight_YDown
--     for_ haskellLogo $ \polygon -> do
--         sketch (transform (translate (Vec2 10 10) <> scale 80) polygon)
--         C.stroke
-- :}
-- Generated file: size 3KB, crc32: 0x98aab3be
--
-- >>> all (\polygon -> polygonOrientation polygon == PolygonPositive) haskellLogo
-- True
haskellLogo :: [Polygon]
haskellLogo :: [Polygon]
haskellLogo = [Polygon] -> [Polygon]
rescaleNormalizePolygons [Polygon]
haskellLogoRaw

-- | Rescale so that in drawing coordinates, the top/left is at the origin, and
-- the height extents is 1.
rescaleNormalizePolygons :: [Polygon] -> [Polygon]
rescaleNormalizePolygons :: [Polygon] -> [Polygon]
rescaleNormalizePolygons [Polygon]
polygons =
    let BoundingBox (Vec2 Double
minX Double
minY) (Vec2 Double
_maxX Double
maxY) = [Polygon] -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox [Polygon]
polygons
        scaleFactor :: Double
scaleFactor = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
maxY Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minY)
        transformation :: Transformation
transformation = Double -> Transformation
scale Double
scaleFactor Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Vec2 -> Transformation
translate (Double -> Double -> Vec2
Vec2 (- Double
minX) (- Double
minY))
    in Transformation -> [Polygon] -> [Polygon]
forall geo. Transform geo => Transformation -> geo -> geo
transform Transformation
transformation [Polygon]
polygons

haskellLogoRaw :: [Polygon]
haskellLogoRaw :: [Polygon]
haskellLogoRaw = [Polygon
left, Polygon
lambda, Polygon
upper, Polygon
lower]
  where
    left :: Polygon
left   = [Vec2] -> Polygon
Polygon [Double -> Double -> Vec2
Vec2 Double
0 Double
340.15625, Double -> Double -> Vec2
Vec2 Double
113.386719 Double
170.078125, Double -> Double -> Vec2
Vec2 Double
0 Double
0, Double -> Double -> Vec2
Vec2 Double
85.039062 Double
0, Double -> Double -> Vec2
Vec2 Double
198.425781 Double
170.078125, Double -> Double -> Vec2
Vec2 Double
85.039062 Double
340.15625]
    lambda :: Polygon
lambda = [Vec2] -> Polygon
Polygon [Double -> Double -> Vec2
Vec2 Double
113.386719 Double
340.15625, Double -> Double -> Vec2
Vec2 Double
226.773438 Double
170.078125, Double -> Double -> Vec2
Vec2 Double
113.386719 Double
0, Double -> Double -> Vec2
Vec2 Double
198.425781 Double
0, Double -> Double -> Vec2
Vec2 Double
425.195312 Double
340.15625, Double -> Double -> Vec2
Vec2 Double
340.15625 Double
340.15625, Double -> Double -> Vec2
Vec2 Double
269.292969 Double
233.859375, Double -> Double -> Vec2
Vec2 Double
198.425781 Double
340.15625]
    upper :: Polygon
upper  = [Vec2] -> Polygon
Polygon [Double -> Double -> Vec2
Vec2 Double
330.710938 Double
155.90625, Double -> Double -> Vec2
Vec2 Double
292.914062 Double
99.214844, Double -> Double -> Vec2
Vec2 Double
481.890625 Double
99.210938, Double -> Double -> Vec2
Vec2 Double
481.890625 Double
155.90625]
    lower :: Polygon
lower  = [Vec2] -> Polygon
Polygon [Double -> Double -> Vec2
Vec2 Double
387.402344 Double
240.945312, Double -> Double -> Vec2
Vec2 Double
349.609375 Double
184.253906, Double -> Double -> Vec2
Vec2 Double
481.890625 Double
184.25, Double -> Double -> Vec2
Vec2 Double
481.890625 Double
240.945312]

-- | Rectangular spiral. Useful as an example for very much non-convex polygons. 'PolygonPositive' orientation.
--
-- <<docs/haddock/Geometry/Shapes/spiral_polygon.svg>>
--
-- === __(image code)__
-- >>> :{
-- haddockRender "Geometry/Shapes/spiral_polygon.svg" 100 100 $ \_ -> do
--     coordinateSystem (MathStandard_ZeroCenter_XRight_YUp 100 100)
--     let polygon = spiralPolygon 8 10
--     sketch polygon
--     C.stroke
-- :}
-- Generated file: size 2KB, crc32: 0x7b879da5
--
-- >>> polygonOrientation (spiralPolygon 8 10) == PolygonPositive
-- True
spiralPolygon
    :: Int -- ^ Winding number
    -> Double -- ^ Width
    -> Polygon
spiralPolygon :: Int -> Double -> Polygon
spiralPolygon Int
n Double
width = [Vec2] -> Polygon
Polygon ([Vec2] -> [Vec2]
forall a. [a] -> [a]
reverse ((Vec2 -> Vec2 -> Vec2) -> Vec2 -> [Vec2] -> [Vec2]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
(+.) (Double -> Double -> Vec2
Vec2 Double
0 Double
0) [Vec2]
relativeSpiral))
  where
    instructions :: [(Int, Vec2 -> Vec2)]
instructions = [[(Int, Vec2 -> Vec2)]] -> [(Int, Vec2 -> Vec2)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Int] -> [Vec2 -> Vec2] -> [(Int, Vec2 -> Vec2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
n] ((Vec2 -> Vec2) -> [Vec2 -> Vec2]
forall a. a -> [a]
repeat Vec2 -> Vec2
turnLeft)
                          , [(Int
1, Vec2 -> Vec2
turnLeft)]
                          , [(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Vec2 -> Vec2
turnRight)]
                          , [Int] -> [Vec2 -> Vec2] -> [(Int, Vec2 -> Vec2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4 .. Int
1] ((Vec2 -> Vec2) -> [Vec2 -> Vec2]
forall a. a -> [a]
repeat Vec2 -> Vec2
turnRight)
                          ]
    relativeSpiral :: [Vec2]
relativeSpiral = [(Int, Vec2 -> Vec2)] -> Vec2 -> [Vec2]
forall {t} {a}.
(VectorSpace t, Integral a) =>
[(a, t -> t)] -> t -> [t]
go [(Int, Vec2 -> Vec2)]
instructions (Double -> Double -> Vec2
Vec2 Double
1 Double
0)
      where
        go :: [(a, t -> t)] -> t -> [t]
go [] t
_dir = []
        go ((a
len, t -> t
makeCorner) : [(a, t -> t)]
rest) t
dir = Double
widthDouble -> Double -> Double
forall a. Num a => a -> a -> a
*a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len Double -> t -> t
forall v. VectorSpace v => Double -> v -> v
*. t
dir t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [(a, t -> t)] -> t -> [t]
go [(a, t -> t)]
rest (t -> t
makeCorner t
dir)
    turnLeft :: Vec2 -> Vec2
turnLeft  (Vec2 Double
x Double
y) = Double -> Double -> Vec2
Vec2   Double
y  (-Double
x)
    turnRight :: Vec2 -> Vec2
turnRight (Vec2 Double
x Double
y) = Double -> Double -> Vec2
Vec2 (-Double
y)   Double
x

-- | Regular n-gon with radius 1, oriented 'PolygonPositive',
-- and starting with the first corner on the positive x axis.
--
-- <<docs/haddock/Geometry/Shapes/regular_pentagon.svg>>
--
-- === __(image code)__
-- >>> :{
-- haddockRender "Geometry/Shapes/regular_pentagon.svg" 100 100 $ \_ -> do
--     let polygon = transform (translate (Vec2 50 50) <> scale 45) (regularPolygon 5)
--     sketch polygon
--     C.stroke
-- :}
-- Generated file: size 2KB, crc32: 0x43d94b0e
--
-- >>> polygonOrientation (regularPolygon 5) == PolygonPositive
-- True
regularPolygon :: Int -> Polygon
regularPolygon :: Int -> Polygon
regularPolygon Int
n =
    let angleStepSize :: Double
angleStepSize = Double
360Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    in [Vec2] -> Polygon
Polygon [Angle -> Double -> Vec2
polar (Double -> Angle
deg Double
angle) Double
1 | Double
angle <- (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
360) ((Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
angleStepSize) Double
0)]