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

module Graphics.Implicit.ObjectUtil.GetBox3 (getBox3) where

import Prelude(uncurry, pure, Bool(False), Either (Left, Right), (==), max, (/), (-), (+), fmap, unzip, ($), (<$>), (.), minimum, maximum, min, (>), (*), (<), abs, either, const, otherwise, take, fst, snd)

import Graphics.Implicit.Definitions
    ( Fastℕ,
      fromFastℕ,
      ExtrudeMScale(C2, C1),
      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude),
      Box3,
      ℝ,
      fromFastℕtoℝ,
      toScaleFn )

import Graphics.Implicit.ObjectUtil.GetBox2 (getBox2, getBox2R)

import Graphics.Implicit.ObjectUtil.GetBoxShared (corners, pointsBox, getBoxShared)

import Linear (V2(V2), V3(V3))
import qualified Linear

-- FIXME: many variables are being ignored here. no rounding for intersect, or difference.. etc.

-- Get a Box3 around the given object.
getBox3 :: SymbolicObj3 -> Box3
-- Primitives
getBox3 :: SymbolicObj3 -> Box3
getBox3 (Shared3 SharedObj SymbolicObj3 V3 ℝ
obj) = SharedObj SymbolicObj3 V3 ℝ -> Box3
forall obj (f :: * -> *) a.
(Object obj f a, VectorStuff (f a), ComponentWiseMultable (f a),
 Fractional a, Metric f) =>
SharedObj obj f a -> (f a, f a)
getBoxShared SharedObj SymbolicObj3 V3 ℝ
obj
getBox3 (Cube ℝ3
size) = (ℝ -> ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
0, ℝ3
size)
getBox3 (Sphere ℝ
r) = (ℝ -> ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-ℝ
r), ℝ -> ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
r)
getBox3 (Cylinder ℝ
h ℝ
r1 ℝ
r2) = (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (-ℝ
r) (-ℝ
r) ℝ
0, ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
r ℝ
r ℝ
h ) where r :: ℝ
r = ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max ℝ
r1 ℝ
r2
-- (Rounded) CSG
-- Simple transforms
getBox3 (Rotate3 Quaternion ℝ
q SymbolicObj3
symbObj) =
    let box :: Box3
box = SymbolicObj3 -> Box3
getBox3 SymbolicObj3
symbObj
     in [ℝ3] -> Box3
