diff --git a/Graphics/Implicit.hs b/Graphics/Implicit.hs index e4a2c8ff..c488fd5e 100644 --- a/Graphics/Implicit.hs +++ b/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) diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index 2aaa7a75..c9c8b5e8 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/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 diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs index c57db226..b2a833d6 100644 --- a/Graphics/Implicit/Export/SymbolicFormats.hs +++ b/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] diff --git a/Graphics/Implicit/MathUtil.hs b/Graphics/Implicit/MathUtil.hs index b1046e0d..4b389da7 100644 --- a/Graphics/Implicit/MathUtil.hs +++ b/Graphics/Implicit/MathUtil.hs @@ -2,17 +2,19 @@ -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- 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 + + diff --git a/Graphics/Implicit/ObjectUtil/GetBox2.hs b/Graphics/Implicit/ObjectUtil/GetBox2.hs index 99676987..d1f9df5f 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox2.hs +++ b/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 diff --git a/Graphics/Implicit/ObjectUtil/GetBox3.hs b/Graphics/Implicit/ObjectUtil/GetBox3.hs index b82bbe9c..96f15572 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox3.hs +++ b/Graphics/Implicit/ObjectUtil/GetBox3.hs @@ -7,11 +7,12 @@ 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. @@ -19,6 +20,15 @@ import Data.VectorSpace ((^-^), (^+^)) 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 diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs index bb12b4e0..546d959b 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs +++ b/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 diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs index 54f28195..56205f04 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs +++ b/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 diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs index a7bc4be7..d77fbaa7 100644 --- a/Graphics/Implicit/Primitives.hs +++ b/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