{- ORMOLU_DISABLE -}
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU AGPLV3+, see LICENSE

-- Allow us to use the tearser parallel list comprehension syntax, to avoid having to call zip in the complicated comprehensions below.
{-# LANGUAGE ParallelListComp #-}

-- export getContour and getMesh, which returns the edge of a 2D object, or the surface of a 3D object, respectively.
module Graphics.Implicit.Export.Render (getMesh, getContour) where

import Prelude(error, (-), ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>), (<$>), traverse)

import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, ℝ2, ℝ3, TriangleMesh, Obj2, SymbolicObj2, Obj3, SymbolicObj3, Polyline(getSegments), (⋯/), fromℕtoℝ, fromℕ, ℝ3' (ℝ3'))

import Graphics.Implicit.Export.Symbolic.Rebound2 (rebound2)

import Graphics.Implicit.Export.Symbolic.Rebound3 (rebound3)

import Graphics.Implicit.ObjectUtil (getBox2, getBox3)

import Data.Foldable(fold)
import Linear ( V3(V3), V2(V2) )

-- Here's the plan for rendering a cube (the 2D case is trivial):

-- (1) We calculate midpoints using interpolate.
--     This guarentees that our mesh will line up everywhere.
--     (Contrast with calculating them in getSegs)
import Graphics.Implicit.Export.Render.Interpolate (interpolate)

-- (2) We calculate the segments separating the inside and outside of our
--     object on the sides of the cube.
--     getSegs internally uses refine from RefineSegs to subdivide the segs
--     to better match the boundary.
import Graphics.Implicit.Export.Render.GetSegs (getSegs)

-- (3) We put the segments from all sides of the cube together
--     and extract closed loops.
import Graphics.Implicit.Export.Render.GetLoops (getLoops)

-- (4) We tesselate the loops, using a mixture of triangles and squares
import Graphics.Implicit.Export.Render.TesselateLoops (tesselateLoop)

-- (5) We try to merge squares, then turn everything into triangles.
import Graphics.Implicit.Export.Render.HandleSquares (mergedSquareTris)

-- Success: This is our mesh.

-- Each step on the Z axis is done in parallel using Control.Parallel.Strategies
import Control.Parallel.Strategies (using, rdeepseq, parBuffer)

-- The actual code is just a bunch of ugly argument passing.
-- Utility functions can be found at the end.

-- For efficiency, we need to avoid looking things up in other lists
-- (since they're 3D, it's an O(n³) operation...). So we need to make
-- our algorithms "flow" along the data structure instead of accessing
-- within it. To do this we use the ParallelListComp GHC extention.

-- We also compute lots of things in advance and pass them in as arguments,
-- to reduce redundant computations.

-- All in all, this is kind of ugly. But it is necessary.

-- Note: As far as the actual results of the rendering algorithm, nothing in
--       this file really matters. All the actual decisions about how to build
--       the mesh are abstracted into the imported files.

-- For the 2D case, we need one last thing, cleanLoopsFromSegs:
import Graphics.Implicit.Export.Render.HandlePolylines (cleanLoopsFromSegs)
import Data.Maybe (fromMaybe)
import Graphics.Implicit.Primitives (getImplicit)
import Control.Lens (_Wrapped, view, over, _Just)

-- Set the default types for the numbers in this file.
default (ℕ, Fastℕ, ℝ)

getMesh :: ℝ3 -> SymbolicObj3 -> TriangleMesh
getMesh :: ℝ3 -> SymbolicObj3 -> TriangleMesh
getMesh res :: ℝ3
res@(V3 ℝ
xres ℝ
yres ℝ
zres) SymbolicObj3
symObj =
    let
        -- Grow bounds a little to avoid sampling at exact bounds
        (Obj3
obj, (p1 :: ℝ3
p1@(V3 ℝ
x1 ℝ
y1 ℝ
z1), ℝ3
p2)) = (Obj3, Box3) -> (Obj3, Box3)
rebound3 (forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit SymbolicObj3
symObj, SymbolicObj3 -> Box3
getBox3 SymbolicObj3
symObj)

        -- How much space are we rendering?
        d :: ℝ3
d = ℝ3
p2 forall a. Num a => a -> a -> a
- ℝ3
p1

        -- How many steps will we take on each axis?
        nx, ny, nz :: ℕ
        steps :: V3 ℕ