forall (f :: * -> *) a.
(Applicative f, Num a, VectorStuff (f a)) =>
[f a] -> (f a, f a)
pointsBox ([ℝ3] -> Box3) -> [ℝ3] -> Box3
forall a b. (a -> b) -> a -> b
$ Quaternion ℝ -> ℝ3 -> ℝ3
forall a.
(Conjugate a, RealFloat a) =>
Quaternion a -> V3 a -> V3 a
Linear.rotate Quaternion ℝ
q (ℝ3 -> ℝ3) -> [ℝ3] -> [ℝ3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Box3 -> [ℝ3]
forall vec. VectorStuff vec => (vec, vec) -> [vec]
corners Box3
box
getBox3 (Transform3 M44 ℝ
m SymbolicObj3
symbObj) =
    let box :: Box3
box = SymbolicObj3 -> Box3
getBox3 SymbolicObj3
symbObj
     in [ℝ3] -> Box3
forall (f :: * -> *) a.
(Applicative f, Num a, VectorStuff (f a)) =>
[f a] -> (f a, f a)
pointsBox ([ℝ3] -> Box3) -> [ℝ3] -> Box3
forall a b. (a -> b) -> a -> b
$ V4 ℝ -> ℝ3
forall a. Fractional a => V4 a -> V3 a
Linear.normalizePoint (V4 ℝ -> ℝ3) -> (ℝ3 -> V4 ℝ) -> ℝ3 -> ℝ3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M44 ℝ
m M44 ℝ -> V4 ℝ -> V4 ℝ
forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
Linear.!*) (V4 ℝ -> V4 ℝ) -> (ℝ3 -> V4 ℝ) -> ℝ3 -> V4 ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ3 -> V4 ℝ
forall a. Num a => V3 a -> V4 a
Linear.point (ℝ3 -> ℝ3) -> [ℝ3] -> [ℝ3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Box3 -> [ℝ3]
forall vec. VectorStuff vec => (vec, vec) -> [vec]
corners Box3
box
-- Misc
-- 2D Based
getBox3 (Extrude SymbolicObj2
symbObj ℝ
h) = (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x1 ℝ
y1 ℝ
0, ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x2 ℝ
y2 ℝ
h)
    where
        (V2 ℝ
x1 ℝ
y1, V2 ℝ
x2 ℝ
y2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj
getBox3 (ExtrudeOnEdgeOf SymbolicObj2
symbObj1 SymbolicObj2
symbObj2) =
    let
        (V2 ℝ
ax1 ℝ
ay1, V2 ℝ
ax2 ℝ
ay2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj1
        (V2 ℝ
bx1 ℝ
by1, V2 ℝ
bx2 ℝ
by2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj2
    in
        (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ
bx1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
ax1) (ℝ
by1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
ax1) ℝ
ay1, ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ
bx2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
ax2) (ℝ
by2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
ax2) ℝ
ay2)
-- FIXME: magic numbers: 0.2 and 11.
-- FIXME: this may use an approximation, based on sampling functions. generate a warning if the approximation part of this function is used.
-- FIXME: re-implement the expression system, so this can recieve a function, and determine class (constant, linear)... and implement better forms of this function.
getBox3 (ExtrudeM Either ℝ (ℝ -> ℝ)
twist ExtrudeMScale
scale Either (V2 ℝ) (ℝ -> V2 ℝ)
translate SymbolicObj2
symbObj Either ℝ (V2 ℝ -> ℝ)
height) =
    let
        (V2 ℝ
x1 ℝ
y1, V2 ℝ
x2 ℝ
y2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj
        (ℝ
dx, ℝ
dy) = (ℝ
x2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
x1, ℝ
y2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
y1)

        samples :: Fastℕ
        samples :: Fastℕ
samples = Fastℕ
11
        range :: [Fastℕ]
        range :: [Fastℕ]
range = [Fastℕ
0, Fastℕ
1 .. (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)]
        ([ℝ]
xrange, [ℝ]
yrange) = ( (Fastℕ -> ℝ) -> [Fastℕ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\ℝ
s -> ℝ
x1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
sℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
dxℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/Fastℕ -> ℝ
fromFastℕtoℝ (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)) (ℝ -> ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fastℕ -> ℝ
fromFastℕtoℝ) [Fastℕ]
range, (Fastℕ -> ℝ) -> [Fastℕ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\ℝ
s -> ℝ
y1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
sℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
dyℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/Fastℕ -> ℝ
fromFastℕtoℝ (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)) (ℝ -> ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fastℕ -> ℝ
fromFastℕtoℝ) [Fastℕ]
range)

        hfuzz :: ℝ
        hfuzz :: ℝ
hfuzz = ℝ
0.2
        h :: ℝ
h = case Either ℝ (V2 ℝ -> ℝ)
height of
              Left ℝ
hval -> ℝ
hval
              Right V2 ℝ -> ℝ
hfun -> ℝ
hmax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
hfuzzℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
hmaxℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
hmin)
                where
                    hs :: [ℝ]
hs = [V2 ℝ -> ℝ
hfun (V2 ℝ -> ℝ) -> V2 ℝ -> ℝ
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y | ℝ
x <- [ℝ]
xrange, ℝ
y <- [ℝ]
yrange]
                    (ℝ
hmin, ℝ
hmax) = ([ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ℝ]
hs, [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ℝ]
hs)
        hrange :: [ℝ]
hrange = (Fastℕ -> ℝ) -> [Fastℕ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ Fastℕ -> ℝ
fromFastℕtoℝ (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)) (ℝ -> ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ℝ
hℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*) (ℝ -> ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fastℕ -> ℝ
fromFastℕtoℝ) [Fastℕ]
range

        (ℝ
twistXmin, ℝ
twistYmin, ℝ
twistXmax, ℝ
twistYmax) =
          let
            both :: (t -> b) -> (t, t) -> (b, b)
both t -> b
f (t
a, t
b) = (t -> b
f t
a, t -> b
f t
b)
            (V2 ℝ
scalex' ℝ
scaley') = case ExtrudeMScale
scale of
              C1 ℝ
s -> ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
s ℝ
s
              C2 V2 ℝ
s -> V2 ℝ
s
              ExtrudeMScale
s -> (ℝ, ℝ) -> V2 ℝ
forall a. (a, a) -> V2 a
pack ((ℝ, ℝ) -> V2 ℝ) -> (ℝ, ℝ) -> V2 ℝ
forall a b. (a -> b) -> a -> b
$ ([ℝ] -> ℝ) -> ([ℝ], [ℝ]) -> (ℝ, ℝ)
forall t b. (t -> b) -> (t, t) -> (b, b)
both [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([ℝ], [ℝ]) -> (ℝ, ℝ))
-> ([(ℝ, ℝ)] -> ([ℝ], [ℝ])) -> [(ℝ, ℝ)] -> (ℝ, ℝ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ℝ, ℝ)] -> ([ℝ], [ℝ])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ℝ, ℝ)] -> (ℝ, ℝ)) -> [(ℝ, ℝ)] -> (ℝ, ℝ)
forall a b. (a -> b) -> a -> b
$ (V2 ℝ -> (ℝ, ℝ)) -> [V2 ℝ] -> [(ℝ, ℝ)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V2 ℝ -> (ℝ, ℝ)
forall a. V2 a -> (a, a)
unpack ([V2 ℝ] -> [(ℝ, ℝ)]) -> [V2 ℝ] -> [(ℝ, ℝ)]
forall a b. (a -> b) -> a -> b
$ (ℝ -> ℝ) -> V2 ℝ -> V2 ℝ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ -> ℝ
forall a. Num a => a -> a
abs (V2 ℝ -> V2 ℝ) -> (ℝ -> V2 ℝ) -> ℝ -> V2 ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtrudeMScale -> ℝ -> V2 ℝ
toScaleFn ExtrudeMScale
s (ℝ -> V2 ℝ) -> [ℝ] -> [V2 ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ℝ]
hrange
            smin :: a -> a -> a
smin a
s a
v = a -> a -> a
forall a. Ord a => a -> a -> a
min a
v (a
s a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
            smax :: a -> a -> a
smax a
s a
v = a -> a -> a
forall a. Ord a => a -> a -> a
max a
v (a
s a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
            -- FIXME: assumes minimums are negative, and maximums are positive.
            scaleEach :: (V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)
scaleEach (V2 ℝ
d1 ℝ
d2, V2 ℝ
d3 ℝ
d4) = (ℝ
scalex' ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
d1, ℝ
scaley' ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
d2, ℝ
scalex' ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
d3, ℝ
scaley' ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
d4)
          in case Either ℝ (ℝ -> ℝ)
twist of
            Left ℝ
twval -> if ℝ
twval ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0
                          then (ℝ -> ℝ -> ℝ
forall a. (Ord a, Num a) => a -> a -> a
smin ℝ
scalex' ℝ
x1, ℝ -> ℝ -> ℝ
forall a. (Ord a, Num a) => a -> a -> a
smin ℝ
scaley' ℝ
y1, ℝ -> ℝ -> ℝ
forall a. (Ord a, Num a) => a -> a -> a
smax ℝ
scalex' ℝ
x2, ℝ -> ℝ -> ℝ
forall a. (Ord a, Num a) => a -> a -> a
smax ℝ
scaley' ℝ
y2)
                          else (V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)
scaleEach ((V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)) -> (V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)
forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> ℝ -> (V2 ℝ, V2 ℝ)
getBox2R SymbolicObj2
symbObj ℝ
twval
            Right ℝ -> ℝ
_  -> (V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)
scaleEach ((V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)) -> (V2 ℝ, V2 ℝ) -> (ℝ, ℝ, ℝ, ℝ)
forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> ℝ -> (V2 ℝ, V2 ℝ)
getBox2R SymbolicObj2
symbObj ℝ
360 -- we can't range functions yet, so assume a full circle.

        (ℝ
tminx, ℝ
tmaxx, ℝ
tminy, ℝ
tmaxy) =
          let
            tvalsx :: (ℝ -> V2 ℝ) -> [ℝ]
            tvalsx :: (ℝ -> V2 ℝ) -> [ℝ]
tvalsx ℝ -> V2 ℝ
tfun = (ℝ -> ℝ) -> [ℝ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ℝ, ℝ) -> ℝ
forall a b. (a, b) -> a
fst ((ℝ, ℝ) -> ℝ) -> (ℝ -> (ℝ, ℝ)) -> ℝ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 ℝ -> (ℝ, ℝ)
forall a. V2 a -> (a, a)
unpack (V2 ℝ -> (ℝ, ℝ)) -> (ℝ -> V2 ℝ) -> ℝ -> (ℝ, ℝ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> V2 ℝ
tfun) [ℝ]
hrange
            tvalsy :: (ℝ -> V2 ℝ) -> [ℝ]
            tvalsy :: (ℝ -> V2 ℝ) -> [ℝ]
tvalsy ℝ -> V2 ℝ
tfun = (ℝ -> ℝ) -> [ℝ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ℝ, ℝ) -> ℝ
forall a b. (a, b) -> b
snd ((ℝ, ℝ) -> ℝ) -> (ℝ -> (ℝ, ℝ)) -> ℝ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 ℝ -> (ℝ, ℝ)
forall a. V2 a -> (a, a)
unpack (V2 ℝ -> (ℝ, ℝ)) -> (ℝ -> V2 ℝ) -> ℝ -> (ℝ, ℝ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> V2 ℝ
tfun) [ℝ]
hrange
          in case Either (V2 ℝ) (ℝ -> V2 ℝ)
translate of
            Left  (V2 ℝ
tvalx ℝ
tvaly) -> (ℝ
tvalx, ℝ
tvalx, ℝ
tvaly, ℝ
tvaly)
            Right ℝ -> V2 ℝ
tfun -> ( [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall a b. (a -> b) -> a -> b
$ (ℝ -> V2 ℝ) -> [ℝ]
tvalsx ℝ -> V2 ℝ
tfun
                          , [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall a b. (a -> b) -> a -> b
$ (ℝ -> V2 ℝ) -> [ℝ]
tvalsx ℝ -> V2 ℝ
tfun
                          , [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall a b. (a -> b) -> a -> b
$ (ℝ -> V2 ℝ) -> [ℝ]
tvalsy ℝ -> V2 ℝ
tfun
                          , [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall a b. (a -> b) -> a -> b
$ (ℝ -> V2 ℝ) -> [ℝ]
tvalsy ℝ -> V2 ℝ
tfun
                          )
    in
        (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ
twistXmin ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
tminx) (ℝ
twistYmin ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
tminy) ℝ
0, ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ
twistXmax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
tmaxx) (ℝ
twistYmax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
tmaxy) ℝ
h)
-- Note: Assumes x2 is always greater than x1.
-- FIXME: Insert the above assumption as an assertion in the type system?
getBox3 (RotateExtrude ℝ
_ (Left (V2 ℝ
xshift ℝ
yshift)) Either ℝ (ℝ -> ℝ)
_ SymbolicObj2
symbObj) =
    let
        (V2 ℝ
_ ℝ
y1, V2 ℝ
x2 ℝ
y2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj
        r :: ℝ
r = ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max ℝ
x2 (ℝ
x2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
xshift)
    in
        (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (-ℝ
r) (-ℝ
r) (ℝ -> ℝ3) -> ℝ -> ℝ3
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
min ℝ
y1 (ℝ
y1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
yshift), ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
r ℝ
r (ℝ -> ℝ3) -> ℝ -> ℝ3
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max ℝ
y2 (ℝ
y2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
yshift))
-- FIXME: magic numbers: 0.1, 1.1, and 11.
-- FIXME: this may use an approximation, based on sampling functions. generate a warning if the approximation part of this function is used.
-- FIXME: re-implement the expression system, so this can recieve a function, and determine class (constant, linear)... and implement better forms of this function.
getBox3 (RotateExtrude ℝ
rot (Right ℝ -> V2 ℝ
f) Either ℝ (ℝ -> ℝ)
rotate SymbolicObj2
symbObj) =
    let
        samples :: Fastℕ
        samples :: Fastℕ
samples = Fastℕ
11
        xfuzz :: ℝ
        xfuzz :: ℝ
xfuzz = ℝ
1.1
        yfuzz :: ℝ
        yfuzz :: ℝ
yfuzz=ℝ
0.1
        range :: [Fastℕ]
        range :: [Fastℕ]
range = [Fastℕ
0, Fastℕ
1 .. (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)]
        step :: ℝ
step = ℝ
rotℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/Fastℕ -> ℝ
fromFastℕtoℝ (Fastℕ
samplesFastℕ -> Fastℕ -> Fastℕ
forall a. Num a => a -> a -> a
-Fastℕ
1)
        (V2 ℝ
x1 ℝ
y1, V2 ℝ
x2 ℝ
y2) = SymbolicObj2 -> (V2 ℝ, V2 ℝ)
getBox2 SymbolicObj2
symbObj
        ([ℝ]
xrange, [ℝ]
yrange) = [(ℝ, ℝ)] -> ([ℝ], [ℝ])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ℝ, ℝ)] -> ([ℝ], [ℝ])) -> [(ℝ, ℝ)] -> ([ℝ], [ℝ])
forall a b. (a -> b) -> a -> b
$ (V2 ℝ -> (ℝ, ℝ)) -> [V2 ℝ] -> [(ℝ, ℝ)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V2 ℝ -> (ℝ, ℝ)
forall a. V2 a -> (a, a)
unpack ([V2 ℝ] -> [(ℝ, ℝ)]) -> [V2 ℝ] -> [(ℝ, ℝ)]
forall a b. (a -> b) -> a -> b
$ Int -> [V2 ℝ] -> [V2 ℝ]
forall a. Int -> [a] -> [a]
take (Fastℕ -> Int
forall n. FastN n => Fastℕ -> n
fromFastℕ Fastℕ
samples) ([V2 ℝ] -> [V2 ℝ]) -> [V2 ℝ] -> [V2 ℝ]
forall a b. (a -> b) -> a -> b
$ (Fastℕ -> V2 ℝ) -> [Fastℕ] -> [V2 ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ℝ -> V2 ℝ
f (ℝ -> V2 ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> V2 ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ℝ
stepℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*) (ℝ -> ℝ) -> (Fastℕ -> ℝ) -> Fastℕ -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fastℕ -> ℝ
fromFastℕtoℝ) [Fastℕ]
range
        xmax :: ℝ
xmax = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ℝ]
xrange
        ymax :: ℝ
ymax = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ℝ]
yrange
        ymin :: ℝ
ymin = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ℝ]
yrange
        xmax' :: ℝ
xmax' | ℝ
xmax ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0 = ℝ
xmax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
xfuzz
              | ℝ
xmax ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< - ℝ
x1 = ℝ
0
              | Bool
otherwise = ℝ
xmax
        ymax' :: ℝ
ymax' = ℝ
ymax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
yfuzz ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (ℝ
ymax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
ymin)
        ymin' :: ℝ
ymin' = ℝ
ymin ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
yfuzz ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (ℝ
ymax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
ymin)
        (ℝ
r, ℝ
_, ℝ
_) = if (ℝ -> Bool) -> ((ℝ -> ℝ) -> Bool) -> Either ℝ (ℝ -> ℝ) -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
==ℝ
0) (Bool -> (ℝ -> ℝ) -> Bool
forall a b. a -> b -> a
const Bool
False) Either ℝ (ℝ -> ℝ)
rotate
            then let
                s :: ℝ
s = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall a b. (a -> b) -> a -> b
$ (ℝ -> ℝ) -> [ℝ] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ -> ℝ
forall a. Num a => a -> a
abs [ℝ
x2, ℝ
y1, ℝ
y2]
            in (ℝ
s ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
xmax', ℝ
s ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymin', ℝ
y2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymax')
            else (ℝ
x2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
xmax', ℝ
y1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymin', ℝ
y2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymax')
    in
        (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (-ℝ
r) (-ℝ
r) (ℝ -> ℝ3) -> ℝ -> ℝ3
forall a b. (a -> b) -> a -> b
$ ℝ
y1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymin', ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
r  ℝ
r  (ℝ -> ℝ3) -> ℝ -> ℝ3
forall a b. (a -> b) -> a -> b
$ ℝ
y2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ymax')

unpack :: V2 a -> (a, a)
unpack :: V2 a -> (a, a)
unpack (V2 a
a a
b) = (a
a, a
b)

pack :: (a, a) -> V2 a
pack :: (a, a) -> V2 a
pack = (a -> a -> V2 a) -> (a, a) -> V2 a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> V2 a
forall a. a -> a -> V2 a
V2