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

-- FIXME: Required. why?
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}

-- A module exporting all of the primitives, and some operations on them.
module Graphics.Implicit.Primitives (
                                     translate,
                                     mirror,
                                     scale,
                                     outset,
                                     complement, union, intersect, difference,
                                     unionR, intersectR, differenceR,
                                     shell,
                                     getBox,
                                     getImplicit,
                                     getImplicit',
                                     extrude,
                                     extrudeM,
                                     extrudeOnEdgeOf,
                                     sphere,
                                     cube, rect3,
                                     circle,
                                     cylinder,
                                     cylinder2,
                                     cone,
                                     torus,
                                     ellipsoid,
                                     square, rect,
                                     polygon,
                                     rotateExtrude,
                                     rotate3,
                                     rotateQ,
                                     rotate3V,
                                     transform3,
                                     pack3,
                                     rotate,
                                     transform,
                                     pack2,
                                     implicit,
                                     emptySpace,
                                     fullSpace,
                                     withRounding,
                                     _Shared,
                                     pattern Shared,
                                     Object(Space, canonicalize)) where

import Prelude(Applicative, Eq, Foldable, Num, abs, (<), otherwise, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($), (**), sqrt)

import Graphics.Implicit.Canon (canonicalize2, canonicalize3)
import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                      SharedObj(Empty,
                                                Full,
                                                Translate,
                                                Empty,
                                                Scale,
                                                Complement,
                                                Outset,
                                                Mirror,
                                                Shell,
                                                UnionR,
                                                DifferenceR,
                                                IntersectR,
                                                EmbedBoxedObj,
                                                WithRounding
                                               ),
                                      SymbolicObj2(
                                                   Square,
                                                   Circle,
                                                   Polygon,
                                                   Rotate2,
                                                   Transform2,
                                                   Shared2
                                                  ),
                                      SymbolicObj3(
                                                   Cube,
                                                   Sphere,
                                                   Cylinder,
                                                   Rotate3,
                                                   Transform3,
                                                   Extrude,
                                                   ExtrudeM,
                                                   RotateExtrude,
                                                   ExtrudeOnEdgeOf,
                                                   Shared3
                                                  ),
                                      ExtrudeMScale,
                                      defaultObjectContext
                                     )
import Graphics.Implicit.MathUtil   (pack)
import Graphics.Implicit.ObjectUtil (getBox2, getBox3, getImplicit2, getImplicit3)
import Linear (M33, M44, V2(V2),V3(V3), axisAngle, Quaternion)
import Control.Lens (prism', Prism', preview, (#))
import Data.Kind (Type)

-- $ 3D Primitives

sphere ::
    ℝ                  -- ^ Radius of the sphere
    -> SymbolicObj3    -- ^ Resulting sphere
sphere :: ℝ -> SymbolicObj3
sphere = ℝ -> SymbolicObj3
Sphere

-- | A rectangular prism
rect3
    :: ℝ3             -- ^ Bottom.. corner
    -> ℝ3             -- ^ Top right... corner
    -> SymbolicObj3   -- ^ Resuting cube
rect3 :: ℝ3 -> ℝ3 -> SymbolicObj3
rect3 ℝ3
xyz1 ℝ3
xyz2 = forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ℝ3
xyz1 forall a b. (a -> b) -> a -> b
$ ℝ3 -> SymbolicObj3
Cube forall a b. (a -> b) -> a -> b
$ ℝ3
xyz2 forall a. Num a => a -> a -> a
- ℝ3
xyz1

-- | A cube
cube
    :: Bool           -- ^ Centered?
    -> ℝ3             -- ^ Size
    -> SymbolicObj3   -- ^ Resuting cube. (0,0,0) is bottom left if @center = False@,
                      -- otherwise it's the center.
cube :: Bool -> ℝ3 -> SymbolicObj3
cube Bool
False ℝ3
size = ℝ3 -> SymbolicObj3
Cube ℝ3
size
cube Bool
True  ℝ3
size = forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ ℝ
2)) ℝ3
size) forall a b. (a -> b) -> a -> b
$ ℝ3 -> SymbolicObj3
Cube ℝ3
size

