From 11d384a4745a415293538da442512e6d81c07a10 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sun, 22 Oct 2023 12:16:29 +0200 Subject: [PATCH 1/3] Add slice primitive --- Graphics/Implicit.hs | 5 +++-- Graphics/Implicit/Canon.hs | 3 +++ Graphics/Implicit/Definitions.hs | 4 ++++ Graphics/Implicit/Export/SymbolicFormats.hs | 3 ++- Graphics/Implicit/ObjectUtil/GetBox2.hs | 7 +++++-- Graphics/Implicit/ObjectUtil/GetImplicit2.hs | 11 +++++++++-- Graphics/Implicit/Primitives.hs | 8 ++++++++ tests/Graphics/Implicit/Test/Instances.hs | 4 +++- 8 files changed, 37 insertions(+), 8 deletions(-) diff --git a/Graphics/Implicit.hs b/Graphics/Implicit.hs index 81c56794..b63131c2 100644 --- a/Graphics/Implicit.hs +++ b/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) diff --git a/Graphics/Implicit/Canon.hs b/Graphics/Implicit/Canon.hs index 31897ceb..dbd177a1 100644 --- a/Graphics/Implicit/Canon.hs +++ b/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 diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index 2bb86ad9..9685984b 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/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'. diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs index 3ee866e1..662b4467 100644 --- a/Graphics/Implicit/Export/SymbolicFormats.hs +++ b/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] diff --git a/Graphics/Implicit/ObjectUtil/GetBox2.hs b/Graphics/Implicit/ObjectUtil/GetBox2.hs index a86c5459..f4bb1cf2 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox2.hs +++ b/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 diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs index 293f0386..2be52b33 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs +++ b/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 diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs index 876d717e..3be6f4d4 100644 --- a/Graphics/Implicit/Primitives.hs +++ b/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 diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs index 3188fb72..0aaed2d9 100644 --- a/tests/Graphics/Implicit/Test/Instances.hs +++ b/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 From 5888bb4e131ed21d9245fc8f880531dea14f11bb Mon Sep 17 00:00:00 2001 From: sorki Date: Thu, 4 Jan 2024 07:16:12 +0100 Subject: [PATCH 2/3] extopenscad: add projection(cut=true) calling slice --- Graphics/Implicit/ExtOpenScad/Primitives.hs | 23 ++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index b81f3cf3..8832ba0a 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/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 From 26617785eec1e7a7852d9828ea8e5553388f2e58 Mon Sep 17 00:00:00 2001 From: sorki Date: Sat, 6 Jan 2024 15:16:01 +0100 Subject: [PATCH 3/3] CHANGELOG: slice and projection(cut=true) --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e404b9da..62dec941 100644 --- a/CHANGELOG.md +++ b/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.