module Graphics.Implicit.Export.Render.RefineSegs where
import Data.VectorSpace
import Graphics.Implicit.Definitions
import Graphics.Implicit.Export.Util (centroid)
refine :: ℝ -> Obj2 -> [ℝ2] -> [ℝ2]
refine res obj = simplify res . detail' res obj
detail' res obj [p1@(x1,y1), p2@(x2,y2)] | (x2x1)^2 + (y2y1)^2 > res^2/200 =
detail 0 res obj [p1,p2]
detail' _ _ a = a
detail :: Int -> ℝ -> (ℝ2 -> ℝ) -> [ℝ2] -> [ℝ2]
detail n res obj [p1, p2] | n < 2 =
let
mid = centroid [p1,p2]
midval = obj mid
in if abs midval < res / 40
then [p1, p2]
else let
normal = (\(a,b) -> (b, a)) $ normalized (p2 ^-^ p1)
derivN = (obj (mid ^-^ (normal ^* (midval/2))) midval) * (2/midval)
in if abs derivN > 0.5 && abs derivN < 2 && abs (midval/derivN) < 3*res
then let
mid' = mid ^-^ (normal ^* (midval / derivN))
in detail (n+1) res obj [p1, mid']
++ tail (detail (n+1) res obj [mid', p2] )
else let
derivX = (obj (mid ^+^ (res/100, 0)) midval)*100/res
derivY = (obj (mid ^+^ (0, res/100)) midval)*100/res
derivNormSq = derivX^2 + derivY^2
in if abs derivNormSq > 0.09 && abs derivNormSq < 4 && abs (midval/sqrt derivNormSq) < 3*res
then let
(dX, dY) = ( derivX*midval/derivNormSq, derivY*midval/derivNormSq)
mid' = mid ^+^ (dX, dY)
midval' = obj mid'
posRatio = midval/(midval midval')
mid'' = mid ^+^ (dX*posRatio, dY*posRatio)
in
detail (n+1) res obj [p1, mid''] ++ tail (detail (n+1) res obj [mid'', p2] )
else [p1, p2]
detail _ _ _ x = x
simplify res = simplify1
simplify1 :: [ℝ2] -> [ℝ2]
simplify1 (a:b:c:xs) =
if abs ( ((b ^-^ a) ⋅ (c ^-^ a)) magnitude (b ^-^ a) * magnitude (c ^-^ a) ) < 0.0001
then simplify1 (a:c:xs)
else a : simplify1 (b:c:xs)
simplify1 a = a