-- | A conical frustum --- ie. a cylinder with different radii at either end.
cylinder2 ::
    ℝ                   -- ^ Radius of the cylinder
    -> ℝ                -- ^ Second radius of the cylinder
    -> ℝ                -- ^ Height of the cylinder
    -> SymbolicObj3     -- ^ Resulting cylinder
cylinder2 :: ℝ -> ℝ -> ℝ -> SymbolicObj3
cylinder2 ℝ
r1 ℝ
r2 ℝ
h
  | ℝ
h forall a. Ord a => a -> a -> Bool
< ℝ
0 = forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
mirror (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1) forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ -> SymbolicObj3
cylinder2 ℝ
r1 ℝ
r2 (forall a. Num a => a -> a
abs ℝ
h)
  | Bool
otherwise = ℝ -> ℝ -> ℝ -> SymbolicObj3
Cylinder ℝ
h ℝ
r1 ℝ
r2

cylinder ::
    ℝ                   -- ^ Radius of the cylinder
    -> ℝ                -- ^ Height of the cylinder
    -> SymbolicObj3     -- ^ Resulting cylinder
cylinder :: ℝ -> ℝ -> SymbolicObj3
cylinder ℝ
r = ℝ -> ℝ -> ℝ -> SymbolicObj3
cylinder2 ℝ
r ℝ
r

cone ::
    ℝ                   -- ^ Radius of the cylinder
    -> ℝ                -- ^ Height of the cylinder
    -> SymbolicObj3     -- ^ Resulting cylinder
cone :: ℝ -> ℝ -> SymbolicObj3
cone = ℝ -> ℝ -> ℝ -> SymbolicObj3
cylinder2 ℝ
0

torus :: ℝ -> ℝ -> SymbolicObj3 -- Major radius, minor radius
torus :: ℝ -> ℝ -> SymbolicObj3
torus ℝ
r1 ℝ
r2 = forall obj (f :: * -> *) a.
Object obj f a =>
(f a -> a) -> (f a, f a) -> obj
implicit
    (\(V3 ℝ
x ℝ
y ℝ
z) -> let a :: ℝ
a = (forall a. Floating a => a -> a
sqrt (ℝ
xforall a. Floating a => a -> a -> a
**ℝ
2 forall a. Num a => a -> a -> a
+ ℝ
yforall a. Floating a => a -> a -> a
**ℝ
2) forall a. Num a => a -> a -> a
- ℝ
r1) in ℝ
aforall a. Floating a => a -> a -> a
**ℝ
2 forall a. Num a => a -> a -> a
+ ℝ
zforall a. Floating a => a -> a -> a
**ℝ
2 forall a. Num a => a -> a -> a
- ℝ
r2forall a. Floating a => a -> a -> a
**ℝ
2)
    (forall a. a -> a -> a -> V3 a
V3 (-ℝ
r) (-ℝ
r) (-ℝ
r2), forall a. a -> a -> a -> V3 a
V3 ℝ
r ℝ
r ℝ
r2)
    where
        r :: ℝ
r = ℝ
r1 forall a. Num a => a -> a -> a
+ ℝ
r2

ellipsoid :: ℝ -> ℝ -> ℝ -> SymbolicObj3 -- a, b, c
ellipsoid :: ℝ -> ℝ -> ℝ -> SymbolicObj3
ellipsoid ℝ
a ℝ
b ℝ
c = forall obj (f :: * -> *) a.
Object obj f a =>
(f a -> a) -> (f a, f a) -> obj
implicit
    (\(V3 ℝ
x ℝ
y ℝ
z) -> (ℝ
xforall a. Floating a => a -> a -> a
**ℝ
2forall a. Fractional a => a -> a -> a
/ℝ
aforall a. Floating a => a -> a -> a
**ℝ
2) forall a. Num a => a -> a -> a
+ (ℝ
yforall a. Floating a => a -> a -> a
**ℝ
2forall a. Fractional a => a -> a -> a
/ℝ
bforall a. Floating a => a -> a -> a
**ℝ
2) forall a. Num a => a -> a -> a
+ (ℝ
zforall a. Floating a => a -> a -> a
**ℝ
2forall a. Fractional a => a -> a -> a
/ℝ
cforall a. Floating a => a -> a -> a
**ℝ
2) forall a. Num a => a -> a -> a
- ℝ
1)
    (forall a. a -> a -> a -> V3 a
V3 (-ℝ
a) (-ℝ
b) (-ℝ
c), forall a. a -> a -> a -> V3 a
V3 ℝ
a ℝ
b ℝ
c)