steps@(V3 ℕ
nx ℕ
ny ℕ
nz) = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ℝ3
d forall a. ComponentWiseMultable a => a -> a -> a
⋯/ ℝ3
res)

        -- How big are the steps?
        (V3 ℝ
rx ℝ
ry ℝ
rz) = ℝ3
d forall a. ComponentWiseMultable a => a -> a -> a
⋯/ (ℕ -> ℝ
fromℕtoℝ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 ℕ
steps)

        -- The planes we're rendering along.
        pYZ :: [ℝ]
pYZ = [ ℝ
x1 forall a. Num a => a -> a -> a
+ ℝ
rxforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
n | ℕ
n <- [ℕ
0.. ℕ
nx] ]
        pXZ :: [ℝ]
pXZ = [ ℝ
y1 forall a. Num a => a -> a -> a
+ ℝ
ryforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
n | ℕ
n <- [ℕ
0.. ℕ
ny] ]
        pXY :: [ℝ]
pXY = [ ℝ
z1 forall a. Num a => a -> a -> a
+ ℝ
rzforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
n | ℕ
n <- [ℕ
0.. ℕ
nz] ]

        -- performance tuning.
        -- FIXME: magic number.
        forcesteps :: Int
        forcesteps :: Int
forcesteps = Int
32

        -- Evaluate obj to avoid waste in mids, segs, later.
        objV :: [[[ℝ]]]
objV = ℕ -> ℕ -> ℕ -> [[[ℝ]]]
par3DList ℕ
nx ℕ
ny ℕ
nz

        -- Sample our object(s) at every point in the 3D space given.
        par3DList :: ℕ -> ℕ -> ℕ -> [[[ℝ]]]
        par3DList :: ℕ -> ℕ -> ℕ -> [[[ℝ]]]
par3DList ℕ
lenx ℕ
leny ℕ
lenz =
            [[[ ℕ -> ℕ -> ℕ -> ℝ
sample ℕ
mx ℕ
my ℕ
mz
            | ℕ
mx <- [ℕ
0..ℕ
lenx] ] | ℕ
my <- [ℕ
0..ℕ
leny] ] | ℕ
mz <- [ℕ
0..ℕ
lenz] ]
              forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ (ℕ
lenxforall a. Num a => a -> a -> a
+ℕ
lenyforall a. Num a => a -> a -> a
+ℕ
lenz)) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- sample our object(s) at the given point.
        sample :: ℕ -> ℕ -> ℕ -> ℝ
        sample :: ℕ -> ℕ -> ℕ -> ℝ
sample ℕ
mx ℕ
my ℕ
mz = Obj3
obj forall a b. (a -> b) -> a -> b
$
              forall a. a -> a -> a -> V3 a
V3
                (ℝ
x1 forall a. Num a => a -> a -> a
+ ℝ
rxforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
mx)
                (ℝ
y1 forall a. Num a => a -> a -> a
+ ℝ
ryforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
my)
                (ℝ
z1 forall a. Num a => a -> a -> a
+ ℝ
rzforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
mz)

        -- (1) Calculate mid points on X, Y, and Z axis in 3D space.
        midsZ :: [[[ℝ]]]
