Add slice primitive

CHANGELOG.md

@@ -1,7 +1,11 @@
 # Version [next](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.4.1.0...master) (202Y-MM-DD)
 
+* ExtOpenScad interface changes
+  * Added `projection(cut=true)` support [#448](https://github.com/Haskell-Things/ImplicitCAD/pull/448)
+
 * Haskell interface changes
   * `extrude` arguments are now swapped, instead of `extrude obj height` we now have `extrude height obj` [#473](https://github.com/Haskell-Things/ImplicitCAD/issues/473)
+  * Added `slice` primitive [#448](https://github.com/Haskell-Things/ImplicitCAD/pull/448)
 
 * Other changes
   * Fixing `shell` so that it doesn't increase the outside dimentions of objects.

Graphics/Implicit.hs

@@ -45,6 +45,7 @@ module Graphics.Implicit (
   P.rotate,
   P.transform,
   P.pack2,
+  P.slice,
 
   -- * 3D primitive shapes
   P.cube,
@@ -93,8 +94,8 @@ module Graphics.Implicit (
 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 (withRounding, rect, rect3, translate, scale, mirror, complement, union, intersect, difference, unionR, intersectR, differenceR, shell, extrude, extrudeM, extrudeOnEdgeOf, sphere, cube, circle, cylinder, cylinder2, square, polygon, rotateExtrude, rotate3, rotate3V, pack3, transform3, rotate, transform, pack2, implicit, fullSpace, emptySpace, outset, Object)
+-- MAYBEFIXME: regularPolygon and zsurface primitives.
+import Graphics.Implicit.Primitives as P (withRounding, rect, rect3, translate, scale, mirror, complement, union, intersect, difference, unionR, intersectR, differenceR, shell, extrude, extrudeM, extrudeOnEdgeOf, sphere, cube, circle, cylinder, cylinder2, square, slice, polygon, rotateExtrude, rotate3, rotate3V, pack3, transform3, rotate, transform, pack2, implicit, fullSpace, emptySpace, outset, Object)
 
 -- The Extended OpenScad interpreter.
 import Graphics.Implicit.ExtOpenScad as E (runOpenscad)

Graphics/Implicit/Canon.hs

@@ -79,6 +79,7 @@ import Graphics.Implicit.Definitions
       , Shared2
       , Square
       , Transform2
+      , Slice
       )
   , SymbolicObj3
       ( Cube
@@ -158,6 +159,7 @@ fmapObj2 f _ _ (Circle r)       = f $ Circle r
 fmapObj2 f _ _ (Polygon ps)     = f $ Polygon ps
 fmapObj2 f g s (Rotate2 r o)    = f $ Rotate2 r (fmapObj2 f g s o)
 fmapObj2 f g s (Transform2 m o) = f $ Transform2 m (fmapObj2 f g s o)
+fmapObj2 f g s (Slice o)        = f $ Slice (fmapObj3 g f s o)
 fmapObj2 f g s (Shared2 o)      = fmapSharedObj (fmapObj2 f g s) s (Shared2 o)
 
 -- | Map over @SymbolicObj3@ and its underlying shared objects
@@ -223,6 +225,7 @@ instance EqObj SymbolicObj2 where
   Polygon a =^= Polygon b = a == b
   Rotate2 x a =^= Rotate2 y b = x == y && a =^= b
   Transform2 x a =^= Transform2 y b = x == y && a =^= b
+  Slice a =^= Slice b = a =^= b
   Shared2 a =^= Shared2 b = a =^= b
   _ =^= _ = False
 

Graphics/Implicit/Definitions.hs

@@ -50,6 +50,7 @@ module Graphics.Implicit.Definitions (
         Circle,
         Polygon,
         Rotate2,
+        Slice,
         Transform2,
         Shared2),
     SymbolicObj3(
@@ -296,6 +297,8 @@ data SymbolicObj2 =
     -- Simple transforms
     | Rotate2 ℝ SymbolicObj2
     | Transform2 (M33 ℝ) SymbolicObj2
+    -- Slice 3D object by intersecting it with a XY plane to produce 2D outline
+    | Slice SymbolicObj3
     -- Lifting common objects
     | Shared2 (SharedObj SymbolicObj2 V2 ℝ)
     deriving (Generic)
@@ -310,6 +313,7 @@ instance Show SymbolicObj2 where
     Polygon ps       -> showCon "polygon"    @| ps
     Rotate2 v obj    -> showCon "rotate"     @| v     @| obj
     Transform2 m obj -> showCon "transform"  @| m     @| obj
+    Slice o          -> showCon "slice"      @| o
     Shared2 obj   -> flip showsPrec obj
 
 -- | Semigroup under 'Graphic.Implicit.Primitives.union'.

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -12,7 +12,7 @@ module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
 
 import Prelude((.), fmap, Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))
 
-import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
+import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2, Slice), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
 import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)
 
 import Control.Monad.Reader (Reader, runReader, ask)
@@ -193,3 +193,4 @@ buildS2 (Transform2 m obj) =
 
 buildS2 (Square (V2 w h)) = call "square" [bf w, bf h] []
 
+buildS2 (Slice obj) = callNaked "projection" ["cut = true"] [buildS3 obj]

Graphics/Implicit/ExtOpenScad/Primitives.hs

@@ -31,7 +31,7 @@ import Graphics.Implicit.ExtOpenScad.Util.OVal (OTypeMirror, caseOType, divideOb
 import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC)
 
 -- Note the use of a qualified import, so we don't have the functions in this file conflict with what we're importing.
-import qualified Graphics.Implicit.Primitives as Prim (withRounding, sphere, rect3, rect, translate, circle, polygon, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone)
+import qualified Graphics.Implicit.Primitives as Prim (withRounding, sphere, rect3, rect, translate, circle, polygon, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, slice, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone)
 
 import Control.Monad (when, mplus)
 
@@ -70,6 +70,7 @@ primitiveModules =
   , onModIze extrude [([("height", hasDefault), ("center", hasDefault), ("twist", hasDefault), ("scale", hasDefault), ("translate", hasDefault), ("r", hasDefault)], requiredSuite)]
   , onModIze rotateExtrude [([("angle", hasDefault), ("r", hasDefault), ("translate", hasDefault), ("rotate", hasDefault)], requiredSuite)]
   , onModIze shell [([("w", noDefault)], requiredSuite)]
+  , onModIze projection [([("cut", hasDefault)], requiredSuite)]
   , onModIze pack [([("size", noDefault), ("sep", noDefault)], requiredSuite)]
   , onModIze unit [([("unit", noDefault)], requiredSuite)]
   , onModIze mirror [([("x", noDefault), ("y", noDefault), ("z", noDefault)], requiredSuite), ([("v", noDefault)], requiredSuite)]
@@ -574,6 +575,20 @@ shell = moduleWithSuite "shell" $ \_ children -> do
             `doc` "width of the shell..."
     pure $ pure $ objMap (Prim.shell w) (Prim.shell w) children
 
+projection :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
+projection = moduleWithSuite "projection" $ \sourcePosition children -> do
+    example "projection(cut=true) sphere(10);"
+    -- arguments
+    cut :: Bool <- argument "cut"
+            `defaultTo` False
+            `doc` "Cut with a plane at z=0"
+    pure $
+      if cut
+      then pure $ obj3DownMap Prim.slice children
+      else do
+        errorC sourcePosition "projection(cut=false) is not yet implemented"
+        pure children
+
 -- Not a permanent solution! Breaks if can't pack.
 pack :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 pack = moduleWithSuite "pack" $ \sourcePosition children -> do
@@ -705,6 +720,12 @@ obj2UpMap obj2upmod (x:xs) = case x of
     a          -> a                      : obj2UpMap obj2upmod xs
 obj2UpMap _ [] = []
 
+obj3DownMap :: (SymbolicObj3 -> SymbolicObj2) -> [OVal] -> [OVal]
+obj3DownMap obj3downmod (x:xs) = case x of
+    OObj3 obj3 -> OObj2 (obj3downmod obj3) : obj3DownMap obj3downmod xs
+    a          -> a                        : obj3DownMap obj3downmod xs
+obj3DownMap _ [] = []
+
 toInterval :: Bool -> ℝ -> ℝ2
 toInterval center h =
     if center

Graphics/Implicit/ObjectUtil/GetBox2.hs

@@ -8,7 +8,7 @@ module Graphics.Implicit.ObjectUtil.GetBox2 (getBox2, getBox2R) where
 import Prelude(pure, fmap, Eq, (==), (.), (<$>), (||), unzip, minimum, maximum, ($), (/), (-), (+), (*), cos, sin, sqrt, min, max, (<), (<>), pi, atan2, (==), (>), show, (&&), otherwise, error)
 
 import Graphics.Implicit.Definitions
-    ( SymbolicObj2(Square, Circle, Polygon, Rotate2, Transform2, Shared2),
+    ( SymbolicObj2(Square, Circle, Polygon, Rotate2, Slice, Transform2, Shared2),
       SharedObj(IntersectR, Complement, UnionR, DifferenceR),
       Box2,
       ℝ2,
@@ -18,6 +18,7 @@ import Graphics.Implicit.Definitions
 import Data.Fixed (mod')
 
 import Graphics.Implicit.ObjectUtil.GetBoxShared (emptyBox, corners, outsetBox, intersectBoxes, pointsBox, getBoxShared, unionBoxes)
+import {-# SOURCE #-} Graphics.Implicit.Primitives (getBox)
 
 -- To construct vectors of ℝs.
 import Linear (V2(V2), V3(V3))
@@ -29,11 +30,13 @@ getBox2 :: SymbolicObj2 -> Box2
 getBox2 (Square size) = (pure 0, size)
 getBox2 (Circle r) = (pure (-r), pure r)
 getBox2 (Polygon points) = pointsBox points
--- (Rounded) CSG
 -- Simple transforms
 getBox2 (Rotate2 θ symbObj) =
     let rotate (V2 x y) = V2 (x*cos θ - y*sin θ) (x*sin θ + y*cos θ)
      in pointsBox $ fmap rotate $ corners $ getBox2 symbObj
+getBox2 (Slice symObj) =
+  let (V3 x1 y1 _z1, V3 x2 y2 _z2) = getBox symObj
+  in ((V2 x1 y1), (V2 x2 y2))
 getBox2 (Transform2 m symbObj) =
     let box = getBox2 symbObj
         augment (V2 x y) = V3 x y 1

Graphics/Implicit/ObjectUtil/GetImplicit2.hs

@@ -11,7 +11,7 @@ module Graphics.Implicit.ObjectUtil.GetImplicit2 (getImplicit2) where
 import Prelude(cycle, (/=), uncurry, fst, Eq, zip, drop, abs, (-), (/), sqrt, (*), (+), length, fmap, (<=), (&&), (>=), (||), odd, ($), (>), filter, (<), minimum, (.), sin, cos)
 
 import Graphics.Implicit.Definitions
-    ( objectRounding, ObjectContext, SymbolicObj2(Square, Circle, Polygon, Rotate2, Transform2, Shared2), SharedObj (Empty), Obj2, ℝ2, ℝ )
+    ( objectRounding, ObjectContext, SymbolicObj2(Square, Circle, Polygon, Rotate2, Slice, Transform2, Shared2), SharedObj (Empty), Obj2, ℝ2, ℝ )
 
 import Graphics.Implicit.MathUtil
     ( distFromLineSeg, rmaximum )
@@ -21,6 +21,8 @@ import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
 import Linear (V2(V2), V3(V3))
 import qualified Linear
 
+import {-# SOURCE #-} Graphics.Implicit.Primitives (getImplicit)
+
 ------------------------------------------------------------------------------
 -- | Filter out equal consecutive elements in the list. This function will
 -- additionally trim the last element of the list if it's equal to the first.
@@ -59,12 +61,17 @@ getImplicit2 _ (Polygon (scanUniqueCircular -> points@(_:_:_:_))) =
     in
         minimum dists * if isIn then -1 else 1
 getImplicit2 ctx (Polygon _) = getImplicitShared @SymbolicObj2 ctx Empty
--- (Rounded) CSG
+-- Simple transforms
 getImplicit2 ctx (Rotate2 θ symbObj) =
     \(V2 x y) -> let
         obj = getImplicit2 ctx symbObj
     in
         obj $ V2 (x*cos θ + y*sin θ) (y*cos θ - x*sin θ)
+getImplicit2 _ctx (Slice symObj) =
+  let
+      obj = getImplicit symObj
+  in
+    \(V2 x y) -> obj (V3 x y 0)
 getImplicit2 ctx (Transform2 m symbObj) =
     \vin ->
     let

Graphics/Implicit/Primitives.hs

@@ -43,6 +43,7 @@ module Graphics.Implicit.Primitives (
                                      transform3,
                                      pack3,
                                      rotate,
+                                     slice,
                                      transform,
                                      pack2,
                                      implicit,
@@ -77,6 +78,7 @@ import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                                    Circle,
                                                    Polygon,
                                                    Rotate2,
+                                                   Slice,
                                                    Transform2,
                                                    Shared2
                                                   ),
@@ -495,3 +497,9 @@ pack2 (V2 dx dy) sep objs =
             (a, []) -> Just $ union $ fmap (\(V2 x y,obj) -> translate (V2 x y) obj) a
             _ -> Nothing
 
+-- 3D to 2D
+-- Slice 3D object by intersecting it with a XY plane to produce 2D outline
+slice
+    :: SymbolicObj3
+    -> SymbolicObj2
+slice = Slice

tests/Graphics/Implicit/Test/Instances.hs

@@ -41,7 +41,8 @@ import Graphics.Implicit
       rotate3V,
       transform3,
       rotate,
-      transform )
+      transform,
+      slice )
 
 import Graphics.Implicit.Definitions
     ( ExtrudeMScale(C1,C2,Fn),
@@ -127,6 +128,7 @@ instance Arbitrary SymbolicObj2 where
     else oneof $
         [ rotate <$> arbitrary <*> decayArbitrary 2
         , transform <$> arbitraryInvertibleM33 <*> decayArbitrary 2
+        , slice <$> decayArbitrary 2
         , Shared2 <$> arbitrary
         ] <> small
     where