{- 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

-- export one function, which refines polylines.
module Graphics.Implicit.Export.Render.RefineSegs (refine) where

import Prelude((<), (/), (<>), (*), ($), (&&), (-), (+), (.), (>), abs, (<=))

import Graphics.Implicit.Definitions (ℝ, ℝ2, Polyline(Polyline), minℝ, Fastℕ, Obj2)
import Graphics.Implicit.Export.Util (centroid)
import Linear ( Metric(norm, dot), V2(V2), normalize, (^*) )

default (Fastℕ, ℝ)

-- | The purpose of refine is to add detail to a polyline aproximating
--   the boundary of an implicit function and to remove redundant points.
--   We break this into two steps: detail and then simplify.
refine :: ℝ -> Obj2 -> Polyline -> Polyline
refine :: ℝ -> Obj2 -> Polyline -> Polyline
refine ℝ
res Obj2
obj = ℝ -> Polyline -> Polyline
simplify ℝ
res (Polyline -> Polyline)
-> (Polyline -> Polyline) -> Polyline -> Polyline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> Obj2 -> Polyline -> Polyline
detail' ℝ
res Obj2
obj

-- | We wrap detail to make it ignore very small segments, and to pass in
--   an initial value for a depth counter argument.
-- FIXME: magic number.
detail' :: ℝ -> (ℝ2 -> ℝ) -> Polyline -> Polyline
detail' :: ℝ -> Obj2 -> Polyline -> Polyline
detail' ℝ
res Obj2
obj (Polyline [p1 :: ℝ2
p1@(V2 ℝ
x1 ℝ
y1), p2 :: ℝ2
p2@(V2 ℝ
x2 ℝ
y2)])
  | (ℝ
x2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
x1)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
x2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
x1) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ (ℝ
y2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
y1)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
y2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
y1) ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
resℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
resℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
200 = Fastℕ -> ℝ -> Obj2 -> Polyline -> Polyline
detail Fastℕ
0 ℝ
res Obj2
obj (Polyline -> Polyline) -> Polyline -> Polyline
forall a b. (a -> b) -> a -> b
$ [ℝ2] -> Polyline
Polyline [ℝ2
p1,ℝ2
p2]
detail' ℝ
_ Obj2
_ Polyline
a = Polyline
a

-- | detail adds new points to a polyline to add more detail.
-- FIXME: all of the magic numbers.
detail :: Fastℕ -> ℝ -> (ℝ2 -> ℝ) -> Polyline -> Polyline
detail :: Fastℕ -> ℝ -> Obj2 -> Polyline -> Polyline
detail Fastℕ
n ℝ
res Obj2
obj (Polyline [ℝ2
p1, ℝ2
p2]) | Fastℕ
n Fastℕ -> Fastℕ -> Bool
forall a. Ord a => a -> a -> Bool
< Fastℕ
2 =
    let
        mid :: ℝ2
mid = [ℝ2] -> ℝ2
forall a (t :: * -> *) (f :: * -> *).
(Fractional a, Foldable t, Applicative f, Num (f a)) =>
t (f a) -> f a
centroid [ℝ2
p1,ℝ2
p2]
        midval :: ℝ
midval = Obj2
obj ℝ2
mid
    in if ℝ -> ℝ
forall a. Num a => a -> a
abs ℝ
midval ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
res ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
40
       then [ℝ2] -> Polyline
Polyline [ℝ2
p1, ℝ2
p2]
       else
         let
           normal :: ℝ2
normal = (\(V2 ℝ
a ℝ
b) -> ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
b (-ℝ
a)) (ℝ2 -> ℝ2) -> ℝ2 -> ℝ2
forall a b. (a -> b) -> a -> b
$ ℝ2 -> ℝ2
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (ℝ2
p2 ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- ℝ2
p1)
           derivN :: ℝ
derivN = -(Obj2
obj (ℝ2
mid ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- (ℝ2
normal ℝ2 -> ℝ -> ℝ2
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (ℝ
midvalℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2))) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
midval) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (ℝ
2ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
midval)
         in
           if ℝ -> ℝ
