{- 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 #-}

-- 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,
                                     square, rect,
                                     polygon,
                                     rotateExtrude,
                                     rotate3,
                                     rotateQ,
                                     rotate3V,
                                     transform3,
                                     pack3,
                                     rotate,
                                     transform,
                                     pack2,
                                     implicit,
                                     emptySpace,
                                     fullSpace,
                                     withRounding,
                                     _Shared,
                                     pattern Shared,
                                     Object
                                    ) where

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

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, (#))

-- $ 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 = ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ℝ3
xyz1 (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ3 -> SymbolicObj3
Cube (ℝ3 -> SymbolicObj3) -> ℝ3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ3
xyz2 ℝ3 -> ℝ3 -> ℝ3
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 = ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ((ℝ -> ℝ) -> ℝ3 -> ℝ3
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) (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
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 ℝ
_ ℝ
_ ℝ
0 = SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => obj
emptySpace  -- necessary to prevent a NaN
cylinder2 ℝ
r1 ℝ
r2 ℝ
h
  | ℝ
h ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
0 = ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
mirror (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1) (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
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

-- $ 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 = ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ℝ2
xy1 (SymbolicObj2 -> SymbolicObj2) -> SymbolicObj2 -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ℝ2 -> SymbolicObj2
Square (ℝ2 -> SymbolicObj2) -> ℝ2 -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ℝ2
xy2 ℝ2 -> ℝ2 -> ℝ2
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 = ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate ((ℝ -> ℝ) -> ℝ2 -> ℝ2
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) (SymbolicObj2 -> SymbolicObj2) -> SymbolicObj2 -> SymbolicObj2
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)
      , Num a
      , Num (f a))
      => Object obj f a | obj -> f a
      where
    -- | 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

-- | 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 :: obj -> f a -> a
getImplicit = ObjectContext -> obj -> f a -> a
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 :: SharedObj obj f a -> obj
$mShared :: forall r obj (f :: * -> *) a.
Object obj f a =>
obj -> (SharedObj obj f a -> r) -> (Void# -> r) -> r
Shared v <- (preview _Shared -> Just v)
  where
    Shared SharedObj obj f a
v = Tagged (SharedObj obj f a) (Identity (SharedObj obj f a))
-> Tagged obj (Identity obj)
forall obj (f :: * -> *) a.
Object obj f a =>
Prism' obj (SharedObj obj f a)
_Shared (Tagged (SharedObj obj f a) (Identity (SharedObj obj f a))
 -> Tagged obj (Identity obj))
-> SharedObj obj f a -> obj
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 :: f a -> obj -> obj
translate f a
0 obj
s = obj
s
translate f a
_ s :: obj
s@(Shared SharedObj obj f a
Empty) = obj
s
translate f a
_ s :: obj
s@(Shared SharedObj obj f a
Full) = obj
s
translate f a
v1 (Shared (Translate f a
v2 obj
s)) = f a -> obj -> obj
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (f a
v1 f a -> f a -> f a
forall a. Num a => a -> a -> a
+ f a
v2) obj
s
translate f a
v obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ f a -> obj -> SharedObj obj f a
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 :: f a -> obj -> obj
scale f a
1 obj
s = obj
s
scale f a
_ s :: obj
s@(Shared SharedObj obj f a
Empty) = obj
s
scale f a
v1 (Shared (Scale f a
v2 obj
s)) = f a -> obj -> obj
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
scale (f a
v1 f a -> f a -> f a
forall a. Num a => a -> a -> a
* f a
v2) obj
s
scale f a
v obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ f a -> obj -> SharedObj obj f a
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 :: obj -> obj
complement (Shared SharedObj obj f a
Empty) = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
forall obj (f :: * -> *) a. SharedObj obj f a
Full
complement (Shared SharedObj obj f a
Full) = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
forall obj (f :: * -> *) a. SharedObj obj f a
Empty
complement (Shared (Complement obj
s)) = obj
s
complement obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ obj -> SharedObj obj f a
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 :: obj
emptySpace = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
forall obj (f :: * -> *) a. SharedObj obj f a
Empty

-- | The object that fills the entire space
fullSpace :: Object obj f a => obj
fullSpace :: obj
fullSpace = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
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 :: ℝ -> obj -> obj
withRounding ℝ
0 = obj -> obj
forall a. a -> a
id
withRounding ℝ
r = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj)
-> (obj -> SharedObj obj f a) -> obj -> obj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ -> obj -> SharedObj obj f a
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 :: f a -> obj -> obj
mirror f a
_ s :: obj
s@(Shared SharedObj obj f a
Empty) = obj
s
mirror f a
_ s :: obj
s@(Shared SharedObj obj f a
Full) = obj
s
mirror f a
v obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ f a -> obj -> SharedObj obj f a
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 :: ℝ -> obj -> obj
outset ℝ
0 obj
s = obj
s
outset ℝ
_ s :: obj
s@(Shared SharedObj obj f a
Empty) = obj
s
outset ℝ
_ s :: obj
s@(Shared SharedObj obj f a
Full) = obj
s
outset ℝ
v1 (Shared (Outset ℝ
v2 obj
s)) = ℝ -> obj -> obj
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
outset (ℝ
v1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
v2) obj
s
outset ℝ
v obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ ℝ -> obj -> SharedObj obj f a
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 :: ℝ -> obj -> obj
shell ℝ
_ s :: obj
s@(Shared SharedObj obj f a
Empty) = obj
s
shell ℝ
_ s :: obj
s@(Shared SharedObj obj f a
Full) = obj
s
shell ℝ
v obj
s = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ ℝ -> obj -> SharedObj obj f a
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 :: ℝ -> [obj] -> obj
unionR ℝ
_ [] = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
forall obj (f :: * -> *) a. SharedObj obj f a
Empty
unionR ℝ
_ [obj
s] = obj
s
unionR ℝ
r [obj]
ss = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ ℝ -> [obj] -> SharedObj obj f a
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 :: ℝ -> obj -> [obj] -> obj
differenceR ℝ
_ obj
s [] = obj
s
differenceR ℝ
_ s :: obj
s@(Shared SharedObj obj f a
Empty) [obj]
_ = obj
s
differenceR ℝ
r obj
s [obj]
ss = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ ℝ -> obj -> [obj] -> SharedObj obj f a
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 :: ℝ -> [obj] -> obj
intersectR ℝ
_ [] = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared SharedObj obj f a
forall obj (f :: * -> *) a. SharedObj obj f a
Full
intersectR ℝ
_ [obj
s] = obj
s
intersectR ℝ
r [obj]
ss = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ ℝ -> [obj] -> SharedObj obj f a
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 :: (f a -> a) -> (f a, f a) -> obj
implicit f a -> a
a (f a, f a)
b = SharedObj obj f a -> obj
forall obj (f :: * -> *) a.
Object obj f a =>
SharedObj obj f a -> obj
Shared (SharedObj obj f a -> obj) -> SharedObj obj f a -> obj
forall a b. (a -> b) -> a -> b
$ (f a -> a, (f a, f a)) -> SharedObj obj f a
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
  _Shared :: p (SharedObj SymbolicObj2 V2 ℝ) (f (SharedObj SymbolicObj2 V2 ℝ))
-> p SymbolicObj2 (f SymbolicObj2)
_Shared = (SharedObj SymbolicObj2 V2 ℝ -> SymbolicObj2)
-> (SymbolicObj2 -> Maybe (SharedObj SymbolicObj2 V2 ℝ))
-> Prism' SymbolicObj2 (SharedObj SymbolicObj2 V2 ℝ)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SharedObj SymbolicObj2 V2 ℝ -> SymbolicObj2
Shared2 ((SymbolicObj2 -> Maybe (SharedObj SymbolicObj2 V2 ℝ))
 -> Prism' SymbolicObj2 (SharedObj SymbolicObj2 V2 ℝ))
-> (SymbolicObj2 -> Maybe (SharedObj SymbolicObj2 V2 ℝ))
-> Prism' SymbolicObj2 (SharedObj SymbolicObj2 V2 ℝ)
forall a b. (a -> b) -> a -> b
$ \case
    Shared2 SharedObj SymbolicObj2 V2 ℝ
x -> SharedObj SymbolicObj2 V2 ℝ -> Maybe (SharedObj SymbolicObj2 V2 ℝ)
forall a. a -> Maybe a
Just SharedObj SymbolicObj2 V2 ℝ
x
    SymbolicObj2
_         -> Maybe (SharedObj SymbolicObj2 V2 ℝ)
forall a. Maybe a
Nothing
  getBox :: SymbolicObj2 -> (ℝ2, ℝ2)
getBox       = SymbolicObj2 -> (ℝ2, ℝ2)
getBox2
  getImplicit' :: ObjectContext -> SymbolicObj2 -> ℝ2 -> ℝ
getImplicit' = ObjectContext -> SymbolicObj2 -> ℝ2 -> ℝ
getImplicit2

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

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

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

intersect :: Object obj f a => [obj] -> obj
intersect :: [obj] -> obj
intersect = ℝ -> [obj] -> obj
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 ℝ
0 Either ℝ2 (ℝ -> ℝ2)
_ Either ℝ (ℝ -> ℝ)
_ SymbolicObj2
_ = SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => obj
emptySpace
rotateExtrude ℝ
_ Either ℝ2 (ℝ -> ℝ2)
_ Either ℝ (ℝ -> ℝ)
_ (Shared SharedObj SymbolicObj2 V2 ℝ
Empty) = SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => obj
emptySpace
rotateExtrude ℝ
theta Either ℝ2 (ℝ -> ℝ2)
t Either ℝ (ℝ -> ℝ)
r SymbolicObj2
obj = ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
RotateExtrude ℝ
theta Either ℝ2 (ℝ -> ℝ2)
t Either ℝ (ℝ -> ℝ)
r SymbolicObj2
obj

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 ℝ3
0 = SymbolicObj3 -> SymbolicObj3
forall a. a -> a
id
rotate3 (V3 ℝ
pitch ℝ
roll ℝ
yaw)
  = Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
Rotate3
  (Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3)
-> Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ3 -> ℝ -> Quaternion ℝ
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1) ℝ
yaw
  Quaternion ℝ -> Quaternion ℝ -> Quaternion ℝ
forall a. Num a => a -> a -> a
* ℝ3 -> ℝ -> Quaternion ℝ
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
1 ℝ
0) ℝ
roll
  Quaternion ℝ -> Quaternion ℝ -> Quaternion ℝ
forall a. Num a => a -> a -> a
* ℝ3 -> ℝ -> Quaternion ℝ
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (ℝ -> ℝ -> ℝ -> ℝ3
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 ℝ
0 ℝ3
_ = SymbolicObj3 -> SymbolicObj3
forall a. a -> a
id
rotate3V ℝ
w ℝ3
xyz = Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
Rotate3 (Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3)
-> Quaternion ℝ -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ3 -> ℝ -> Quaternion ℝ
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 ℝ
_) = (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b, ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
d ℝ
e)
        withBoxes :: [(Box2, SymbolicObj3)]
        withBoxes :: [((ℝ2, ℝ2), SymbolicObj3)]
withBoxes = (SymbolicObj3 -> ((ℝ2, ℝ2), SymbolicObj3))
-> [SymbolicObj3] -> [((ℝ2, ℝ2), SymbolicObj3)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SymbolicObj3
obj -> ( (ℝ3, ℝ3) -> (ℝ2, ℝ2)
boxDropZ ((ℝ3, ℝ3) -> (ℝ2, ℝ2)) -> (ℝ3, ℝ3) -> (ℝ2, ℝ2)
forall a b. (a -> b) -> a -> b
$ SymbolicObj3 -> (ℝ3, ℝ3)
getBox3 SymbolicObj3
obj, SymbolicObj3
obj)) [SymbolicObj3]
objs
    in case (ℝ2, ℝ2)
-> ℝ
-> [((ℝ2, ℝ2), SymbolicObj3)]
-> ([(ℝ2, SymbolicObj3)], [((ℝ2, ℝ2), SymbolicObj3)])
forall a.
(ℝ2, ℝ2) -> ℝ -> [((ℝ2, ℝ2), a)] -> ([(ℝ2, a)], [((ℝ2, ℝ2), a)])
pack (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0,ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
dy) ℝ
sep [((ℝ2, ℝ2), SymbolicObj3)]
withBoxes of
            ([(ℝ2, SymbolicObj3)]
a, []) -> SymbolicObj3 -> Maybe SymbolicObj3
forall a. a -> Maybe a
Just (SymbolicObj3 -> Maybe SymbolicObj3)
-> SymbolicObj3 -> Maybe SymbolicObj3
forall a b. (a -> b) -> a -> b
$ [SymbolicObj3] -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
union ([SymbolicObj3] -> SymbolicObj3) -> [SymbolicObj3] -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ((ℝ2, SymbolicObj3) -> SymbolicObj3)
-> [(ℝ2, SymbolicObj3)] -> [SymbolicObj3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 ℝ
x ℝ
y,SymbolicObj3
obj) -> ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0) SymbolicObj3
obj) [(ℝ2, SymbolicObj3)]
a
            ([(ℝ2, SymbolicObj3)], [((ℝ2, ℝ2), SymbolicObj3)])