midsZ = [[[
                 ℝ2 -> ℝ2 -> (ℝ -> ℝ) -> ℝ -> ℝ
interpolate (forall a. a -> a -> V2 a
V2 ℝ
z0 ℝ
objX0Y0Z0) (forall a. a -> a -> V2 a
V2 ℝ
z1' ℝ
objX0Y0Z1) (Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appABC Obj3
obj ℝ
x0 ℝ
y0) ℝ
zres
                 | ℝ
x0 <- [ℝ]
pYZ |                   ℝ
objX0Y0Z0 <- [ℝ]
objY0Z0 | ℝ
objX0Y0Z1 <- [ℝ]
objY0Z1
                ]| ℝ
y0 <- [ℝ]
pXZ |                   [ℝ]
objY0Z0   <- [[ℝ]]
objZ0   | [ℝ]
objY0Z1   <- [[ℝ]]
objZ1
                ]| ℝ
z0 <- [ℝ]
pXY | ℝ
z1' <- forall a. [a] -> [a]
tail [ℝ]
pXY | [[ℝ]]
objZ0     <- [[[ℝ]]]
objV    | [[ℝ]]
objZ1     <- forall a. [a] -> [a]
tail [[[ℝ]]]
objV
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
nz) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        midsY :: [[[ℝ]]]
midsY = [[[
                 ℝ2 -> ℝ2 -> (ℝ -> ℝ) -> ℝ -> ℝ
interpolate (forall a. a -> a -> V2 a
V2 ℝ
y0 ℝ
objX0Y0Z0) (forall a. a -> a -> V2 a
V2 ℝ
y1' ℝ
objX0Y1Z0) (Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appACB Obj3
obj ℝ
x0 ℝ
z0) ℝ
yres
                 | ℝ
x0 <- [ℝ]
pYZ |                   ℝ
objX0Y0Z0 <- [ℝ]
objY0Z0 | ℝ
objX0Y1Z0 <- [ℝ]
objY1Z0
                ]| ℝ
y0 <- [ℝ]
pXZ | ℝ
y1' <- forall a. [a] -> [a]
tail [ℝ]
pXZ | [ℝ]
objY0Z0   <- [[ℝ]]
objZ0   | [ℝ]
objY1Z0   <- forall a. [a] -> [a]
tail [[ℝ]]
objZ0
                ]| ℝ
z0 <- [ℝ]
pXY |                   [[ℝ]]
objZ0     <- [[[ℝ]]]
objV
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
ny) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        midsX :: [[[ℝ]]]
midsX = [[[
                 ℝ2 -> ℝ2 -> (ℝ -> ℝ) -> ℝ -> ℝ
interpolate (forall a. a -> a -> V2 a
V2 ℝ
x0 ℝ
objX0Y0Z0) (forall a. a -> a -> V2 a
V2 ℝ
x1' ℝ
objX1Y0Z0) (Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appBCA Obj3
obj ℝ
y0 ℝ
z0) ℝ
xres
                 | ℝ
x0 <- [ℝ]
pYZ | ℝ
x1' <- forall a. [a] -> [a]
tail [ℝ]
pYZ | ℝ
objX0Y0Z0 <- [ℝ]
objY0Z0 | ℝ
objX1Y0Z0 <- forall a. [a] -> [a]
tail [ℝ]
objY0Z0
                ]| ℝ
y0 <- [ℝ]
pXZ |                   [ℝ]
objY0Z0   <- [[ℝ]]
objZ0
                ]| ℝ
z0 <- [ℝ]
pXY |                   [[ℝ]]
objZ0     <- [[[ℝ]]]
objV
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
nx) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- (2) Calculate segments for each side
        segsZ :: [[[[[ℝ3]]]]]