-- $ 2D Primitives

circle ::
    ℝ               -- ^ radius of the circle
    -> SymbolicObj2 -- ^ resulting circle
circle :: ℝ -> SymbolicObj2
circle   = ℝ -> SymbolicObj2
Circle

-- | A rectangle
rect
    :: ℝ2           -- ^ Bottom left corner
    -> ℝ2           -- ^ Top right corner
    -> SymbolicObj2 -- ^ Resulting square
rect :: ℝ2 -> ℝ2 -> SymbolicObj2
rect ℝ2
xy1 ℝ2
xy2 = forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ℝ2
xy1 forall a b. (a -> b) -> a -> b
$ ℝ2 -> SymbolicObj2
Square forall a b. (a -> b) -> a -> b
$ ℝ2
xy2 forall a. Num a => a -> a -> a
- ℝ2
xy1

-- | A square
square
    :: Bool         -- ^ Centered?
    -> ℝ2           -- ^ Size
    -> SymbolicObj2 -- ^ Resulting square (bottom right = (0,0) )
square :: Bool -> ℝ2 -> SymbolicObj2
square Bool
False ℝ2
size = ℝ2 -> SymbolicObj2
Square ℝ2
size
square Bool
True  ℝ2
size = forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ ℝ
2)) ℝ2
size) forall a b. (a -> b) -> a -> b
$ ℝ2 -> SymbolicObj2
Square ℝ2
size

-- | A 2D polygon
polygon
    :: [ℝ2]          -- ^ Verticies of the polygon
    -> SymbolicObj2  -- ^ Resulting polygon
polygon :: [ℝ2] -> SymbolicObj2
polygon = [ℝ2] -> SymbolicObj2
Polygon

-- $ Shared Operations

-- | Operations available on both 2D and 3D objects. The obvious omission of
-- rotation operations from this class are a technical limitation, and are
-- instead provided by 'rotate' and 'rotate3'.
--
-- Library users shouldn't need to provide new instances of this class.
class ( Applicative f
      , Eq a
      , Eq (f a)
      , Foldable f
      , Num a
      , Num (f a))
      => Object obj f a | obj -> f a
      where

    -- | Type representing a space this object belongs to.
    -- V3 for 3D objects, V2 for 2D
    type Space obj :: Type -> Type

    -- | A 'Prism'' for including 'SharedObj's in @obj@. Prefer using 'Shared'
    -- instead of this.
    _Shared :: Prism' obj (SharedObj obj f a)

    -- | Get the bounding box an object
    getBox ::
        obj           -- ^ Object to get box of
        -> (f a, f a) -- ^ Bounding box

    -- | Get the implicit function for an object
    getImplicit'
        :: ObjectContext
        -> obj         -- ^ Object to get implicit function of
        -> (f a -> a)  -- ^ Implicit function

    -- | Canonicalization function used to rewrite / normalize
    -- abstract syntax tree representing an object
    canonicalize :: obj -> obj

-- | Get the implicit function for an object
getImplicit
    :: Object obj f a
    => obj         -- ^ Object to get implicit function of
    -> (f a -> a)  -- ^ Implicit function
getImplicit :: forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit = forall obj (f :: * -> *) a.
Object obj f a =>
ObjectContext -> obj -> f a -> a
getImplicit' ObjectContext
defaultObjectContext

