Mirror3 #73

Closed
wants to merge 2 commits into
from
@@ -102,6 +102,7 @@ data SymbolicObj2 =
| IntersectR2 [SymbolicObj2]
-- Simple transforms
| Translate2 ℝ2 SymbolicObj2
+ | Mirror2 ℝ2 SymbolicObj2
| Scale2 ℝ2 SymbolicObj2
| Rotate2 SymbolicObj2
-- Boundary mods
@@ -125,6 +126,7 @@ data SymbolicObj3 =
| DifferenceR3 [SymbolicObj3]
-- Simple transforms
| Translate3 ℝ3 SymbolicObj3
+ | Mirror3 ℝ3 SymbolicObj3
| Scale3 ℝ3 SymbolicObj3
| Rotate3 (,,) SymbolicObj3
-- Boundary mods
@@ -23,7 +23,7 @@ import qualified Data.Either as Either
import Data.VectorSpace
primitives :: [(String, [OVal] -> ArgParser (IO [OVal]) )]
-primitives = [ sphere, cube, square, cylinder, circle, polygon, union, difference, intersect, translate, scale, rotate, extrude, pack, shell, rotateExtrude ]
+primitives = [ sphere, cube, square, cylinder, circle, polygon, union, difference, intersect, translate, mirror, scale, rotate, extrude, pack, shell, rotateExtrude ]
-- **Exmaple of implementing a module**
-- sphere is a module without a suite named sphere,
@@ -262,6 +262,20 @@ rotate = moduleWithSuite "rotate" $ \children -> do
objMap (id ) (Prim.rotate3 (deg2rad yz, deg2rad xz, 0)) children
) <||> ( \_ -> [] )
+mirror = moduleWithSuite "mirror" $ \children -> do
+ v :: Either ℝ2 ℝ3 <- argument "v"
+ `doc` "vector defining plane to mirror across"
+
+ example "mirror ([2,3]) square([4,5]);"
+ example "mirror ([5,6,7]) cube([1,2,3]);"
+
+ let
+ mirrorObjs plane2 plane3 =
+ objMap (Prim.mirror plane2) (Prim.mirror plane3) children
+
+ return $ return $ case v of
+ Left (x,y) -> mirrorObjs (x,y) (x,y,0.0)
+ Right (x,y,z) -> mirrorObjs (x,y) (x,y,z)
scale = moduleWithSuite "scale" $ \children -> do
@@ -68,6 +68,15 @@ getBox2 (Translate2 v symbObj) =
then ((0,0),(0,0))
else (a^+^v, b^+^v)
+getBox2 (Mirror2 a symbObj) =
+ let
+ (a,b) = getBox2 symbObj
+ mirror p =
+ let c = 2 * (p ⋅ a) / (a ⋅ a)
+ in c *^ a ^-^ p
+ in
+ (mirror a, mirror b)
+
getBox2 (Scale2 s symbObj) =
let
(a,b) = getBox2 symbObj
@@ -79,6 +79,15 @@ getBox3 (Translate3 v symbObj) =
in
(a^+^v, b^+^v)
+getBox3 (Mirror3 a symbObj) =
+ let
+ (a,b) = getBox3 symbObj
+ mirror p =
+ let c = 2 * (p ⋅ a) / (a ⋅ a)
+ in p ^-^ c *^ a
+ in
+ (mirror a, mirror b)
+
getBox3 (Scale3 s symbObj) =
let
(a,b) = getBox3 symbObj
@@ -75,6 +75,15 @@ getImplicit2 (Translate2 v symbObj) =
in
\p -> obj (p ^-^ v)
+getImplicit2 (Mirror2 a symbObj) =
+ let
+ obj = getImplicit2 symbObj
+ in
+ \p ->
+ let
+ c = 2 * (p ⋅ a) / (a ⋅ a)
+ in obj $ c *^ a ^-^ p
+
getImplicit2 (Scale2 s@(sx,sy) symbObj) =
let
obj = getImplicit2 symbObj
@@ -77,6 +77,15 @@ getImplicit3 (Scale3 s@(sx,sy,sz) symbObj) =
in
\p -> k * obj (p ⋯/ s)
+getImplicit3 (Mirror3 a symbObj) =
+ let
+ obj = getImplicit3 symbObj
+ in
+ \p ->
+ let
+ c = 2 * (p ⋅ a) / (a ⋅ a)
+ in obj $ p ^-^ c *^ a
+
getImplicit3 (Rotate3 (yz, xz, xy) symbObj) =
let
obj = getImplicit3 symbObj
@@ -71,6 +71,12 @@ class Object obj vec | obj -> vec where
-> obj -- ^ Object to translate
-> obj -- ^ Resulting object
+ -- | Mirror an object
+ mirror ::
+ vec -- ^ Vector defining plane to mirror across
+ -> obj -- ^ Object to mirror
+ -> obj -- ^ Resulting mirrored object
+
-- | Scale an object
scale ::
vec -- ^ Amount to scale by
@@ -130,6 +136,7 @@ class Object obj vec | obj -> vec where
instance Object SymbolicObj2 ℝ2 where
translate = Translate2
+ mirror = Mirror2
scale = Scale2
complement = Complement2
unionR = UnionR2
@@ -143,6 +150,7 @@ instance Object SymbolicObj2 ℝ2 where
instance Object SymbolicObj3 ℝ3 where
translate = Translate3
+ mirror = Mirror3
scale = Scale3
complement = Complement3
unionR = UnionR3