Add support for mirroring

Graphics/Implicit.hs

@@ -19,6 +19,7 @@ module Graphics.Implicit (
   P.Object
     ( P.translate,
       P.scale,
+      P.mirror,
       P.complement,
       P.unionR,
       P.intersectR,
@@ -81,7 +82,7 @@ import Prelude(FilePath, IO)
 
 -- The primitive objects, and functions for manipulating them.
 -- MAYBEFIXME: impliment slice operation, regularPolygon and zsurface primitives.
-import Graphics.Implicit.Primitives as P (cubeR, squareR, translate, scale, complement, union, intersect, difference, unionR, intersectR, differenceR, shell, extrudeR, extrudeRM, extrudeOnEdgeOf, sphere, rect3R, circle, cylinder, cylinder2, rectR, polygonR, rotateExtrude, rotate3, rotate3V, pack3, rotate, pack2, implicit, Object)
+import Graphics.Implicit.Primitives as P (rectR, rect3R, translate, scale, mirror, complement, union, intersect, difference, unionR, intersectR, differenceR, shell, extrudeR, extrudeRM, extrudeOnEdgeOf, sphere, cubeR, circle, cylinder, cylinder2, squareR, polygonR, rotateExtrude, rotate3, rotate3V, pack3, rotate, pack2, implicit, Object)
 
 -- The Extended OpenScad interpreter.
 import Graphics.Implicit.ExtOpenScad as E (runOpenscad)

Graphics/Implicit/Definitions.hs

@@ -47,6 +47,7 @@ module Graphics.Implicit.Definitions (
         Translate2,
         Scale2,
         Rotate2,
+        Mirror2,
         Shell2,
         Outset2,
         EmbedBoxedObj2),
@@ -62,6 +63,7 @@ module Graphics.Implicit.Definitions (
         Scale3,
         Rotate3,
         Rotate3V,
+        Mirror3,
         Shell3,
         Outset3,
         EmbedBoxedObj3,
@@ -259,6 +261,7 @@ data SymbolicObj2 =
     | Translate2 ℝ2 SymbolicObj2
     | Scale2 ℝ2 SymbolicObj2
     | Rotate2 ℝ SymbolicObj2
+    | Mirror2 ℝ2 SymbolicObj2 -- mirror across the line whose normal is defined by the R2
     -- Boundary mods
     | Outset2 ℝ SymbolicObj2
     | Shell2 ℝ SymbolicObj2
@@ -290,6 +293,7 @@ data SymbolicObj3 =
     | Scale3 ℝ3 SymbolicObj3
     | Rotate3 ℝ3 SymbolicObj3
     | Rotate3V ℝ ℝ3 SymbolicObj3
+    | Mirror3 ℝ3 SymbolicObj3  -- mirror across the plane whose normal is the R3
     -- Boundary mods
     | Outset3 ℝ SymbolicObj3
     | Shell3 ℝ SymbolicObj3

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -8,9 +8,9 @@
 -- output SCAD code, AKA an implicitcad to openscad converter.
 module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
 
-import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))
+import Prelude(fmap, Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))
 
-import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(SquareR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(CubeR, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf), isScaleID)
+import Graphics.Implicit.Definitions(ℝ2, ℝ3, ℝ, SymbolicObj2(SquareR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Mirror2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(CubeR, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Mirror3, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf), isScaleID)
 import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)
 
 import Control.Monad.Reader (Reader, runReader, ask)
@@ -49,6 +49,12 @@ call = callToken ("[", "]")
 callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
 callNaked = callToken ("", "")
 
+bvect3 :: ℝ3 -> Builder
+bvect3 (x, y, z) = "[" <> fold (intersperse "," [bf x, bf y, bf z]) <> "]"
+
+bvect2 :: ℝ2 -> Builder
+bvect2 (x, y) = "[" <> fold (intersperse "," [bf x, bf y]) <> "]"
+
 -- | First, the 3D objects.
 buildS3 :: SymbolicObj3 -> Reader ℝ Builder
 
@@ -76,9 +82,9 @@ buildS3 (Scale3 (x,y,z) obj) = call "scale" [bf x, bf y, bf z] [buildS3 obj]
 
 buildS3 (Rotate3 (x,y,z) obj) = call "rotate" [bf (rad2deg x), bf (rad2deg y), bf (rad2deg z)] [buildS3 obj]
 
-buildS3 (Rotate3V a v obj) = callNaked "rotate" [ "a=" <> bf (rad2deg a), "v=" <> bvect v ] [buildS3 obj]
-    where
-    bvect (x, y, z) = "[" <> fold (intersperse "," [bf x, bf y, bf z]) <> "]"
+buildS3 (Rotate3V a v obj) = callNaked "rotate" [ "a=" <> bf (rad2deg a), "v=" <> bvect3 v ] [buildS3 obj]
+
+buildS3 (Mirror3 v obj) = callNaked "mirror" [ "v=" <> bvect3 v ] [buildS3 obj]
 
 buildS3 (Outset3 r obj) | r == 0 = call "outset" [] [buildS3 obj]
 
