{-# LANGUAGE TupleSections #-}
module Polyhedra.Geodesic
    where
import Geometry.Data
import Geometry.Vector3D
import Polyhedra.Data

import Data.List
import qualified Data.Map as M

icosahedronPoints :: [Point3]
icosahedronPoints = concat
    [ [V3 0 one gr, V3 one gr 0, V3 gr 0 one]
    | one <- [-1,1]
    , gr  <- [negate (1 + sqrt 5)/2, (1 + sqrt 5)/2 ]
    ]

icosohedronFaces :: [[Point3]]
icosohedronFaces = map orderFace $
    rectEdgeFaces ++ map (map rotTrip) rectEdgeFaces ++ map (map (rotTrip . rotTrip)) rectEdgeFaces
    ++ addSym negFst (addSym negSnd $ addSym negThd rectCornFace)
  where
    rectEdgeFaces = addSym negThd $ addSym negFst rectEdgeFace
    rectEdgeFace = [[ (gr,1,0) , (gr,negate 1,0) , (1,0,gr) ]]
    rectCornFace = [[ (gr,1,0) , (0,gr,1) , (1,0,gr) ]]
    addSym f faces = map (map f) faces ++ faces
    negFst (x,y,z) = (negate x,y,z)
    negSnd (x,y,z) = (x,negate y,z)
    negThd (x,y,z) = (x,y,negate z)
    rotTrip (x,y,z) = (z,x,y)
    gr = (1 + sqrt 5) / 2 :: Float
    orderFace ps = undefined orderAround3 ps

-- | Assuming that this works, note that it relies heavily on the ordering of
-- faces adjacent to a vertex (clockwise around the vertex) 
-- and vertices on faces (anticlockwise around center of face).
truncate :: Ord a => VF a -> VF (a,a) 
truncate vf = VF
    { _vertices = M.fromList . concatMap f $ M.toList vmap
    }
  where
    vmap = _vertices vf
    f (i, (pos, faces)) = map (g i pos faces) faces
    g i pos faces (j:_) = 
        ((i,j) 
        ,   (0.5 *.*.* (pos +.+.+ fst (vmap M.! j))
            ,truncFaces i j faces
            )
        )
    g _ _ _ _ = undefined

truncFaces :: Eq a => a -> a -> [[a]] -> [[(a,a)]]
truncFaces v n vss = 
    [ reverse $ map ((v,) . head) (f1:fs) 
    , g (n:f0) ++ [(n,v)]
    , (n,v) : g (f1 ++ [v])
    ]
  where
    (f0:f1:fs) = rotateTo ((== n) . head) vss
    g (x:y:xs) = [(x,y),(y,x)] ++ g (y:xs)
    g _ = []

rotateTo :: (a -> Bool) -> [a] -> [a]
rotateTo p xs = ys ++ zs
  where
    (zs,ys) = break p xs

facesToVF :: Ord a => [[a]] -> M.Map a [[a]]
facesToVF faces = foldr f M.empty vs
  where
    vs = nub $ concat faces
    f v = M.insert v (g v)
    g v = map (tail . rotateTo (== v)) $ filter (elem v) faces