{-# Language MultiParamTypeClasses #-}
{-# Language TypeSynonymInstances #-}
{-# Language FlexibleInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module     : Geometry.SetOperations.BRep
-- Copyright  : (C) 2017 Maksymilian Owsianny
-- License    : BSD-style (see LICENSE)
-- 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]]