segsZ = [[[
            ℝ -> Polyline -> [ℝ3]
injZ ℝ
z0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ℝ2 -> ℝ2 -> Obj2 -> (ℝ, ℝ, ℝ, ℝ) -> (ℝ, ℝ, ℝ, ℝ) -> [Polyline]
getSegs (forall a. a -> a -> V2 a
V2 ℝ
x0 ℝ
y0) (forall a. a -> a -> V2 a
V2 ℝ
x1' ℝ
y1') (Obj3
obj Obj3 -> ℝ -> Obj2
**$ ℝ
z0) (ℝ
objX0Y0Z0, ℝ
objX1Y0Z0, ℝ
objX0Y1Z0, ℝ
objX1Y1Z0) (ℝ
midA0, ℝ
midA1, ℝ
midB0, ℝ
midB1)
             | ℝ
x0<-[ℝ]
pYZ | ℝ
x1'<-forall a. [a] -> [a]
tail [ℝ]
pYZ |ℝ
midB0<-[ℝ]
mX''  | ℝ
midB1<-[ℝ]
mX'T     | ℝ
midA0<-[ℝ]
mY''  | ℝ
midA1<-forall a. [a] -> [a]
tail [ℝ]
mY''  | ℝ
objX0Y0Z0<-[ℝ]
objY0Z0 | ℝ
objX1Y0Z0<- forall a. [a] -> [a]
tail [ℝ]
objY0Z0 | ℝ
objX0Y1Z0<-[ℝ]
objY1Z0    | ℝ
objX1Y1Z0<-forall a. [a] -> [a]
tail [ℝ]
objY1Z0
            ]| ℝ
y0<-[ℝ]
pXZ | ℝ
y1'<-forall a. [a] -> [a]
tail [ℝ]
pXZ |[ℝ]
mX'' <-[[ℝ]]
mX'   | [ℝ]
mX'T <-forall a. [a] -> [a]
tail [[ℝ]]
mX' | [ℝ]
mY'' <-[[ℝ]]
mY'                       | [ℝ]
objY0Z0  <-[[ℝ]]
objZ0                              | [ℝ]
objY1Z0  <-forall a. [a] -> [a]
tail [[ℝ]]
objZ0
            ]| ℝ
z0<-[ℝ]
pXY                 |[[ℝ]]
mX'  <-[[[ℝ]]]
midsX |                   [[ℝ]]
mY'  <-[[[ℝ]]]
midsY                     | [[ℝ]]
objZ0    <-[[[ℝ]]]
objV
            ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
nz) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        segsY :: [[[[[ℝ3]]]]]
segsY = [[[
            ℝ -> Polyline -> [ℝ3]
injY ℝ
y0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ℝ2 -> ℝ2 -> Obj2 -> (ℝ, ℝ, ℝ, ℝ) -> (ℝ, ℝ, ℝ, ℝ) -> [Polyline]
getSegs (forall a. a -> a -> V2 a
V2 ℝ
x0 ℝ
z0) (forall a. a -> a -> V2 a
V2 ℝ
x1' ℝ
z1') (Obj3
obj Obj3 -> ℝ -> Obj2
*$* ℝ
y0) (ℝ
objX0Y0Z0, ℝ
objX1Y0Z0, ℝ
objX0Y0Z1, ℝ
objX1Y0Z1) (ℝ
midA0, ℝ
midA1, ℝ
midB0, ℝ
midB1)
             | ℝ
x0<-[ℝ]
pYZ | ℝ
x1'<-forall a. [a] -> [a]
tail [ℝ]
pYZ | ℝ
midB0<-[ℝ]
mB''  | ℝ
midB1<-[ℝ]
mBT'       | ℝ
midA0<-[ℝ]
mA''  | ℝ
midA1<-forall a. [a] -> [a]
tail [ℝ]
mA'' | ℝ
objX0Y0Z0<-[ℝ]
objY0Z0 | ℝ
objX1Y0Z0<-forall a. [a] -> [a]
tail [ℝ]
objY0Z0 | ℝ
objX0Y0Z1<-[ℝ]
objY0Z1 | ℝ
objX1Y0Z1<-forall a. [a] -> [a]
tail [ℝ]
objY0Z1
            ]| ℝ
y0<-[ℝ]
pXZ |                 [ℝ]
mB'' <-[[ℝ]]
mB'   | [ℝ]
mBT' <-[[ℝ]]
mBT        | [ℝ]
mA'' <-[[ℝ]]
mA'                      | [ℝ]
objY0Z0  <-[[ℝ]]
objZ0                             | [ℝ]
objY0Z1  <-[[ℝ]]
objZ1
            ]| ℝ
z0<-[ℝ]
pXY | ℝ
z1'<-forall a. [a] -> [a]
tail [ℝ]
pXY | [[ℝ]]
mB'  <-[[[ℝ]]]
midsX | [[ℝ]]
mBT  <-forall a. [a] -> [a]
tail [[[ℝ]]]
midsX | [[ℝ]]
mA'  <-[[[ℝ]]]
midsZ                    | [[ℝ]]
objZ0    <-[[[ℝ]]]
objV                              | [[ℝ]]
objZ1    <-forall a. [a] -> [a]
tail [[[ℝ]]]
objV
            ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
ny) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        segsX :: [[[[[ℝ3]]]]]
segsX = [[[
            ℝ -> Polyline -> [ℝ3]
injX ℝ
x0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ℝ2 -> ℝ2 -> Obj2 -> (ℝ, ℝ, ℝ, ℝ) -> (ℝ, ℝ, ℝ, ℝ) -> [Polyline]
getSegs (forall a. a -> a -> V2 a
V2 ℝ
y0 ℝ
z0) (forall a. a -> a -> V2 a
V2 ℝ
y1' ℝ
z1') (Obj3
obj Obj3 -> ℝ -> Obj2
$** ℝ
x0) (ℝ
objX0Y0Z0, ℝ
objX0Y1Z0, ℝ
objX0Y0Z1, ℝ
objX0Y1Z1) (ℝ
midA0, ℝ
midA1, ℝ
midB0, ℝ
midB1)
             | ℝ
x0<-[ℝ]
pYZ |                 ℝ
midB0<-[ℝ]
mB''  | ℝ
midB1<-[ℝ]
mBT'       | ℝ
midA0<-[ℝ]
mA''  | ℝ
midA1<-[ℝ]
mA'T     | ℝ
objX0Y0Z0<-[ℝ]
objY0Z0 | ℝ
objX0Y1Z0<-[ℝ]
objY1Z0    | ℝ
objX0Y0Z1<-[ℝ]
objY0Z1    | ℝ
objX0Y1Z1<-     [ℝ]
objY1Z1
            ]| ℝ
y0<-[ℝ]
pXZ | ℝ
y1'<-forall a. [a] -> [a]
tail [ℝ]
pXZ | [ℝ]
mB'' <-[[ℝ]]
mB'   | [ℝ]
mBT' <-[[ℝ]]
mBT        | [ℝ]
mA'' <-[[ℝ]]
mA'   | [ℝ]
mA'T <-forall a. [a] -> [a]
tail [[ℝ]]
mA' | [ℝ]
objY0Z0  <-[[ℝ]]
objZ0   | [ℝ]
objY1Z0  <-forall a. [a] -> [a]
tail [[ℝ]]
objZ0 | [ℝ]
objY0Z1  <-[[ℝ]]
objZ1      | [ℝ]
objY1Z1  <-forall a. [a] -> [a]
tail [[ℝ]]
objZ1
            ]| ℝ
z0<-[ℝ]
pXY | ℝ
z1'<-forall a. [a] -> [a]
tail [ℝ]
pXY | [[ℝ]]
mB'  <-[[[ℝ]]]
midsY | [[ℝ]]
mBT  <-forall a. [a] -> [a]
tail [[[ℝ]]]
midsY | [[ℝ]]
mA'  <-[[[ℝ]]]
midsZ                   | [[ℝ]]
objZ0    <- [[[ℝ]]]
objV                           | [[ℝ]]
objZ1    <- forall a. [a] -> [a]
tail [[[ℝ]]]
objV
            ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
nx) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- (3) & (4) : get and tesselate loops
        -- FIXME: hack.
        minres :: ℝ