@@ -128,8 +134,7 @@ buildS2 (SquareR r (w,h)) | r == 0 = call "cube" [bf w, bf h] []
 
 buildS2 (Circle r) = call "circle" [bf r] []
 
-buildS2 (PolygonR r points) | r == 0 = call "polygon" [buildVector [x,y] | (x,y) <- points] []
-    where buildVector comps = "[" <> fold (intersperse "," $  bf <$> comps) <> "]"
+buildS2 (PolygonR r points) | r == 0 = call "polygon" (fmap bvect2 points) []
 
 buildS2 (Complement2 obj) = call "complement" [] [buildS2 obj]
 
@@ -145,6 +150,8 @@ buildS2 (Scale2 (x,y) obj)     = call "scale" [bf x, bf y] [buildS2 obj]
 
 buildS2 (Rotate2 r obj)     = call "rotate" [bf (rad2deg r)] [buildS2 obj]
 
+buildS2 (Mirror2 v obj) = callNaked "mirror" [ "v=" <> bvect2 v ] [buildS2 obj]
+
 buildS2 (Outset2 r obj) | r == 0 = call "outset" [] [buildS2 obj]
 
 buildS2 (Shell2 r obj) | r == 0 =  call "shell" [] [buildS2 obj]

Graphics/Implicit/MathUtil.hs

@@ -2,17 +2,19 @@
 -- Copyright (C) 2014 2015 2016, Julia Longtin ([email protected])
 -- Released under the GNU AGPLV3+, see LICENSE
 
+{-# LANGUAGE FlexibleContexts #-}
+
 -- A module of math utilities.
-module Graphics.Implicit.MathUtil (rmax, rmaximum, rminimum, distFromLineSeg, pack, box3sWithin) where
+module Graphics.Implicit.MathUtil (rmax, rmaximum, rminimum, distFromLineSeg, pack, box3sWithin, reflect) where
 
 -- Explicitly include what we need from Prelude.
-import Prelude (Bool, Ordering, (>), (<), (+), ($), (/), otherwise, not, (||), (&&), abs, (-), (*), sin, asin, pi, max, sqrt, min, compare, (<=), fst, snd, (<>), head, flip, maximum, minimum, (==))
+import Prelude (Fractional, Num, Bool, Ordering, (>), (<), (+), ($), (/), otherwise, not, (||), (&&), abs, (-), (*), sin, asin, pi, max, sqrt, min, compare, (<=), fst, snd, (<>), head, flip, maximum, minimum, (==))
 
 import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, Box2, (⋅))
 
 import Data.List (sort, sortBy, (!!))
 
-import Data.VectorSpace (magnitude, normalized, (^-^), (^+^), (*^))
+import Data.VectorSpace ((<.>), Scalar, (^*), InnerSpace, magnitude, normalized, (^-^), (^+^), (*^))
 
 -- get the distance between two points.
 import Data.AffineSpace (distance)
@@ -143,3 +145,16 @@ pack (dx, dy) sep objs = packSome sortedObjs (dx, dy)
             else
                 tmap2 (presObj:) $ packSome otherBoxedObjs box
         packSome [] _ = ([], [])
+
+
+-- | Reflect a vector across a hyperplane defined by its normal vector.
+--
+-- From https://en.wikipedia.org/wiki/Reflection_(mathematics)#Reflection_through_a_hyperplane_in_n_dimensions
+reflect
+    :: (InnerSpace v, Fractional (Scalar v))
+    => v  -- ^ Mirror axis
+    -> v  -- ^ Vector to transform
+    -> v
+reflect a v = v ^-^ (2 * ((v <.> a) / (a <.> a))) *^ a
+
+

Graphics/Implicit/ObjectUtil/GetBox2.hs

@@ -8,11 +8,12 @@ import Prelude(Bool, Fractional, Eq, (==), (||), unzip, minimum, maximum, ($), f
 
 import Graphics.Implicit.Definitions (ℝ, ℝ2, Box2, (⋯*),
                                       SymbolicObj2(Shell2, Outset2, Circle, Translate2, Rotate2, UnionR2, Scale2, SquareR,
-                                                   PolygonR, Complement2, DifferenceR2, IntersectR2, EmbedBoxedObj2), minℝ)
+                                                   PolygonR, Complement2, DifferenceR2, IntersectR2, EmbedBoxedObj2, Mirror2), minℝ)
 
 import Data.VectorSpace ((^-^), (^+^))
 
 import Data.Fixed (mod')
+import Graphics.Implicit.MathUtil (reflect)
 
 -- | An empty box.
 emptyBox :: Box2
@@ -25,6 +26,7 @@ isEmpty ((a, b), (c, d)) = a==c || b==d
 
 -- | Define a Box2 around all of the given points.
 pointsBox :: [ℝ2] -> Box2
+pointsBox [] = emptyBox
 pointsBox points =
     let
         (xs, ys) = unzip points
@@ -104,6 +106,13 @@ getBox2 (Rotate2 θ symbObj) =
                   , rotate (x2, y1)
                   , rotate (x2, y2)
                   ]
