-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE

module Graphics.Implicit.Export.Render.HandleSquares (mergedSquareTris) where

import Graphics.Implicit.Definitions
import Graphics.Implicit.Export.Render.Definitions
import GHC.Exts (groupWith)
import Data.List (sortBy)
import Data.VectorSpace       

-- We want small meshes. Essential to this, is getting rid of triangles.
-- We secifically mark quads in tesselation (refer to Graphics.Implicit.
-- Export.Render.Definitions, Graphics.Implicit.Export.Render.TesselateLoops)
-- So that we can try and merge them together.

{- Core idea of mergedSquareTris:

  Many Quads on Plane 
   ____________ 
  |    |    |  |
  |____|____|  |
  |____|____|__|

   | joinXaligned
   v 
   ____________ 
  |         |  |
  |_________|__|
  |_________|__|

   | joinYaligned
   v 
   ____________ 
  |         |  |
  |         |  |
  |_________|__|

   | joinXaligned (presently disabled)
   v 
   ____________ 
  |            |
  |            |
  |____________|

   | squareToTri
   v 
   ____________ 
  |\           |
  | ---------- |
  |___________\|

-}

mergedSquareTris sqTris = 
	let
		-- We don't need to do any work on triangles. They'll just be part of
		-- the list of triangles we give back. So, the triangles coming from
		-- triangles...
		triTriangles = concat $ map (\(Tris a) -> a) $ filter isTris sqTris	
		-- We actually want to work on the quads, so we find those
		squares = filter (not . isTris) sqTris
		-- Collect ones that are on the same plane.
		planeAligned = groupWith (\(Sq basis z _ _) -> (basis,z)) squares
		-- For each plane:
		-- Select for being the same range on X and then merge them on Y
		-- Then vice versa.
		joined = map 
			( -- concat . (map joinXaligned) . groupWith (\(Sq _ _ xS _) -> xS)
			  concat . (map joinYaligned) . groupWith (\(Sq _ _ _ yS) -> yS)
			. concat . (map joinXaligned) . groupWith (\(Sq _ _ xS _) -> xS)) 
			planeAligned
		-- Merge them back together, and we have the desired reult!
		finishedSquares = concat joined
	in
		-- merge them to triangles, and combine with the original triagneles.
		triTriangles ++ concat (map squareToTri finishedSquares)


-- And now for a bunch of helper functions that do the heavy lifting...

isTris (Tris _) = True
isTris _ = False


joinXaligned quads@((Sq b z xS _):_) =
	let
		orderedQuads = sortBy 
			(\(Sq _ _ _ (ya,_)) (Sq _ _ _ (yb,_)) -> compare ya yb)
			quads
		mergeAdjacent (pres@(Sq _ _ _ (y1a,y2a)) : next@(Sq _ _ _ (y1b,y2b)) : others) =
			if y2a == y1b
			then mergeAdjacent ((Sq b z xS (y1a,y2b)): others)
			else if y1a == y2b
			then mergeAdjacent ((Sq b z xS (y1b,y2a)): others)
			else pres : mergeAdjacent (next : others)
		mergeAdjacent a = a
	in
		mergeAdjacent orderedQuads
joinXaligned [] = []

joinYaligned quads@((Sq b z _ yS):_) =
	let
		orderedQuads = sortBy 
			(\(Sq _ _ (xa,_) _) (Sq _ _ (xb,_) _) -> compare xa xb)
			quads
		mergeAdjacent (pres@(Sq _ _ (x1a,x2a) _) : next@(Sq _ _ (x1b,x2b) _) : others) =
			if x2a == x1b
			then mergeAdjacent ((Sq b z (x1a,x2b) yS): others)
			else if x1a == x2b
			then mergeAdjacent ((Sq b z (x1b,x2a) yS): others)
			else pres : mergeAdjacent (next : others)
		mergeAdjacent a = a
	in
		mergeAdjacent orderedQuads
joinYaligned [] = []


-- Reconstruct a triangle
squareToTri (Sq (b1,b2,b3) z (x1,x2) (y1,y2)) =
	let
		zV = b3 ^* z
		(x1V, x2V) = (x1 *^ b1, x2 *^ b1)
		(y1V, y2V) = (y1 *^ b2, y2 *^ b2)
		a = zV ^+^ x1V ^+^ y1V
		b = zV ^+^ x2V ^+^ y1V
		c = zV ^+^ x1V ^+^ y2V
		d = zV ^+^ x2V ^+^ y2V
	in
		[(a,b,c),(c,b,d)]