forall a. Num a => a -> a
abs ℝ
derivN ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0.5 Bool -> Bool -> Bool
&& ℝ -> ℝ
forall a. Num a => a -> a
abs ℝ
derivN ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
2 Bool -> Bool -> Bool
&& ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ
midvalℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
derivN) ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
3ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
res
           then
             let
               mid' :: ℝ2
mid' = ℝ2
mid ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- (ℝ2
normal ℝ2 -> ℝ -> ℝ2
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (ℝ
midval ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
derivN))
             in
               Polyline -> Polyline -> Polyline
addPolylines (Fastℕ -> ℝ -> Obj2 -> Polyline -> Polyline
detail (Fastℕ
nFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
+Fastℕ
1) ℝ
res Obj2
obj ([ℝ2] -> Polyline
Polyline [ℝ2
p1, ℝ2
mid'])) (Fastℕ -> ℝ -> Obj2 -> Polyline -> Polyline
detail (Fastℕ
nFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
+Fastℕ
1) ℝ
res Obj2
obj ( [ℝ2] -> Polyline
Polyline [ℝ2
mid', ℝ2
p2] ))
           -- NOTE: we used to have a routine for increasing the sharpness of corners here, but it was too buggy. - JEL
           else [ℝ2] -> Polyline
Polyline [ℝ2
p1, ℝ2
p2]

detail Fastℕ
_ ℝ
_ Obj2
_ Polyline
x = Polyline
x

-- FIXME: re-add simplify2 and simplify3?
simplify :: ℝ -> Polyline -> Polyline
simplify :: ℝ -> Polyline -> Polyline
simplify ℝ
_ = {-simplify3 . simplify2 res . -} Polyline -> Polyline
simplify1

simplify1 :: Polyline -> Polyline
simplify1 :: Polyline -> Polyline
simplify1 (Polyline (ℝ2
a:ℝ2
b:ℝ2
c:[ℝ2]
xs)) =
    if ℝ -> ℝ
forall a. Num a => a -> a
abs ( ((ℝ2
b ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- ℝ2
a) ℝ2 -> Obj2
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` (ℝ2
c ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- ℝ2
a)) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- Obj2
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (ℝ2
b ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- ℝ2
a) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* Obj2
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (ℝ2
c ℝ2 -> ℝ2 -> ℝ2
forall a. Num a => a -> a -> a
- ℝ2
a) ) ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<= ℝ
minℝ
    then Polyline -> Polyline
simplify1 ([ℝ2] -> Polyline
Polyline (ℝ2
aℝ2 -> [ℝ2] -> [ℝ2]
forall a. a -> [a] -> [a]
:ℝ2
cℝ2 -> [ℝ2] -> [ℝ2]
forall a. a -> [a] -> [a]
:[ℝ2]
xs))
    else Polyline -> Polyline -> Polyline
addPolylines ([ℝ2] -> Polyline
Polyline [ℝ2
a]) (Polyline -> Polyline
simplify1 ([ℝ2] -> Polyline
Polyline (ℝ2
bℝ2 -> [ℝ2] -> [ℝ2]
forall a. a -> [a] -> [a]
:ℝ2
cℝ2 -> [ℝ2] -> [ℝ2]
forall a. a -> [a] -> [a]
:[ℝ2]
xs)))
simplify1 Polyline
a = Polyline
a

addPolylines :: Polyline -> Polyline -> Polyline
addPolylines :: Polyline -> Polyline -> Polyline
addPolylines (Polyline [ℝ2]
as) (Polyline [ℝ2]
bs) = [ℝ2] -> Polyline
Polyline ([ℝ2]
as [ℝ2] -> [ℝ2] -> [ℝ2]
forall a. Semigroup a => a -> a -> a
<> [ℝ2]
bs)

{-
simplify2 :: ℝ -> Polyline -> Polyline
simplify2 res [a,b,c,d] =
    if norm (b - c) < res/10
    then [a, ((b + c) / (2::ℝ)), d]
    else [a,b,c,d]
simplify2 _ a = a

simplify3 (a:as) | length as > 5 = simplify3 $ a : half (init as) <> [last as]
    where
        half (a:b:xs) = a : half xs
        half a = a
simplify3 a = a

-}