{-# 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 :: * -> *} {b}.
(Diff p ~ V2, Ord b, Affine p, Num b) =>
Bool -> [p b] -> [p b]
chain Bool
True [P2 n]
ps, Bool -> [P2 n] -> [P2 n]
forall {p :: * -> *} {b}.
(Diff p ~ V2, Ord b, Affine p, Num b) =>
Bool -> [p b] -> [p b]
chain Bool
False [P2 n]
ps)
 where
   chain :: Bool -> [p b] -> [p b]
chain Bool
upper (p b
p1_:p b
p2_:[p b]
rest_) =
     case V2 b -> p b -> [p b] -> Either [p b] [p b]
go (p b
p2_ p b -> p b -> Diff p b
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 b
p1_) p b
p2_ [p b]
rest_ of
       Right [p b]
l -> p b
p1_p b -> [p b] -> [p b]
forall a. a -> [a] -> [a]
:[p b]
l
       Left [p b]
l  -> Bool -> [p b] -> [p b]
chain Bool
upper (p b
p1_p b -> [p b] -> [p b]
forall a. a -> [a] -> [a]
:[p b]
l)
     where
       test :: b -> Bool
test = if Bool
upper then (b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>b
0) else (b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<b
0)
       -- find the convex hull by comparing the angles of the vectors with
       -- the cross product and backtracking if necessary
       go :: V2 b -> p b -> [p b] -> Either [p b] [p b]
go V2 b
dir p b
p1 l :: [p b]
l@(p b
p2:[p b]
rest)
         -- backtrack if the direction is outward
         | b -> Bool
test (b -> Bool) -> b -> Bool
forall a b. (a -> b) -> a -> b
$ V2 b
dir V2 b -> V2 b -> b
forall n. Num n => V2 n -> V2 n -> n
`cross2` V2 b
Diff p b
dir' = [p b] -> Either [p b] [p b]
forall a b. a -> Either a b
Left [p b]
l
         | Bool
otherwise                =
             case V2 b -> p b -> [p b] -> Either [p b] [p b]
go V2 b
Diff p b
dir' p b
p2 [p b]
rest of
               Left [p b]
m  -> V2 b -> p b -> [p b] -> Either [p b] [p b]
go V2 b
dir p b
p1 [p b]
m
               Right [p b]
m -> [p b] -> Either [p b] [p b]
forall a b. b -> Either a b
Right (p b
p1p b -> [p b] -> [p b]
forall a. a -> [a] -> [a]
:[p b]
m)
         where
           dir' :: Diff p b
dir' = p b
p2 p b -> p b -> Diff p b
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 b
p1
       go V2 b
_ p b
p1 [p b]
p = [p b] -> Either [p b] [p b]
forall a b. b -> Either a b
Right (p b
p1p b -> [p b] -> [p b]
forall a. a -> [a] -> [a]
:[p b]
p)

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