{-# LANGUAGE ConstraintKinds #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Points
-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Special functions for points in R2.
--
-----------------------------------------------------------------------------

{-# LANGUAGE TypeFamilies #-}

module Diagrams.TwoD.Points where

import Data.List

import Diagrams.Core
import Diagrams.TwoD.Vector
import Diagrams.TwoD.Types (P2)

import Linear.Affine

-- | Find the convex hull of a list of points using Andrew's monotone chain
--   algorithm O(n log n).
--   
--   Returns clockwise list of points starting from the left-most point.
convexHull2D :: OrderedField n => [P2 n] -> [P2 n]
convexHull2D :: forall n. OrderedField n => [P2 n] -> [P2 n]
convexHull2D [P2 n]
ps = [P2 n] -> [P2 n]
forall a. HasCallStack => [a] -> [a]
init [P2 n]
upper [P2 n] -> [P2 n] -> [P2 n]
forall a. [a] -> [a] -> [a]
++ [P2 n] -> [P2 n]
forall a. [a] -> [a]
reverse ([P2 n] -> [P2 n]
forall a. HasCallStack => [a] -> [a]
tail [P2 n]
lower)
  where
    ([P2 n]
upper, [P2 n]
lower) = [P2 n] -> ([P2 n], [P2 n])
forall n. OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull ([P2 n] -> [P2 n]
forall a. Ord a => [a] -> [a]
sort [P2 n]
ps)

-- | Find the convex hull of a set of points already sorted in the x direction. 
--   The first list of the tuple is the upper hull going clockwise from 
--   left-most to right-most point. The second is the lower hull from 
--   right-most to left-most in the anti-clockwise direction.
sortedConvexHull :: OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull :: forall n. OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull [P2 n]
ps = (Bool -> [P2 n] -> [P2 n]
forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Affine p, Num a) =>
Bool -> [p a] -> [p a]
chain Bool
True [P2 n]
ps, Bool -> [P2 n] -> [P2 n]
forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Affine p, Num a) =>
Bool -> [p a] -> [p a]
chain Bool
False [P2 n]
ps)
 where
   chain :: Bool -> [p a] -> [p a]
chain Bool
upper (p a
p1_:p a
p2_:[p a]
rest_) =
     case V2 a -> p a -> [p a] -> Either [p a] [p a]
go (p a
p2_ p a -> p a -> Diff p a
forall a. Num a => p a -> p a -> Diff p a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p a
p1_) p a
p2_ [p a]
rest_ of
       Right [p a]
l -> p a
p1_p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
:[p a]
l
       Left [p a]
l  -> Bool -> [p a] -> [p a]
chain Bool
upper (p a
p1_p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
:[p a]
l)
     where
       test :: a -> Bool
test = if Bool
upper then (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0) else (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0)
       -- find the convex hull by comparing the angles of the vectors with
       -- the cross product and backtracking if necessary
       go :: V2 a -> p a -> [p a] -> Either [p a] [p a]
go V2 a
dir p a
p1 l :: [p a]
l@(p a
p2:[p a]
rest)
         -- backtrack if the direction is outward
         | a -> Bool
test (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ V2 a
dir V2 a -> V2 a -> a
forall n. Num n => V2 n -> V2 n -> n
`cross2` V2 a
Diff p a
dir' = [p a] -> Either [p a] [p a]
forall a b. a -> Either a b
Left [p a]
l
         | Bool
otherwise                =
             case V2 a -> p a -> [p a] -> Either [p a] [p a]
go V2 a
Diff p a
dir' p a
p2 [p a]
rest of
               Left [p a]
m  -> V2 a -> p a -> [p a] -> Either [p a] [p a]
go V2 a
dir p a
p1 [p a]
m
               Right [p a]
m -> [p a] -> Either [p a] [p a]
forall a b. b -> Either a b
Right (p a
p1p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
:[p a]
m)
         where
           dir' :: Diff p a
dir' = p a
p2 p a -> p a -> Diff p a
forall a. Num a => p a -> p a -> Diff p a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p a
p1
       go V2 a
_ p a
p1 [p a]
p = [p a] -> Either [p a] [p a]
forall a b. b -> Either a b
Right (p a
p1p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
:[p a]
p)

   chain Bool
_ [p a]
l = [p a]
l