Allow tweaking z buffer when rendering polygon, improve explosion render

src/Polyhedra/Geodesic.hs

@@ -0,0 +1,79 @@
+{-# 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
+    [ [(0,one,gr),(one, gr, 0),(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
+
+--triPyramid :: VF
+--triPyramid = VF
+
+--dual :: VF a -> VF [a]
+--dual vf =