minres = ℝ
xres forall a. Ord a => a -> a -> a
`min` ℝ
yres forall a. Ord a => a -> a -> a
`min` ℝ
zres
        sqTris :: [[[[TriSquare]]]]
sqTris = [[[
            forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ℝ -> Obj3 -> [[ℝ3]] -> [TriSquare]
tesselateLoop ℝ
minres Obj3
obj) forall a b. (a -> b) -> a -> b
$
              forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"unclosed loop in paths given") forall a b. (a -> b) -> a -> b
$
              -- Shove the ℝ3s into ℝ3's to get the NaN checks, then
              -- unwrap everything. This should mostly compile away
              -- given that it is lensy and passing a newtype instance
              -- around. `getLoops` is the function actually doing the
              -- work we care about
              forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [[a]] -> Maybe [[[a]]]
getLoops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) ℝ3 -> ℝ3'
ℝ3' forall a b. (a -> b) -> a -> b
$
                        [[ℝ3]]
segX''' forall a. Semigroup a => a -> a -> a
<>
                   [[ℝ3]] -> [[ℝ3]]
mapR [[ℝ3]]
segX''T forall a. Semigroup a => a -> a -> a
<>
                   [[ℝ3]] -> [[ℝ3]]
mapR [[ℝ3]]
segY''' forall a. Semigroup a => a -> a -> a
<>
                        [[ℝ3]]
segY'T' forall a. Semigroup a => a -> a -> a
<>
                        [[ℝ3]]
segZ''' forall a. Semigroup a => a -> a -> a
<>
                   [[ℝ3]] -> [[ℝ3]]
mapR [[ℝ3]]
segZT''
             | [[ℝ3]]
segZ'''<- [[[ℝ3]]]
segZ''| [[ℝ3]]
segZT''<- [[[ℝ3]]]
segZT'
             | [[ℝ3]]
