{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2012, 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.HandlePolylines (cleanLoopsFromSegs) where

import Prelude(Maybe(Just, Nothing), fmap, (.), (==), last, reverse, ($), (<>), (-), (/), abs, (<=), (||), (&&), (*), (>), otherwise, error)

import Graphics.Implicit.Definitions (minℝ, Polyline(Polyline))
import Linear ( V2(V2) )

cleanLoopsFromSegs :: [Polyline] -> [Polyline]
cleanLoopsFromSegs :: [Polyline] -> [Polyline]
cleanLoopsFromSegs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Polyline -> Polyline
reducePolyline forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Polyline] -> [Polyline]
joinSegs

-- | Join polylines that connect.
joinSegs :: [Polyline] -> [Polyline]
joinSegs :: [Polyline] -> [Polyline]
joinSegs (Polyline [ℝ2]
present:[Polyline]
remaining) =
    let
        findNext :: [Polyline] -> (Maybe Polyline, [Polyline])
        findNext :: [Polyline] -> (Maybe Polyline, [Polyline])
findNext (Polyline (ℝ2
p3:[ℝ2]
ps):[Polyline]
segs)
            | ℝ2
p3 forall a. Eq a => a -> a -> Bool
== forall a. [a] -> a
last [ℝ2]
present      = (forall a. a -> Maybe a
Just ([ℝ2] -> Polyline
Polyline (ℝ2
p3forall a. a -> [a] -> [a]
:[ℝ2]
ps)), [Polyline]
segs)
            | forall a. [a] -> a
last [ℝ2]
ps forall a. Eq a => a -> a -> Bool
== forall a. [a] -> a
last [ℝ2]
present = (forall a. a -> Maybe a
Just ([ℝ2] -> Polyline
Polyline forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ ℝ2
p3forall a. a -> [a] -> [a]
:[ℝ2]
ps), [Polyline]
segs)
            | Bool
otherwise               = case [Polyline] -> (Maybe Polyline, [Polyline])
findNext [Polyline]
segs of (Maybe Polyline
res1,[Polyline]
res2) -> (Maybe Polyline
res1,[ℝ2] -> Polyline
Polyline (ℝ2
p3forall a. a -> [a] -> [a]
:[ℝ2]
ps)forall a. a -> [a] -> [a]
:[Polyline]
res2)
        findNext [] = (forall a. Maybe a
Nothing, [])
        findNext (Polyline []:[Polyline]
_) = (forall a. Maybe a
Nothing, [])
    in
        case [Polyline] -> (Maybe Polyline, [Polyline])
findNext [Polyline]
remaining of
            (Maybe Polyline
Nothing, [Polyline]
_) -> [ℝ2] -> Polyline
Polyline [ℝ2]
presentforall a. a -> [a] -> [a]
: [Polyline] -> [Polyline]
joinSegs [Polyline]
remaining
            (Just (Polyline [ℝ2]
match), [Polyline]
others) -> [Polyline] -> [Polyline]
joinSegs forall a b. (a -> b) -> a -> b
$ [ℝ2] -> Polyline
Polyline ([ℝ2]
present forall a. Semigroup a => a -> a -> a
<> [ℝ2]
match) forall a. a -> [a] -> [a]
: [Polyline]
others
joinSegs [] = []

-- | Simplify and sort a polyline.
reducePolyline :: Polyline -> Polyline
reducePolyline :: Polyline -> Polyline
reducePolyline (Polyline (V2 ℝ
x1 ℝ
y1 : V2 ℝ
x2 ℝ
y2 : V2 ℝ
x3 ℝ
y3:[ℝ2]
others))
    -- Remove sequential duplicate points.
    | (ℝ
x1,ℝ
y1) forall a. Eq a => a -> a -> Bool
== (ℝ
x2,ℝ
y2) = Polyline -> Polyline
reducePolyline ([ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x2 ℝ
y2 forall a. a -> [a] -> [a]
: forall a. a -> a -> V2 a
V2 ℝ
x3 ℝ
y3 forall a. a -> [a] -> [a]
: [ℝ2]
others))
    | forall a. Num a => a -> a
abs ( (ℝ
y2forall a. Num a => a -> a -> a
-ℝ
y1)forall a. Fractional a => a -> a -> a
/(ℝ
x2forall a. Num a => a -> a -> a
-ℝ
x1) forall a. Num a => a -> a -> a
- (ℝ
y3forall a. Num a => a -> a -> a
-ℝ
y1)forall a. Fractional a => a -> a -> a
/(ℝ
x3forall a. Num a => a -> a -> a
-ℝ
x1) ) forall a. Ord a => a -> a -> Bool
<= ℝ
minℝ
      Bool -> Bool -> Bool
|| ( (ℝ
x2forall a. Num a => a -> a -> a
-ℝ
x1) forall a. Eq a => a -> a -> Bool
== ℝ
0 Bool -> Bool -> Bool
&& (ℝ
x3forall a. Num a => a -> a -> a
-ℝ
x1) forall a. Eq a => a -> a -> Bool
== ℝ
0 Bool -> Bool -> Bool
&& (ℝ
y2forall a. Num a => a -> a -> a
-ℝ
y1)forall a. Num a => a -> a -> a
*(ℝ
y3forall a. Num a => a -> a -> a
-ℝ
y1) forall a. Ord a => a -> a -> Bool
> ℝ
0) =
      Polyline -> Polyline
reducePolyline ([ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y1 forall a. a -> [a] -> [a]
: forall a. a -> a -> V2 a
V2 ℝ
x3 ℝ
y3 forall a. a -> [a] -> [a]
:[ℝ2]
others))
    | Bool
otherwise = [ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y1 forall a. a -> [a] -> [a]
: Polyline -> [ℝ2]
points (Polyline -> Polyline
reducePolyline ([ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x2 ℝ
y2 forall a. a -> [a] -> [a]
: forall a. a -> a -> V2 a
V2 ℝ
x3 ℝ
y3 forall a. a -> [a] -> [a]
: [ℝ2]
others))))
  where
    points :: Polyline -> [ℝ2]
points (Polyline [ℝ2]
pts) = [ℝ2]
pts
-- | remove sequential duplicate points.
reducePolyline (Polyline (V2 ℝ
x1 ℝ
y1 : V2 ℝ
x2 ℝ
y2 : [ℝ2]
others)) =
    if (ℝ
x1,ℝ
y1) forall a. Eq a => a -> a -> Bool
== (ℝ
x2,ℝ
y2) then Polyline -> Polyline
reducePolyline ([ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x2 ℝ
y2 forall a. a -> [a] -> [a]
: [ℝ2]
others)) else [ℝ2] -> Polyline
Polyline (forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y1 forall a. a -> [a] -> [a]
: forall a. a -> a -> V2 a
V2 ℝ
x2 ℝ
y2 forall a. a -> [a] -> [a]
: [ℝ2]
others)
-- Return the last result.
reducePolyline l :: Polyline
l@(Polyline ((ℝ2
_:[ℝ2]
_))) = Polyline
l
-- Should not happen.
reducePolyline (Polyline []) = forall a. HasCallStack => [Char] -> a
error [Char]
"empty polyline"