{-# OPTIONS -Wno-incomplete-uni-patterns #-}
module Polyhedra
    ( translateXY
    , rotateXY
    , polyToEdges
    , constructEdgesList
    , boxXYZ
    , boxABC
    , boxXYZnobase
    , polyToGeoRender
    , polysToPic
    ) where
import Geometry
import Polyhedra.Data
import Picture.Data
import Picture

import Data.Maybe
import Data.List
import Data.Bifunctor
import Control.Lens

translateXY :: Float -> Float -> Polyhedra -> Polyhedra
translateXY x y = pyFaces %~ map (map $ first tran)
  where
    tran (V3 a b c) = V3 (a+x) (b+y) c

rotateXY :: Float -> Polyhedra -> Polyhedra
rotateXY = over pyFaces . map . map . first . rotate3z

constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face) 
    ++ constructEdges faces
  where
    otherEdges = concatMap faceEdges faces
constructEdges _ = []

-- | a version of construct edges that directly returns the flattened list of
-- tuples
constructEdgesList :: [[Point3]] -> [Point3]
constructEdgesList (face:faces) = concatMap (findReverseEdgeList otherEdges) (faceEdges face) 
    ++ constructEdgesList faces
  where
    otherEdges = concatMap faceEdges faces
constructEdgesList _ = []

findReverseEdge 
    :: [(Point3,Point3,Point3)] 
    -> (Point3,Point3,Point3) 
    -> Maybe (Point3,Point3,Point3,Point3)
findReverseEdge otherEdges (x,y,z) = (\(_,_,n) -> (x,y,z,n))
    <$> find (\(a,b,_) -> (x,y) == (b,a)) otherEdges

findReverseEdgeList
    :: [(Point3,Point3,Point3)] 
    -> (Point3,Point3,Point3) 
    -> [Point3]
findReverseEdgeList a b = case findReverseEdge a b of
    Nothing -> []
    Just (x,y,z,w) -> [x,y,z,w]

faceEdges :: [Point3] -> [(Point3,Point3,Point3)]
faceEdges xs = zipWith addNormal xs (tail xs ++ [head xs])
  where
    addNormal x y = (x,y,n)
    (a:b:c:_) = xs
    n = crossProd (b -.-.- a) (c -.-.- a)

rhombus :: Point3 -> Point3 -> [Point3]
{-# INLINE rhombus #-}
rhombus a b = 
    [V3 0 0 0
    ,a
    ,a +.+.+ b
    ,b
    ]
boxXYZnobase :: Float -> Float -> Float -> [[Point3]]
{-# INLINE boxXYZnobase #-}
boxXYZnobase x y z = 
    [ map (+.+.+ V3 0 0 z) $ reverse bottomFace
    , frontFace
    , map (+.+.+ V3 0 y 0) $ reverse frontFace
    , sideFace
    , map (+.+.+ V3 x 0 0) $ reverse sideFace
    ]
  where
    bottomFace = rhombus (V3 0 y 0) (V3 x 0 0) 
    frontFace  = rhombus (V3 x 0 0) (V3 0 0 z)
    sideFace   = rhombus (V3 0 0 z) (V3 0 y 0)

boxXYZ :: Float -> Float -> Float -> [[Point3]]
{-# INLINE boxXYZ #-}
boxXYZ x y z = 
    [ bottomFace
    , map (+.+.+ V3 0 0 z) $ reverse bottomFace
    , frontFace
    , map (+.+.+ V3 0 y 0) $ reverse frontFace
    , sideFace
    , map (+.+.+ V3 x 0 0) $ reverse sideFace
    ]
  where
    bottomFace = rhombus (V3 0 y 0) (V3 x 0 0) 
    frontFace  = rhombus (V3 x 0 0) (V3 0 0 z)
    sideFace   = rhombus (V3 0 0 z) (V3 0 y 0)
boxABC :: Point3 -> Point3 -> Point3 -> [[Point3]]
boxABC a b c =
    [ faceNC
    , map (+.+.+ c) $ reverse faceNC
    , faceNB
    , map (+.+.+ b) $ reverse faceNB
    , faceNA
    , map (+.+.+ a) $ reverse faceNA
    ]
  where
    faceNC = rhombus b a
    faceNB = rhombus a c
    faceNA = rhombus c b

polyToPics :: Polyhedra -> [Picture]
polyToPics = map poly3Col . _pyFaces

polysToPic :: [Polyhedra] -> Picture
polysToPic = foldMap (fold . polyToPics)

polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
polyToEdges = map denormalEdges . constructEdges . map (map fst) . _pyFaces

denormalEdges :: (Point3,Point3,Point3,Point3) -> (Point3,Point3,Point3,Point3)
denormalEdges (a,b,n,m) = (a,b,a - x, b - y)
  where
    x = crossProd (b - a) n
    y = crossProd (a - b) m
    
polyToGeoRender :: Polyhedra -> [Point3]
polyToGeoRender = concatMap (polyToTris . map fst) . _pyFaces