segY'''<- [[[ℝ3]]]
segY''| [[ℝ3]]
segY'T'<- [[[ℝ3]]]
segY'T
             | [[ℝ3]]
segX'''<- [[[ℝ3]]]
segX''| [[ℝ3]]
segX''T<- forall a. [a] -> [a]
tail [[[ℝ3]]]
segX''

            ]| [[[ℝ3]]]
segZ'' <- [[[[ℝ3]]]]
segZ' | [[[ℝ3]]]
segZT' <- [[[[ℝ3]]]]
segZT
             | [[[ℝ3]]]
segY'' <- [[[[ℝ3]]]]
segY' | [[[ℝ3]]]
segY'T <- forall a. [a] -> [a]
tail [[[[ℝ3]]]]
segY'
             | [[[ℝ3]]]
segX'' <- [[[[ℝ3]]]]
segX'

            ]| [[[[ℝ3]]]]
segZ'  <- [[[[[ℝ3]]]]]
segsZ | [[[[ℝ3]]]]
segZT  <- forall a. [a] -> [a]
tail [[[[[ℝ3]]]]]
segsZ
             | [[[[ℝ3]]]]
segY'  <- [[[[[ℝ3]]]]]
segsY
             | [[[[ℝ3]]]]
segX'  <- [[[[[ℝ3]]]]]
segsX
            ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ forall a b. (a -> b) -> a -> b
$ ℕ
nxforall a. Num a => a -> a -> a
+ℕ
nyforall a. Num a => a -> a -> a
+ℕ
nz) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

    in
      -- (5) merge squares, etc
      [TriSquare] -> TriangleMesh
mergedSquareTris forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[[[TriSquare]]]]
sqTris

-- | getContour gets a polyline describing the edge of a 2D object.
getContour :: ℝ2 -> SymbolicObj2 -> [Polyline]
getContour :: ℝ2 -> SymbolicObj2 -> [Polyline]
getContour res :: ℝ2
res@(V2 ℝ
xres ℝ
yres) SymbolicObj2
symObj =
    let
        -- Grow bounds a little to avoid sampling at exact bounds
        (Obj2
obj, (p1 :: ℝ2
p1@(V2 ℝ
x1 ℝ
y1), ℝ2
p2)) = (Obj2, Box2) -> (Obj2, Box2)
rebound2 (forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit SymbolicObj2
symObj, SymbolicObj2 -> Box2
getBox2 SymbolicObj2
symObj)

        -- The size of the region we're being asked to search.
        d :: ℝ2
d = ℝ2
p2 forall a. Num a => a -> a -> a
- ℝ2
p1

        -- How many steps will we take on each axis?
        nx, ny :: ℕ
        steps :: V2 ℕ
steps@(V2 ℕ
nx ℕ
ny) = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ℝ2
d forall a. ComponentWiseMultable a => a -> a -> a
⋯/ ℝ2
res)

        -- How big are the steps?
        (V2 ℝ
rx ℝ
ry) = ℝ2
d forall a. ComponentWiseMultable a => a -> a -> a
⋯/ (ℕ -> ℝ
fromℕtoℝ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 ℕ
steps)

        -- The lines we are rendering along.
        pX :: [ℝ]
pX = [ ℝ
x1 forall a. Num a => a -> a -> a
+ ℝ
rxforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
p | ℕ
p <- [ℕ
0.. ℕ
nx] ]
        pY :: [ℝ]
pY = [ ℝ
y1 forall a. Num a => a -> a -> a
+ ℝ
ryforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
p | ℕ
p <- [ℕ
0.. ℕ
ny] ]

        -- Performance tuning.
        -- FIXME: magic number.
        forcesteps :: Int
        forcesteps :: Int
forcesteps = Int
32

        -- Evaluate obj to avoid waste in mids, segs, later.
        objV :: [[ℝ]]
objV = ℕ -> ℕ -> [[ℝ]]
par2DList ℕ
nx ℕ
ny

        -- Sample our object(s) at every point in the 2D plane given.
        par2DList :: ℕ -> ℕ -> [[ℝ]]
        par2DList :: ℕ -> ℕ -> [[ℝ]]