+getBox2 (Mirror2 v symbObj) =
+    let (p1@(x1, y1), p2@(x2, y2)) = getBox2 symbObj
+     in pointsBox [ reflect v p1
+                  , reflect v p2
+                  , reflect v (x1, y2)
+                  , reflect v (x2, y1)
+                  ]
 -- Boundary mods
 getBox2 (Shell2 w symbObj) =
     outsetBox (w/2) $ getBox2 symbObj

Graphics/Implicit/ObjectUtil/GetBox3.hs

@@ -7,18 +7,28 @@ module Graphics.Implicit.ObjectUtil.GetBox3 (getBox3) where
 
 import Prelude(Eq, Bool(False), Fractional, Either (Left, Right), (==), (||), max, (/), (-), (+), fmap, unzip, ($), (<$>), filter, not, (.), unzip3, minimum, maximum, min, (>), (&&), (*), (<), abs, either, error, const, otherwise, take, fst, snd)
 
-import Graphics.Implicit.Definitions (ℝ, Fastℕ, Box3, SymbolicObj3 (CubeR, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Shell3, Outset3, EmbedBoxedObj3, ExtrudeR, ExtrudeOnEdgeOf, ExtrudeRM, RotateExtrude, ExtrudeRotateR), SymbolicObj2 (Translate2, Rotate2, SquareR), ExtrudeRMScale(C1, C2), (⋯*), fromFastℕtoℝ, fromFastℕ, toScaleFn)
+import Graphics.Implicit.Definitions (ℝ3, ℝ, Fastℕ, Box3, SymbolicObj3 (CubeR, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Mirror3, Shell3, Outset3, EmbedBoxedObj3, ExtrudeR, ExtrudeOnEdgeOf, ExtrudeRM, RotateExtrude, ExtrudeRotateR), SymbolicObj2 (Rotate2, SquareR, Translate2), ExtrudeRMScale(C1, C2), (⋯*), fromFastℕtoℝ, fromFastℕ, toScaleFn)
 
 import Graphics.Implicit.ObjectUtil.GetBox2 (getBox2, getBox2R)
 
 import Data.VectorSpace ((^-^), (^+^))
+import Graphics.Implicit.MathUtil (reflect)
 
 -- FIXME: many variables are being ignored here. no rounding for intersect, or difference.. etc.
 
 -- | An empty box.
 emptyBox :: Box3
 emptyBox = ((0,0,0), (0,0,0))
 
+-- | Define a Box3 around all of the given points.
+pointsBox :: [ℝ3] -> Box3
+pointsBox [] = emptyBox
+pointsBox points =
+    let
+        (xs, ys, zs) = unzip3 points
+    in
+        ((minimum xs, minimum ys, minimum zs), (maximum xs, maximum ys, maximum zs))
+
 -- | Is a Box3 empty?
 -- | Really, this checks if it is one dimensional, which is good enough.
 isEmpty :: (Eq a2, Eq a1, Eq a) =>
@@ -98,6 +108,18 @@ getBox3 (Rotate3 (a, b, c) symbObj) =
         ((minimum xs, minimum ys, minimum zs), (maximum xs, maximum ys, maximum zs))
 
 getBox3 (Rotate3V _ v symbObj) = getBox3 (Rotate3 v symbObj)
+getBox3 (Mirror3 v symbObj) =
+    let (p1@(x1, y1, z1), p2@(x2, y2, z2)) = getBox3 symbObj
+     in pointsBox
+          [ reflect v p1
+          , reflect v (x1, y2, z1)
+          , reflect v (x2, y2, z1)
+          , reflect v (x2, y1, z1)
+          , reflect v (x1, y1, z2)
+          , reflect v (x2, y1, z2)
+          , reflect v (x1, y2, z2)
+          , reflect v p2
+          ]
 -- Boundary mods
 getBox3 (Shell3 w symbObj) =
     outsetBox (w/2) $ getBox3 symbObj

Graphics/Implicit/ObjectUtil/GetImplicit2.hs