-- | A pattern that abstracts over 'Shared2' and 'Shared3'.
pattern Shared :: (Object obj f a) => SharedObj obj f a -> obj
pattern $bShared :: forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
$mShared :: forall {r} {obj} {f :: * -> *} {a}.
Object obj f a =>
obj -> (SharedObj obj f a -> r) -> ((# #) -> r) -> r
Shared v <- (preview _Shared -> Just v)
  where
    Shared SharedObj obj f a
v = forall obj (f :: * -> *) a.
Object obj f a =>
Prism' obj (SharedObj obj f a)
_Shared forall t b. AReview t b -> b -> t
# SharedObj obj f a
v

-- | Translate an object by a vector of appropriate dimension.
translate
    :: Object obj f a
    => f a  -- ^ Vector to translate by
    -> obj  -- ^ Object to translate
    -> obj  -- ^ Resulting object
translate :: forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate f a
v obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. f a -> obj -> SharedObj obj f a
Translate f a
v obj
s

-- | Scale an object
scale
    :: Object obj f a
    => f a  -- ^ Amount to scale by
    -> obj  -- ^ Object to scale
    -> obj  -- ^ Resulting scaled object
scale :: forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
scale f a
v obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. f a -> obj -> SharedObj obj f a
Scale f a
v obj
s

-- | Complement an Object
complement
    :: Object obj f a
    => obj  -- ^ Object to complement
    -> obj  -- ^ Result
complement :: forall obj (f :: * -> *) a. Object obj f a => obj -> obj
complement (Shared SharedObj obj f a
Empty) = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall obj (f :: * -> *) a. SharedObj obj f a
Full
complement (Shared SharedObj obj f a
Full) = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall obj (f :: * -> *) a. SharedObj obj f a
Empty
complement (Shared (Complement obj
s)) = obj
s
complement obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. obj -> SharedObj obj f a
Complement obj
s

-- | The object that fills no space
emptySpace :: Object obj f a => obj
emptySpace :: forall obj (f :: * -> *) a. Object obj f a => obj
emptySpace = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall obj (f :: * -> *) a. SharedObj obj f a
Empty

-- | The object that fills the entire space
fullSpace :: Object obj f a => obj
fullSpace :: forall obj (f :: * -> *) a. Object obj f a => obj
fullSpace = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall obj (f :: * -> *) a. SharedObj obj f a
Full

-- | Set the current object-rounding value for the given object. The rounding
-- value is measured in units of distance, and describes the radius of rounded
-- corners.
--
-- This can be used to change the shape of more primitive forms, for example,
-- we can make a cube with rounded corners via @withRounding 5 ('cube' True
-- 20)@.
--
-- @'withRounding' r obj@ applies the rounding @r@ /all/ primitives objects in
-- @obj@, so long as they have the same dimensionality. That is to say,
-- the current object-rounding value set in 3D will not apply to extruded 2D
-- shapes.
withRounding :: Object obj f a => ℝ -> obj -> obj
withRounding :: forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
withRounding ℝ
r = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall obj (f :: * -> *) a. ℝ -> obj -> SharedObj obj f a
WithRounding ℝ
r

-- | Mirror an object across the hyperplane whose normal is a given
-- vector.
mirror
    :: Object obj f a
    => f a  -- ^ Vector defining the hyperplane
    -> obj  -- ^ Object to mirror
    -> obj  -- ^ Resulting object
mirror :: forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
mirror f a
v obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. f a -> obj -> SharedObj obj f a
Mirror f a
v obj
s

-- | Outset of an object.
outset
    :: Object obj f a
    => ℝ     -- ^ distance to outset
    -> obj   -- ^ object to outset
    -> obj   -- ^ resulting object
outset :: forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
outset ℝ
v obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. ℝ -> obj -> SharedObj obj f a
Outset ℝ
v obj
s

-- | Make a shell of an object.
shell
    :: Object obj f a
    => ℝ     -- ^ width of shell
    -> obj   -- ^ object to take shell of
    -> obj   -- ^ resulting shell
shell :: forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
shell ℝ
v obj
s = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. ℝ -> obj -> SharedObj obj f a
Shell ℝ
v obj
s

-- | Rounded union
unionR
    :: Object obj f a
    => ℝ      -- ^ The radius (in mm) of rounding
    -> [obj]  -- ^ objects to union
    -> obj    -- ^ Resulting object
unionR :: forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
unionR ℝ
r [obj]
ss = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. ℝ -> [obj] -> SharedObj obj f a
UnionR ℝ
r [obj]
ss

-- | Rounded difference
differenceR
    :: Object obj f a
    => ℝ     -- ^ The radius (in mm) of rounding
    -> obj   -- ^ Base object
    -> [obj] -- ^ Objects to subtract from the base
    -> obj   -- ^ Resulting object
differenceR :: forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
differenceR ℝ
r obj
s [obj]
ss = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. ℝ -> obj -> [obj] -> SharedObj obj f a
DifferenceR ℝ
r obj
s [obj]
ss
{-# INLINABLE differenceR #-}

-- | Rounded minimum
intersectR
    :: Object obj f a
    => ℝ     -- ^ The radius (in mm) of rounding
    -> [obj] -- ^ Objects to intersect
    -> obj   -- ^ Resulting object
intersectR :: forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
intersectR ℝ
r [obj]
ss = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. ℝ -> [obj] -> SharedObj obj f a
IntersectR ℝ
r [obj]
ss

implicit
    :: Object obj f a
    => (f a -> a)  -- ^ Implicit function
    -> (f a, f a)  -- ^ Bounding box
    -> obj         -- ^ Resulting object
implicit :: forall obj (f :: * -> *) a.
Object obj f a =>
(f a -> a) -> (f a, f a) -> obj
implicit f a -> a
a (f a, f a)
b = forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a.
(f a -> a, (f a, f a)) -> SharedObj obj f a
EmbedBoxedObj (f a -> a
a, (f a, f a)
b)

instance Object SymbolicObj2 V2 ℝ where
  type Space SymbolicObj2 = V2
  _Shared :: Prism' SymbolicObj2 (SharedObj SymbolicObj2 V2 ℝ)
_Shared = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SharedObj SymbolicObj2 V2 ℝ -> SymbolicObj2
Shared2 forall a b. (a -> b) -> a -> b
$ \case
    Shared2 SharedObj SymbolicObj2 V2 ℝ
x -> forall a. a -> Maybe a
Just SharedObj SymbolicObj2 V2 ℝ
x
    SymbolicObj2
_         -> forall a. Maybe a
Nothing
  getBox :: SymbolicObj2 -> (ℝ2, ℝ2)
getBox       = SymbolicObj2 -> (ℝ2, ℝ2)
getBox2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall obj (f :: * -> *) a. Object obj f a => obj -> obj
canonicalize
  getImplicit' :: ObjectContext -> SymbolicObj2 -> ℝ2 -> ℝ
getImplicit' ObjectContext
ctx = ObjectContext -> SymbolicObj2 -> ℝ2 -> ℝ
getImplicit2 ObjectContext
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall obj (f :: * -> *) a. Object obj f a => obj -> obj
canonicalize
  canonicalize :: SymbolicObj2 -> SymbolicObj2
canonicalize = SymbolicObj2 -> SymbolicObj2
canonicalize2

instance Object SymbolicObj3 V3 ℝ where
  type Space SymbolicObj3 = V3
  _Shared :: Prism' SymbolicObj3 (SharedObj SymbolicObj3 V3 ℝ)
_Shared = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SharedObj SymbolicObj3 V3 ℝ -> SymbolicObj3
Shared3 forall a b. (a -> b) -> a -> b
$ \case
    Shared3 SharedObj SymbolicObj3 V3 ℝ
x -> forall a. a -> Maybe a
Just SharedObj SymbolicObj3 V3 ℝ
x
    SymbolicObj3
_         -> forall a. Maybe a
Nothing
  getBox :: SymbolicObj3 -> (ℝ3, ℝ3)
getBox       = SymbolicObj3 -> (ℝ3, ℝ3)
getBox3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall obj (f :: * -> *) a. Object obj f a => obj -> obj
canonicalize
  getImplicit' :: ObjectContext -> SymbolicObj3 -> ℝ3 -> ℝ
getImplicit' ObjectContext
ctx = ObjectContext -> SymbolicObj3 -> ℝ3 -> ℝ
getImplicit3 ObjectContext
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall obj (f :: * -> *) a. Object obj f a => obj -> obj
canonicalize
  canonicalize :: SymbolicObj3 -> SymbolicObj3
canonicalize = SymbolicObj3 -> SymbolicObj3
canonicalize3

union :: Object obj f a => [obj] -> obj
union :: forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
union = forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
unionR ℝ
0

difference :: Object obj f a => obj -> [obj] -> obj
difference :: forall obj (f :: * -> *) a. Object obj f a => obj -> [obj] -> obj
difference = forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
differenceR ℝ
0

intersect :: Object obj f a => [obj] -> obj
intersect :: forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
intersect = forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
intersectR ℝ
0

-- 3D operations

-- | Extrude a 2d object upwards. The current object-rounding value set by
-- 'withRounding' is used to round the caps, but is not used by the 2D object.
extrude
    :: SymbolicObj2
    -> ℝ   -- ^ Extrusion height
    -> SymbolicObj3
extrude :: SymbolicObj2 -> ℝ -> SymbolicObj3
extrude = SymbolicObj2 -> ℝ -> SymbolicObj3
Extrude

-- | The current object-rounding value set by 'withRounding' is used to round
-- the caps, but is not used by the 2D object.
extrudeM
    :: Either ℝ (ℝ -> ℝ)    -- ^ twist
    -> ExtrudeMScale       -- ^ scale
    -> Either ℝ2 (ℝ -> ℝ2)  -- ^ translate
    -> SymbolicObj2         -- ^ object to extrude
    -> Either ℝ (ℝ2 -> ℝ)   -- ^ height to extrude to
    -> SymbolicObj3
extrudeM :: Either ℝ (ℝ -> ℝ)
-> ExtrudeMScale
-> Either ℝ2 (ℝ -> ℝ2)
-> SymbolicObj2
-> Either ℝ (ℝ2 -> ℝ)
-> SymbolicObj3
extrudeM = Either ℝ (ℝ -> ℝ)
-> ExtrudeMScale
-> Either ℝ2 (ℝ -> ℝ2)
-> SymbolicObj2
-> Either ℝ (ℝ2 -> ℝ)
-> SymbolicObj3
ExtrudeM

rotateExtrude
    :: ℝ                    -- ^ Angle to sweep to (in rad)
    -> Either ℝ2 (ℝ -> ℝ2)  -- ^ translate
    -> Either ℝ  (ℝ -> ℝ )  -- ^ rotate
    -> SymbolicObj2         -- ^ object to extrude
    -> SymbolicObj3
rotateExtrude :: ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
rotateExtrude = ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
RotateExtrude

extrudeOnEdgeOf :: SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
extrudeOnEdgeOf :: SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
extrudeOnEdgeOf = SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
ExtrudeOnEdgeOf

-- | Rotate a 3D object via an Euler angle, measured in radians, along the
-- world axis.
rotate3 :: ℝ3 -> SymbolicObj3 -> SymbolicObj3
rotate3 :: ℝ3 -> SymbolicObj3 -> SymbolicObj3
rotate3 (V3 ℝ
pitch ℝ
roll ℝ
yaw)
  = Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
Rotate3
  forall a b. (a -> b) -> a -> b
$ forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1) ℝ
yaw
  forall a. Num a => a -> a -> a
* forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
1 ℝ
0) ℝ
roll
  forall a. Num a => a -> a -> a
* forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (forall a. a -> a -> a -> V3 a
V3 ℝ
1 ℝ
0 ℝ
0) ℝ
pitch

rotateQ
    :: Quaternion ℝ
    -> SymbolicObj3
    -> SymbolicObj3
rotateQ :: Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
rotateQ = Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
Rotate3

-- | Rotate a 3D object along an arbitrary axis.
rotate3V
    :: ℝ   -- ^ Angle of rotation
    -> ℝ3  -- ^ Axis of rotation
    -> SymbolicObj3
    -> SymbolicObj3
rotate3V :: ℝ -> ℝ3 -> SymbolicObj3 -> SymbolicObj3
rotate3V ℝ
w ℝ3
xyz = Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
Rotate3 forall a b. (a -> b) -> a -> b
$ forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle ℝ3
xyz ℝ
w

-- | Transform a 3D object using a 4x4 matrix representing affine transformation
-- (OpenSCAD multmatrix)
transform3
    :: M44 ℝ
    -> SymbolicObj3
    -> SymbolicObj3
transform3 :: M44 ℝ -> SymbolicObj3 -> SymbolicObj3
transform3 = M44 ℝ -> SymbolicObj3 -> SymbolicObj3
Transform3

-- | Attempt to pack multiple 3D objects into a fixed area. The @z@ coordinate
-- of each object is dropped, and the resulting packed objects will all be on
-- the same plane.
--
-- FIXME: shouldn't this pack into a 3d area, or have a 3d equivalent?
pack3
    :: ℝ2                  -- ^ Area to pack
    -> ℝ                   -- ^ Separation between objects
    -> [SymbolicObj3]      -- ^ Objects to pack
    -> Maybe SymbolicObj3  -- ^ 'Just' if the objects could be packed into the given area
pack3 :: ℝ2 -> ℝ -> [SymbolicObj3] -> Maybe SymbolicObj3
pack3 (V2 ℝ
dx ℝ
dy) ℝ
sep [SymbolicObj3]
objs =
    let
        boxDropZ :: (ℝ3,ℝ3) -> (ℝ2,ℝ2)
        boxDropZ :: (ℝ3, ℝ3) -> (ℝ2, ℝ2)
boxDropZ (V3 ℝ
a ℝ
b ℝ
_,V3 ℝ
d ℝ
e ℝ
_) = (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b, forall a. a -> a -> V2 a
V2 ℝ
d ℝ
e)
        withBoxes :: [(Box2, SymbolicObj3)]
        withBoxes :: [((ℝ2, ℝ2), SymbolicObj3)]
withBoxes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SymbolicObj3
obj -> ( (ℝ3, ℝ3) -> (ℝ2, ℝ2)
boxDropZ forall a b. (a -> b) -> a -> b
$ SymbolicObj3 -> (ℝ3, ℝ3)
getBox3 SymbolicObj3
obj, SymbolicObj3
obj)) [SymbolicObj3]
objs
    in case forall a.