par2DList ℕ
lenx ℕ
leny =
            [[ ℕ -> ℕ -> ℝ
sample ℕ
mx ℕ
my
                  | ℕ
mx <- [ℕ
0..ℕ
lenx]
                ] | ℕ
my <- [ℕ
0..ℕ
leny]
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ forall a b. (a -> b) -> a -> b
$ ℕ
lenxforall a. Num a => a -> a -> a
+ℕ
leny) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- sample our object(s) at the given point.
        sample :: ℕ -> ℕ -> ℝ
        sample :: ℕ -> ℕ -> ℝ
sample ℕ
mx ℕ
my = Obj2
obj forall a b. (a -> b) -> a -> b
$
          forall a. a -> a -> V2 a
V2
                (ℝ
x1 forall a. Num a => a -> a -> a
+ ℝ
rxforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
mx)
                (ℝ
y1 forall a. Num a => a -> a -> a
+ ℝ
ryforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
my)

        -- Calculate mid points on X axis in 2D space.
        midsX :: [[ℝ]]
midsX = [[
                 ℝ2 -> ℝ2 -> (ℝ -> ℝ) -> ℝ -> ℝ
interpolate (forall a. a -> a -> V2 a
V2 ℝ
x0 ℝ
objX0Y0) (forall a. a -> a -> V2 a
V2 ℝ
x1' ℝ
objX1Y0) (Obj2
obj Obj2 -> ℝ -> ℝ -> ℝ
*$ ℝ
y0) ℝ
xres
                 | ℝ
x0 <- [ℝ]
pX | ℝ
x1' <- forall a. [a] -> [a]
tail [ℝ]
pX | ℝ
objX0Y0 <- [ℝ]
objY0 | ℝ
objX1Y0 <- forall a. [a] -> [a]
tail [ℝ]
objY0
                ]| ℝ
y0 <- [ℝ]
pY |                   [ℝ]
objY0   <- [[ℝ]]
objV
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
nx) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- Calculate mid points on Y axis in 2D space.
        midsY :: [[ℝ]]
midsY = [[
                 ℝ2 -> ℝ2 -> (ℝ -> ℝ) -> ℝ -> ℝ
interpolate (forall a. a -> a -> V2 a
V2 ℝ
y0 ℝ
objX0Y0) (forall a. a -> a -> V2 a
V2 ℝ
y1' ℝ
objX0Y1) (Obj2
obj Obj2 -> ℝ -> ℝ -> ℝ
$* ℝ
x0) ℝ
yres
                 | ℝ
x0 <- [ℝ]
pX |                  ℝ
objX0Y0 <- [ℝ]
objY0   | ℝ
objX0Y1 <- [ℝ]
objY1
                ]| ℝ
y0 <- [ℝ]
pY | ℝ
y1' <- forall a. [a] -> [a]
tail [ℝ]
pY | [ℝ]
objY0   <- [[ℝ]]
objV    | [ℝ]
objY1   <- forall a. [a] -> [a]
tail [[ℝ]]
objV
                ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ ℕ
ny) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq

        -- Calculate segments for each side
        segs :: [[[Polyline]]]
segs = [[
            ℝ2 -> ℝ2 -> Obj2 -> (ℝ, ℝ, ℝ, ℝ) -> (ℝ, ℝ, ℝ, ℝ) -> [Polyline]
getSegs (forall a. a -> a -> V2 a
V2 ℝ
x0 ℝ
y0) (forall a. a -> a -> V2 a
V2 ℝ
x1' ℝ
y1') Obj2
obj (ℝ
objX0Y0, ℝ
objX1Y0, ℝ
objX0Y1, ℝ
objX1Y1) (ℝ
midA0, ℝ
midA1, ℝ
midB0, ℝ
midB1)
             | ℝ
x0<-[ℝ]
pX | ℝ
x1'<-forall a. [a] -> [a]
tail [ℝ]
pX |ℝ
midB0<-[ℝ]
mX''  | ℝ
midB1<-[ℝ]
mX'T       | ℝ
midA0<-[ℝ]
mY''  | ℝ
midA1<-forall a. [a] -> [a]
tail [ℝ]
mY'' | ℝ
objX0Y0<-[ℝ]
objY0 | ℝ
objX1Y0<-forall a. [a] -> [a]
tail [ℝ]
objY0 | ℝ
objX0Y1<-[ℝ]
objY1 | ℝ
objX1Y1<-forall a. [a] -> [a]
tail [ℝ]
objY1
            ]| ℝ
y0<-[ℝ]
pY | ℝ
y1'<-forall a. [a] -> [a]
tail [ℝ]
pY |[ℝ]
mX'' <-[[ℝ]]
midsX | [ℝ]
mX'T <-forall a. [a] -> [a]
tail [[ℝ]]
midsX | [ℝ]
mY'' <-[[ℝ]]
midsY                    | [ℝ]
objY0 <- [[ℝ]]
objV                        | [ℝ]
objY1 <- forall a. [a] -> [a]
tail [[ℝ]]
objV
            ] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall n. N n => ℕ -> n
fromℕ forall a b. (a -> b) -> a -> b
$ ℕ
nxforall a. Num a => a -> a -> a
+ℕ
ny) Int
forcesteps) forall a. NFData a => Strategy a
rdeepseq
    in
      -- Merge squares
      [Polyline] -> [Polyline]
