```{-# Language MultiParamTypeClasses #-}
{-# Language TypeSynonymInstances #-}
{-# Language FlexibleInstances #-}
{-# Language FlexibleContexts #-}
--------------------------------------------------------------------------------
-- |
-- Module     : Geometry.SetOperations.BRep
-- Copyright  : (C) 2017 Maksymilian Owsianny
-- Maintainer : Maksymilian.Owsianny@gmail.com
--
-- Boundary representations for conversion to and from BSP/Volumes.
--
--------------------------------------------------------------------------------
module Geometry.SetOperations.BRep
( FromPolytopeRep (..)
, ToPolytopeRep   (..)

, Poly3 (..), Poly3D
, PolyT3 (..), PolyT3D
) where

import Protolude
import Linear.Affine (Point)
import Linear
import qualified Data.Map as Map

import Data.EqZero

-- import qualified Data.Vector.Generic as Vector
import Data.Vector.Generic ((!))
import qualified Data.Vector as T

import Geometry.Plane.General
import Geometry.SetOperations.Facet
import Geometry.SetOperations.CrossPoint
import Geometry.SetOperations.Clip

-- | Convert from polytope to a list of Facets.
class FromPolytopeRep p b v n where
fromPolytopeRep :: p v n -> [Facet b v n]

-- | Convert from list of Facets to a polytope boundary representation.
class ToPolytopeRep p b v n where
toPolytopeRep :: [Facet b v n] -> p v n

--------------------------------------------------------------------------------

-- | Indexed 3-BRep as a list of convex polygons. Continent as a way to
-- introduce new base shapes into the constructive geometry context.
data Poly3 v n = Poly3 (T.Vector (Point v n)) [[Int]]
type Poly3D = Poly3 V3 Double

instance ( MakePlane v n, Eq (v n), Foldable v, Applicative v, R3 v
, Num n, Ord n, EqZero n
) => FromPolytopeRep Poly3 (FB3 v n) v n where
fromPolytopeRep = makeFacets3

{-# SPECIALIZE makeFacets3 :: Poly3D -> [Facet3D] #-}

-- I assume valid indexes for now, without checks.
-- Will need to make it safe in the future.
-- There is also assumption that each point is shared by 3 planes
-- and that each eadge is shared by 2 planes.
makeFacets3 :: (MakePlane v n, Foldable v, Applicative v, R3 v, Ord n, EqZero n)
=> (Num n, Eq (v n))
=> Poly3 v n -> [Facet (FB3 v n) v n]
makeFacets3 (Poly3 ps is) = zipWith Facet planes boundries
where
points = map (map (ps!)) is
planes = map (\(a:b:c:_) -> unsafeMakePlane \$ vec3 a b c) points

mkPlaneEdge (p, es) = map (,[p]) es

edges    = map (map mkOrdPair . edges2) is
edgesMap = Map.fromListWith (<>) \$ concatMap mkPlaneEdge \$ zip planes edges

edgePlanePairs = map (mapMaybe (flip Map.lookup edgesMap)) edges
edgePlanes     = zipWith edgeOnly planes edgePlanePairs
edgeOnly p es  = map (\(a:b:_) -> if p == a then b else a) es

uniqueCrossPoints = fmap toCrossPoint ps
crossPoints       = map (map (uniqueCrossPoints!)) is

boundries = zipWith (\a b -> zip a b) crossPoints edgePlanes

data OrdPair a = OrdPair !a !a deriving (Show, Eq, Ord)
mkOrdPair :: Ord a => (a, a) -> OrdPair a
mkOrdPair (a, b) = if a > b then OrdPair a b else OrdPair b a

{-# INLINE edges2 #-}
edges2 :: [a] -> [(a,a)]
edges2 as = zip as (drop 1 \$ cycle as)

--------------------------------------------------------------------------------

-- | Simple direct 3-BRep as a list of triangles. Useful as an output after
-- performing specified set operations of the base shapes for rendering.
newtype PolyT3 v n = PolyT3 [ [Point v n] ]

type PolyT3D = PolyT3 V3 Double

instance ToPolytopeRep PolyT3 (FB3 v n) v n where
toPolytopeRep fs = PolyT3 (concatMap f fs)
where
f (Facet _ bd) = tris \$ map (getPoint . fst) bd

tris :: [a] -> [[a]]
tris ps = take triNum \$ concat \$ zipWith mkTri pps rps
where
triNum = length ps - 2
pps    = egs ps
rps    = egs \$ reverse ps
egs xs = zip xs \$ drop 1 xs
mkTri (a,b) (n,m) = [[a, m, n], [m, a, b]]

```