_ -> Maybe 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 = (SymbolicObj2 -> ((ℝ2, ℝ2), SymbolicObj2))
-> [SymbolicObj2] -> [((ℝ2, ℝ2), SymbolicObj2)]
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 (ℝ2, ℝ2)
-> ℝ
-> [((ℝ2, ℝ2), SymbolicObj2)]
-> ([(ℝ2, SymbolicObj2)], [((ℝ2, ℝ2), SymbolicObj2)])
forall a.
(ℝ2, ℝ2) -> ℝ -> [((ℝ2, ℝ2), a)] -> ([(ℝ2, a)], [((ℝ2, ℝ2), a)])
pack (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0,ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
dy) ℝ
sep [((ℝ2, ℝ2), SymbolicObj2)]
withBoxes of
            ([(ℝ2, SymbolicObj2)]
a, []) -> SymbolicObj2 -> Maybe SymbolicObj2
forall a. a -> Maybe a
Just (SymbolicObj2 -> Maybe SymbolicObj2)
-> SymbolicObj2 -> Maybe SymbolicObj2
forall a b. (a -> b) -> a -> b
$ [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
union ([SymbolicObj2] -> SymbolicObj2) -> [SymbolicObj2] -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ((ℝ2, SymbolicObj2) -> SymbolicObj2)
-> [(ℝ2, SymbolicObj2)] -> [SymbolicObj2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V2 ℝ
x ℝ
y,SymbolicObj2
obj) -> ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
translate (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) SymbolicObj2
obj) [(ℝ2, SymbolicObj2)]
a
            ([(ℝ2, SymbolicObj2)], [((ℝ2, ℝ2), SymbolicObj2)])
_ -> Maybe SymbolicObj2
forall a. Maybe a
Nothing