{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

module Graphics.Implicit.Export.Render.GetSegs (getSegs) where

import Prelude((-), Bool(True, False), sqrt, (+), (*), (/=), map, (.), filter, ($), (<=))

import Graphics.Implicit.Definitions (ℝ, ℝ2, Obj2, Polyline(Polyline))
import Graphics.Implicit.Export.Render.RefineSegs (refine)
import Graphics.Implicit.Export.Util (centroid)
import Linear (V2(V2))

{- The goal of getSegs is to create polylines to separate
   the interior and exterior vertices of a square intersecting
   an object described by an implicit function.

      O.....O        O.....O
      :     :        :     :
      :     *        :  ,--*
      *     :   =>   *--   :
      :     :        :     :
      #.....#        #.....#

  An interior point is one at which obj is negative.

  What are all the variables?
  ===========================

  To allow data sharing, lots of values we
  could calculate are instead arguments.

       positions               obj values
       ---------               ----------

  (x1,y2) .. (x2,y2)    obj   x1y2 .. x2y2
     :          :       =>     :       :
  (x1,y1) .. (x2,y1)          x1y1 .. x2y2

               mid points
               ----------

               (midy2V, y2)
                 = midy2

               ......*......
               :           :
 (x1, midx1V)  *           *  (x2, midx2V)
   = midx1     :           :     = midx2
               :.....*.....:

               (midy1V, y1)
                 = midy1

-}
getSegs :: ℝ2 -> ℝ2 -> Obj2 -> (ℝ,ℝ,ℝ,ℝ) -> (ℝ,ℝ,ℝ,ℝ) -> [Polyline]
getSegs :: ℝ2 -> ℝ2 -> Obj2 -> (ℝ, ℝ, ℝ, ℝ) -> (ℝ, ℝ, ℝ, ℝ) -> [Polyline]
getSegs p1 :: ℝ2
p1@(V2 ℝ
x ℝ
y) ℝ2
p2 Obj2
obj (ℝ
x1y1, ℝ
x2y1, ℝ
x1y2, ℝ
x2y2) (ℝ
midx1V,ℝ
midx2V,ℝ
midy1V,ℝ
midy2V) =
    let
        -- Let's evaluate obj at a few points...
        c :: ℝ
c = Obj2
obj (forall a (t :: * -> *) (f :: * -> *).
(Fractional a, Foldable t, Applicative f, Num (f a)) =>
t (f a) -> f a
centroid [ℝ2
p1,ℝ2
p2])

        -- TODO(sandy): i might have swapped (^+^) for - here
        (V2 ℝ
dx ℝ
dy) = ℝ2
p2 forall a. Num a => a -> a -> a
- ℝ2
p1
        res :: ℝ
res = forall a. Floating a => a -> a
sqrt (ℝ
dxforall a. Num a => a -> a -> a
*ℝ
dy)

        midx1 :: ℝ2
midx1 = forall a. a -> a -> V2 a
V2 ℝ
x        ℝ
midx1V
        midx2 :: ℝ2
midx2 = forall a. a -> a -> V2 a
V2 (ℝ
x forall a. Num a => a -> a -> a
+ ℝ
dx) ℝ
midx2V
        midy1 :: ℝ2
midy1 = forall a. a -> a -> V2 a
V2 ℝ
midy1V   ℝ
y
        midy2 :: ℝ2
midy2 = forall a. a -> a -> V2 a
V2 ℝ
midy2V   (ℝ
y forall a. Num a => a -> a -> a
+ ℝ
dy)

        notPointLine :: Polyline -> Bool
        notPointLine :: Polyline -> Bool
notPointLine (Polyline [ℝ2
np1,ℝ2
np2]) = ℝ2
np1 forall a. Eq a => a -> a -> Bool
/= ℝ2
np2
        notPointLine Polyline
_ = Bool
False

        -- takes straight lines between mid points and subdivides them to
        -- account for sharp corners, etc.

    in forall a b. (a -> b) -> [a] -> [b]
map (ℝ -> Obj2 -> Polyline -> Polyline
refine ℝ
res Obj2
obj) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Polyline -> Bool
notPointLine forall a b. (a -> b) -> a -> b
$ case (ℝ
x1y2 forall a. Ord a => a -> a -> Bool
<= ℝ
0, ℝ
x2y2 forall a. Ord a => a -> a -> Bool
<= ℝ
0,
                                                          ℝ
x1y1 forall a. Ord a => a -> a -> Bool
<= ℝ
0, ℝ
x2y1 forall a. Ord a => a -> a -> Bool
<= ℝ
0) of

        -- An important point here is orientation. If you imagine going along a
        -- generated segment, the interior should be on the left-hand side.

        -- Empty Cases

        (Bool
True,   Bool
True,  Bool
True,  Bool
True) -> []
        (Bool
False, Bool
False, Bool
False, Bool
False) -> []

        -- Horizontal Cases
        ( Bool
True,  Bool
True, Bool
False, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx1, ℝ2
midx2]]
        (Bool
False, Bool
False,  Bool
True,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx2, ℝ2
midx1]]

        -- Vertical Cases
        (Bool
False,  Bool
True, Bool
False,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy2, ℝ2
midy1]]
        ( Bool
True, Bool
False,  Bool
True, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy1, ℝ2
midy2]]

        -- Corner Cases
        ( Bool
True, Bool
False, Bool
False, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx1, ℝ2
midy2]]
        (Bool
False,  Bool
True,  Bool
True,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy2, ℝ2
midx1]]
        ( Bool
True,  Bool
True, Bool
False,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx1, ℝ2
midy1]]
        (Bool
False, Bool
False,  Bool
True, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy1, ℝ2
midx1]]
        ( Bool
True,  Bool
True,  Bool
True, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy1, ℝ2
midx2]]
        (Bool
False, Bool
False, Bool
False,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx2, ℝ2
midy1]]
        ( Bool
True, Bool
False,  Bool
True,  Bool
True) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midx2, ℝ2
midy2]]
        (Bool
False,  Bool
True, Bool
False, Bool
False) -> [[ℝ2] -> Polyline
Polyline [ℝ2
midy2, ℝ2
midx2]]

        -- Dual Corner Cases
        (Bool
True,  Bool
False, Bool
False, Bool
True)  -> if ℝ
c forall a. Ord a => a -> a -> Bool
<= ℝ
0
            then [[ℝ2] -> Polyline
Polyline [ℝ2
midx1, ℝ2
midy1], [ℝ2] -> Polyline
Polyline [ℝ2
midx2, ℝ2
midy2]]
            else [[ℝ2] -> Polyline
Polyline [ℝ2
midx1, ℝ2
midy2], [ℝ2] -> Polyline
Polyline [ℝ2
midx2, ℝ2
midy1]]

        (Bool
False, Bool
True, Bool
True,  Bool
False) -> if ℝ
c forall a. Ord a => a -> a -> Bool
<= ℝ
0
            then [[ℝ2] -> Polyline
Polyline [ℝ2
midy2, ℝ2
midx1], [ℝ2] -> Polyline
Polyline [ℝ2
midy1, ℝ2
midx2]]
            else [[ℝ2] -> Polyline
Polyline [ℝ2
midy1, ℝ2
midx1], [ℝ2] -> Polyline
Polyline [ℝ2
midy2, ℝ2
midx2]]