@@ -6,9 +6,9 @@ module Graphics.Implicit.ObjectUtil.GetImplicit2 (getImplicit2) where
 
 import Prelude(abs, (-), (/), sqrt, (*), (+), mod, length, fmap, (<=), (&&), (>=), (||), odd, ($), (>), filter, (<), minimum, max, cos, sin, tail, (.))
 
-import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, (⋯/), Obj2, SymbolicObj2(SquareR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Shell2, Outset2, EmbedBoxedObj2))
+import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, (⋯/), Obj2, SymbolicObj2(SquareR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Mirror2, Shell2, Outset2, EmbedBoxedObj2))
 
-import Graphics.Implicit.MathUtil (rminimum, rmaximum, distFromLineSeg)
+import Graphics.Implicit.MathUtil (reflect, rminimum, rmaximum, distFromLineSeg)
 
 import Data.VectorSpace ((^-^))
 import Data.List (nub, genericIndex, genericLength)
@@ -81,6 +81,8 @@ getImplicit2 (Rotate2 θ symbObj) =
         obj = getImplicit2 symbObj
     in
         obj ( x*cos θ + y*sin θ, y*cos θ - x*sin θ)
+getImplicit2 (Mirror2 v symbObj) =
+    getImplicit2 symbObj . reflect v
 -- Boundary mods
 getImplicit2 (Shell2 w symbObj) =
     \p -> let

Graphics/Implicit/ObjectUtil/GetImplicit3.hs

@@ -9,10 +9,10 @@ import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max,
 
 import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, ℝ3, (⋯/), Obj3,
                                       SymbolicObj3(Shell3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3,
-                                                   Outset3, CubeR, Sphere, Cylinder, Complement3, EmbedBoxedObj3, Rotate3V,
+                                                   Outset3, CubeR, Sphere, Cylinder, Complement3, EmbedBoxedObj3, Rotate3V, Mirror3,
                                                    ExtrudeR, ExtrudeRM, ExtrudeOnEdgeOf, RotateExtrude, ExtrudeRotateR), fromℕtoℝ, toScaleFn, (⋅), minℝ)
 
-import Graphics.Implicit.MathUtil (rmaximum, rminimum, rmax)
+import Graphics.Implicit.MathUtil (reflect, rmaximum, rminimum, rmax)
 
 import Data.Maybe (fromMaybe, isJust)
 
@@ -98,6 +98,8 @@ getImplicit3 (Rotate3V θ axis symbObj) =
             v ^* cos θ
             - (axis' `cross3` v) ^* sin θ
             + (axis' ^* (axis' ⋅ (v ^* (1 - cos θ))))
+getImplicit3 (Mirror3 v symbObj) =
+    getImplicit3 symbObj . reflect v
 -- Boundary mods
 getImplicit3 (Shell3 w symbObj) =
     let

Graphics/Implicit/Primitives.hs

@@ -9,6 +9,7 @@
 -- A module exporting all of the primitives, and some operations on them.
 module Graphics.Implicit.Primitives (
                                      translate,
+                                     mirror,
                                      scale,
                                      outset,
                                      complement, union, intersect, difference,
@@ -49,6 +50,7 @@ import Graphics.Implicit.Definitions (both, allthree, ℝ, ℝ2, ℝ3, Box2,
                                                    DifferenceR2,
                                                    IntersectR2,
                                                    Translate2,
+                                                   Mirror2,
                                                    Scale2,
                                                    Rotate2,
                                                    Outset2,
@@ -64,6 +66,7 @@ import Graphics.Implicit.Definitions (both, allthree, ℝ, ℝ2, ℝ3, Box2,
                                                    DifferenceR3,
                                                    IntersectR3,
                                                    Translate3,
+                                                   Mirror3,
                                                    Scale3,
                                                    Rotate3,
                                                    Rotate3V,
@@ -199,6 +202,12 @@ class Object obj vec | obj -> vec where
         -> obj   -- ^ Object to translate
         -> obj   -- ^ Resulting object
 
+    -- | Mirror an object across the hyperplane whose normal is a given vector.
+    mirror ::
+        vec      -- ^ Vector defining the hyperplane
+        -> obj   -- ^ Object to mirror
+        -> obj   -- ^ Resulting object
+
     -- | Scale an object
     scale ::
         vec     -- ^ Amount to scale by
@@ -235,6 +244,7 @@ class Object obj vec | obj -> vec where
 
 instance Object SymbolicObj2 ℝ2 where
     translate   = Translate2
+    mirror      = Mirror2
     scale       = Scale2
     complement  = Complement2
     unionR _ [] = mempty
@@ -249,6 +259,7 @@ instance Object SymbolicObj2 ℝ2 where
 
 instance Object SymbolicObj3 ℝ3 where
     translate   = Translate3
+    mirror      = Mirror3
     scale       = Scale3
     complement  = Complement3
     unionR _ [] = mempty