(ℝ2, ℝ2) -> ℝ -> [((ℝ2, ℝ2), a)] -> ([(ℝ2, a)], [((ℝ2, ℝ2), a)])
pack (forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0,forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
dy) ℝ
sep [((ℝ2, ℝ2), SymbolicObj3)]
withBoxes of
            ([(ℝ2, SymbolicObj3)]
a, []) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
union forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 ℝ
x ℝ
y,SymbolicObj3
obj) -> forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0) SymbolicObj3
obj) [(ℝ2, SymbolicObj3)]
a
            ([(ℝ2, SymbolicObj3)], [((ℝ2, ℝ2), SymbolicObj3)])
_ -> forall a. Maybe a
Nothing

-- 2D operations

rotate :: ℝ -> SymbolicObj2 -> SymbolicObj2
rotate :: ℝ -> SymbolicObj2 -> SymbolicObj2
rotate = ℝ -> SymbolicObj2 -> SymbolicObj2
Rotate2

-- | Transform a 2D object using a 3x3 matrix representing affine transformation
-- (OpenSCAD multmatrix)
transform
    :: M33 ℝ
    -> SymbolicObj2
    -> SymbolicObj2
transform :: M33 ℝ -> SymbolicObj2 -> SymbolicObj2
transform = M33 ℝ -> SymbolicObj2 -> SymbolicObj2
Transform2