cleanLoopsFromSegs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[[Polyline]]]
segs

-- utility functions

injX :: ℝ -> Polyline -> [ℝ3]
injX :: ℝ -> Polyline -> [ℝ3]
injX ℝ
val Polyline
polyline = ℝ -> ℝ2 -> ℝ3
prepend ℝ
val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Polyline -> [ℝ2]
getSegments Polyline
polyline
  where
    prepend :: ℝ -> ℝ2 -> ℝ3
    prepend :: ℝ -> ℝ2 -> ℝ3
prepend ℝ
a (V2 ℝ
b ℝ
c) = forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c

injY :: ℝ -> Polyline -> [ℝ3]
injY :: ℝ -> Polyline -> [ℝ3]
injY ℝ
val Polyline
polyline = ℝ -> ℝ2 -> ℝ3
insert ℝ
val  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Polyline -> [ℝ2]
getSegments Polyline
polyline
  where
    insert :: ℝ -> ℝ2 -> ℝ3
    insert :: ℝ -> ℝ2 -> ℝ3
insert ℝ
b (V2 ℝ
a ℝ
c) = forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c

injZ :: ℝ -> Polyline -> [ℝ3]
injZ :: ℝ -> Polyline -> [ℝ3]
injZ ℝ
val Polyline
polyline = ℝ -> ℝ2 -> ℝ3
postfix ℝ
val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Polyline -> [ℝ2]
getSegments Polyline
polyline
  where
    postfix :: ℝ -> ℝ2 -> ℝ3
    postfix :: ℝ -> ℝ2 -> ℝ3
postfix ℝ
c (V2 ℝ
a ℝ
b) = forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c

($**) :: Obj3 -> ℝ -> ℝ2 -> ℝ
Obj3
f $** :: Obj3 -> ℝ -> Obj2
$** ℝ
a = \(V2 ℝ
b ℝ
c) -> Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)
infixr 0 $**

(*$*) :: Obj3 -> ℝ -> ℝ2 -> ℝ
Obj3
f *$* :: Obj3 -> ℝ -> Obj2
*$* ℝ
b = \(V2 ℝ
a ℝ
c) -> Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)
infixr 0 *$*

(**$) :: Obj3 -> ℝ -> ℝ2 -> ℝ
Obj3
f **$ :: Obj3 -> ℝ -> Obj2
**$ ℝ
c = \(V2 ℝ
a ℝ
b) -> Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)
infixr 0 **$

($*) :: Obj2 -> ℝ -> ℝ -> ℝ
Obj2
f $* :: Obj2 -> ℝ -> ℝ -> ℝ
$* ℝ
a = Obj2
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> V2 a
V2 ℝ
a
infixr 0 $*

(*$) :: Obj2 -> ℝ -> ℝ -> ℝ
Obj2
f *$ :: Obj2 -> ℝ -> ℝ -> ℝ
*$ ℝ
b = \ℝ
a -> Obj2
f (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b)
infixr 0 *$

appABC :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appABC :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appABC Obj3
f ℝ
a ℝ
b ℝ
c = Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)
appBCA :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appBCA :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appBCA Obj3
f ℝ
b ℝ
c ℝ
a = Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)
appACB :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appACB :: Obj3 -> ℝ -> ℝ -> ℝ -> ℝ
appACB Obj3
f ℝ
a ℝ
c ℝ
b = Obj3
f (forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)

mapR :: [[ℝ3]] -> [[ℝ3]]
mapR :: [[ℝ3]] -> [[ℝ3]]
mapR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse