vec to f a

Graphics/Implicit/Definitions.hs

@@ -209,23 +209,23 @@ type BoxedObj3 = Boxed3 Obj3
 -- | Means of constructing symbolic objects that are common between the 2D and
 -- 3D case. This type is parameterized on @obj@ and @vec@ so that
 -- 'SymbolicObj2' and 'SymbolicObj3' can instantiate it for their own purposes.
-data SharedObj obj vec
+data SharedObj obj f a
   = Empty  -- ^ The empty object
   | Full   -- ^ The entirely full object
   | Complement obj
   | UnionR ℝ [obj]
   | DifferenceR ℝ obj [obj]
   | IntersectR ℝ [obj]
-  | Translate vec obj
-  | Scale vec obj
-  | Mirror vec obj -- ^ Mirror across the line whose normal is defined by the vector
+  | Translate (f a) obj
+  | Scale (f a) obj
+  | Mirror (f a) obj -- ^ Mirror across the line whose normal is defined by the vector
   | Outset ℝ obj
   | Shell ℝ obj
-  | EmbedBoxedObj (vec -> ℝ, (vec, vec))
+  | EmbedBoxedObj ((f a) -> a, ((f a), (f a)))
   | WithRounding ℝ obj
   deriving (Generic)
 
-instance (Show obj, Show vec) => Show (SharedObj obj vec) where
+instance (Show obj, Show (f a)) => Show (SharedObj obj f a) where
   showsPrec = flip $ \case
      Empty                   -> showCon "emptySpace"
      Full                    -> showCon "fullSpace"
@@ -274,18 +274,18 @@ data SymbolicObj2 =
     | Rotate2 ℝ SymbolicObj2
     | Transform2 (M33 ℝ) SymbolicObj2
     -- Lifting common objects
-    | Shared2 (SharedObj SymbolicObj2 ℝ2)
+    | Shared2 (SharedObj SymbolicObj2 V2 ℝ)
     deriving (Generic)
 
 instance Show SymbolicObj2 where
   showsPrec = flip $ \case
     -- NB: The False here is the centering argument, which has already been
     -- transformed into a translate. The 'Square' constructor itself is never
     -- centered.
-    Square sz  -> showCon "square"    @| False @| sz
-    Circle r      -> showCon "circle" @| r
-    Polygon ps -> showCon "polygon"   @| ps
-    Rotate2 v obj -> showCon "rotate" @| v     @| obj
+    Square sz        -> showCon "square"     @| False @| sz
+    Circle r         -> showCon "circle"     @| r
+    Polygon ps       -> showCon "polygon"    @| ps
+    Rotate2 v obj    -> showCon "rotate"     @| v     @| obj
     Transform2 m obj -> showCon "transform2" @| m     @| obj
     Shared2 obj   -> flip showsPrec obj
 
@@ -310,7 +310,7 @@ data SymbolicObj3 =
     | Extrude SymbolicObj2 ℝ
     | ExtrudeM
         (Either ℝ (ℝ -> ℝ))   -- twist
-        ExtrudeMScale        -- scale
+        ExtrudeMScale         -- scale
         (Either ℝ2 (ℝ -> ℝ2)) -- translate
         SymbolicObj2          -- object to extrude
         (Either ℝ (ℝ2 -> ℝ))  -- height to extrude to
@@ -320,7 +320,7 @@ data SymbolicObj3 =
         (Either ℝ  (ℝ -> ℝ )) -- rotate
         SymbolicObj2          -- object to extrude
     | ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
-    | Shared3 (SharedObj SymbolicObj3 ℝ3)
+    | Shared3 (SharedObj SymbolicObj3 V3 ℝ)
     deriving (Generic)
 
 instance Show SymbolicObj3 where

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -78,7 +78,7 @@ bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]"
 
 ------------------------------------------------------------------------------
 -- | Build the common combinators.
-buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader ℝ Builder
+buildShared :: forall obj f a. (Build obj, VectorStuff (f a)) => SharedObj obj f a -> Reader ℝ Builder
 
 buildShared Empty = call "union" [] []
 

Graphics/Implicit/ObjectUtil/GetBoxShared.hs

@@ -127,8 +127,8 @@ outsetBox r (a, b) = (a - uniformV r, b + uniformV r)
 -- Get a box around the given object.
 getBoxShared
     :: forall obj f a
-     .  ( Applicative f, Object obj (f a), VectorStuff (f a), Eq (f a), ComponentWiseMultable (f a), Fractional a, Metric f)
-    => SharedObj 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)
 -- Primitives
 getBoxShared Empty = emptyBox

Graphics/Implicit/ObjectUtil/GetImplicitShared.hs

@@ -38,13 +38,13 @@ normalize v =
 -- Get a function that describes the surface of the object.
 getImplicitShared
     :: forall obj f
-     . ( Object obj (f ℝ)
+     . ( Object obj f ℝ
        , VectorStuff (f ℝ)
        , ComponentWiseMultable (f ℝ)
        , Metric f
        )
     => ObjectContext
-    -> SharedObj obj (f ℝ)
+    -> SharedObj obj f ℝ
     -> f ℝ
     -> ℝ
 getImplicitShared _ Empty = const infty

Graphics/Implicit/Primitives.hs

@@ -50,7 +50,7 @@ module Graphics.Implicit.Primitives (
                                      Object
                                     ) where
 
-import Prelude(abs, (<), otherwise, id, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($))
+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,
@@ -104,15 +104,15 @@ sphere ::
 
 sphere = Sphere
 
--- | A rectangular prism, with rounded corners.
+-- | A rectangular prism
 rect3
     :: ℝ3             -- ^ Bottom.. corner
     -> ℝ3             -- ^ Top right... corner
     -> SymbolicObj3   -- ^ Resuting cube
 
 rect3 xyz1 xyz2 = translate xyz1 $ Cube $ xyz2 - xyz1
 
--- | A rectangular prism, with rounded corners.
+-- | A cube
 cube
     :: Bool           -- ^ Centered?
     -> ℝ3             -- ^ Size
@@ -148,23 +148,23 @@ circle ::
 
 circle   = Circle
 
--- | A rectangle, with rounded corners.
+-- | A rectangle
 rect
     :: ℝ2           -- ^ Bottom left corner
     -> ℝ2           -- ^ Top right corner
     -> SymbolicObj2 -- ^ Resulting square
 
 rect xy1 xy2 = translate xy1 $ Square $ xy2 - xy1
 
--- | A rectangle, with rounded corners.
+-- | A square
 square
     :: Bool         -- ^ Centered?
     -> ℝ2           -- ^ Size
     -> SymbolicObj2 -- ^ Resulting square (bottom right = (0,0) )
 square False size = Square size
 square True  size = translate (fmap (negate . (/ 2)) size) $ Square size
 
--- | A 2D polygon, with rounded corners.
+-- | A 2D polygon
 polygon
     :: [ℝ2]          -- ^ Verticies of the polygon
     -> SymbolicObj2  -- ^ Resulting polygon
@@ -178,61 +178,67 @@ polygon = Polygon
 -- instead provided by 'rotate' and 'rotate3'.
 --
 -- Library users shouldn't need to provide new instances of this class.
-class Num vec => Object obj vec
-      | obj -> vec where
-
+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 vec)
+    _Shared :: Prism' obj (SharedObj obj f a)
 
     -- | Get the bounding box an object
     getBox ::
         obj           -- ^ Object to get box of
-        -> (vec, vec) -- ^ Bounding box
+        -> (f a, f a) -- ^ Bounding box
 
     -- | Get the implicit function for an object
     getImplicit'
         :: ObjectContext
         -> obj         -- ^ Object to get implicit function of
-        -> (vec -> ℝ)  -- ^ Implicit function
+        -> (f a -> a)  -- ^ Implicit function
 
 -- | Get the implicit function for an object
 getImplicit
-    :: Object obj vec
+    :: Object obj f a
     => obj         -- ^ Object to get implicit function of
-    -> (vec -> ℝ)  -- ^ Implicit function
+    -> (f a -> a)  -- ^ Implicit function
 getImplicit = getImplicit' defaultObjectContext
 
 -- | A pattern that abstracts over 'Shared2' and 'Shared3'.
-pattern Shared :: Object obj vec => SharedObj obj vec -> obj
+pattern Shared :: (Object obj f a) => SharedObj obj f a -> obj
 pattern Shared v <- (preview _Shared -> Just v)
   where
     Shared v = _Shared # v
 
 -- | Translate an object by a vector of appropriate dimension.
 translate
-    :: Object obj vec
-    => vec  -- ^ Vector to translate by
+    :: Object obj f a
+    => f a  -- ^ Vector to translate by
     -> obj  -- ^ Object to translate
     -> obj  -- ^ Resulting object
+translate 0 s = s
 translate _ s@(Shared Empty) = s
 translate _ s@(Shared Full) = s
 translate v1 (Shared (Translate v2 s)) = translate (v1 + v2) s
 translate v s = Shared $ Translate v s
 
 -- | Scale an object
 scale
-    :: Object obj vec
-    => vec  -- ^ Amount to scale by
+    :: Object obj f a
+    => f a  -- ^ Amount to scale by
     -> obj  -- ^ Object to scale
     -> obj  -- ^ Resulting scaled object
+scale 1 s = s
 scale _ s@(Shared Empty) = s
 scale v1 (Shared (Scale v2 s)) = scale (v1 * v2) s
 scale v s = Shared $ Scale v s
 
 -- | Complement an Object
 complement
-    :: Object obj vec
+    :: Object obj f a
     => obj  -- ^ Object to complement
     -> obj  -- ^ Result
 complement (Shared Empty) = Shared Full