-- | Attempt to pack multiple 2D objects into a fixed area.
pack2
    :: ℝ2                  -- ^ Area to pack
    -> ℝ                   -- ^ Separation between objects
    -> [SymbolicObj2]      -- ^ Objects to pack
    -> Maybe SymbolicObj2  -- ^ 'Just' if the objects could be packed into the given area
pack2 :: ℝ2 -> ℝ -> [SymbolicObj2] -> Maybe SymbolicObj2
pack2 (V2 ℝ
dx ℝ
dy) ℝ
sep [SymbolicObj2]
objs =
    let
        withBoxes :: [(Box2, SymbolicObj2)]
        withBoxes :: [((ℝ2, ℝ2), SymbolicObj2)]
withBoxes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SymbolicObj2
obj -> ( SymbolicObj2 -> (ℝ2, ℝ2)
getBox2 SymbolicObj2
obj, SymbolicObj2
obj)) [SymbolicObj2]
objs
    in case forall a.
(ℝ2, ℝ2) -> ℝ -> [((ℝ2, ℝ2), a)] -> ([(ℝ2, a)], [((ℝ2, ℝ2), a)])
pack (forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0,forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
dy) ℝ
sep [((ℝ2, ℝ2), SymbolicObj2)]
withBoxes of
            ([(ℝ2, SymbolicObj2)]
a, []) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
union forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 ℝ
x ℝ
y,SymbolicObj2
obj) -> forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) SymbolicObj2
obj) [(ℝ2, SymbolicObj2)]
a
            ([(ℝ2, SymbolicObj2)], [((ℝ2, ℝ2), SymbolicObj2)])
_ -> forall a. Maybe a
Nothing