@@ -241,11 +247,11 @@ complement (Shared (Complement s)) = s
 complement s = Shared $ Complement s
 
 -- | The object that fills no space
-emptySpace :: Object obj vec => obj
+emptySpace :: Object obj f a => obj
 emptySpace = Shared Empty
 
 -- | The object that fills the entire space
-fullSpace :: Object obj vec => obj
+fullSpace :: Object obj f a => obj
 fullSpace = Shared Full
 
 -- | Set the current object-rounding value for the given object. The rounding
@@ -260,15 +266,15 @@ fullSpace = Shared Full
 -- @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 vec => ℝ -> obj -> obj
+withRounding :: Object obj f a => ℝ -> obj -> obj
 withRounding 0 = id
 withRounding r = Shared . WithRounding r
 
 -- | Mirror an object across the hyperplane whose normal is a given
 -- vector.
 mirror
-    :: Object obj vec
-    => vec  -- ^ Vector defining the hyperplane
+    :: Object obj f a
+    => f a  -- ^ Vector defining the hyperplane
     -> obj  -- ^ Object to mirror
     -> obj  -- ^ Resulting object
 mirror _ s@(Shared Empty) = s
@@ -277,7 +283,7 @@ mirror v s = Shared $ Mirror v s
 
 -- | Outset of an object.
 outset
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ distance to outset
     -> obj   -- ^ object to outset
     -> obj   -- ^ resulting object
@@ -288,7 +294,7 @@ outset v s = Shared $ Outset v s
 
 -- | Make a shell of an object.
 shell
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ width of shell
     -> obj   -- ^ object to take shell of
     -> obj   -- ^ resulting shell
@@ -298,7 +304,7 @@ shell v s = Shared $ Shell v s
 
 -- | Rounded union
 unionR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ      -- ^ The radius (in mm) of rounding
     -> [obj]  -- ^ objects to union
     -> obj    -- ^ Resulting object
@@ -308,7 +314,7 @@ unionR r ss = Shared $ UnionR r ss
 
 -- | Rounded difference
 differenceR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ The radius (in mm) of rounding
     -> obj   -- ^ Base object
     -> [obj] -- ^ Objects to subtract from the base
@@ -320,7 +326,7 @@ differenceR r s ss = Shared $ DifferenceR r s ss
 
 -- | Rounded minimum
 intersectR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ The radius (in mm) of rounding
     -> [obj] -- ^ Objects to intersect
     -> obj   -- ^ Resulting object
@@ -329,33 +335,33 @@ intersectR _ [s] = s
 intersectR r ss = Shared $ IntersectR r ss
 
 implicit
-    :: Object obj vec
-    => (vec -> ℝ)     -- ^ Implicit function
-    -> (vec, vec)  -- ^ Bounding box
+    :: Object obj f a
+    => (f a -> a)  -- ^ Implicit function
+    -> (f a, f a)  -- ^ Bounding box
     -> obj         -- ^ Resulting object
 implicit a b = Shared $ EmbedBoxedObj (a, b)
 
-instance Object SymbolicObj2 ℝ2 where
+instance Object SymbolicObj2 V2 ℝ where
   _Shared = prism' Shared2 $ \case
     Shared2 x -> Just x
     _         -> Nothing
   getBox       = getBox2
   getImplicit' = getImplicit2
 
-instance Object SymbolicObj3 ℝ3 where
+instance Object SymbolicObj3 V3 ℝ where
   _Shared = prism' Shared3 $ \case
     Shared3 x -> Just x
     _         -> Nothing
   getBox       = getBox3
   getImplicit' = getImplicit3
 
-union :: Object obj vec => [obj] -> obj
+union :: Object obj f a => [obj] -> obj
 union = unionR 0
 
-difference :: Object obj vec => obj -> [obj] -> obj
+difference :: Object obj f a => obj -> [obj] -> obj
 difference = differenceR 0
 
-intersect :: Object obj vec => [obj] -> obj
+intersect :: Object obj f a => [obj] -> obj
 intersect = intersectR 0
 
 -- 3D operations
@@ -395,6 +401,7 @@ extrudeOnEdgeOf = ExtrudeOnEdgeOf
 -- | Rotate a 3D object via an Euler angle, measured in radians, along the
 -- world axis.
 rotate3 :: ℝ3 -> SymbolicObj3 -> SymbolicObj3
+rotate3 0 = id
 rotate3 (V3 pitch roll yaw)
   = Rotate3
   $ axisAngle (V3 0 0 1) yaw
@@ -413,6 +420,7 @@ rotate3V
     -> ℝ3  -- ^ Axis of rotation
     -> SymbolicObj3
     -> SymbolicObj3
+rotate3V 0 _ = id
 rotate3V w xyz = Rotate3 $ axisAngle xyz w
 
 -- | Transform a 3D object using a 4x4 matrix representing affine transformation