From aab84f17cd690d7530262c8ccd12dd8978525e2f Mon Sep 17 00:00:00 2001 From: sorki Date: Thu, 4 Jan 2024 06:24:32 +0100 Subject: [PATCH] Flip `extrude` arguments Closes #451 --- CHANGELOG.md | 3 +++ Graphics/Implicit/Canon.hs | 6 +++--- Graphics/Implicit/Definitions.hs | 4 ++-- Graphics/Implicit/Export/SymbolicFormats.hs | 2 +- Graphics/Implicit/ExtOpenScad/Primitives.hs | 4 ++-- Graphics/Implicit/ObjectUtil/GetBox3.hs | 2 +- Graphics/Implicit/ObjectUtil/GetImplicit3.hs | 2 +- Graphics/Implicit/Primitives.hs | 4 ++-- tests/GoldenSpec/Spec.hs | 2 +- tests/Graphics/Implicit/Test/Instances.hs | 2 +- tests/ImplicitSpec.hs | 6 +++--- tests/RewriteSpec.hs | 9 ++++----- 12 files changed, 24 insertions(+), 22 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bc1f25f7..e404b9da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,8 @@ # Version [next](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.4.1.0...master) (202Y-MM-DD) +* 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) + * Other changes * Fixing `shell` so that it doesn't increase the outside dimentions of objects. * Fixing an issue with bounding boxes for infinite functions. [#412](https://github.com/Haskell-Things/ImplicitCAD/issues/412) diff --git a/Graphics/Implicit/Canon.hs b/Graphics/Implicit/Canon.hs index 6e19f5a2..31897ceb 100644 --- a/Graphics/Implicit/Canon.hs +++ b/Graphics/Implicit/Canon.hs @@ -177,7 +177,7 @@ fmapObj3 f _ _ (Torus r1 r2) = f $ Torus r1 r2 fmapObj3 f _ _ (Ellipsoid a b c) = f $ Ellipsoid a b c fmapObj3 f g s (Rotate3 q o) = f $ Rotate3 q (fmapObj3 f g s o) fmapObj3 f g s (Transform3 m o) = f $ Transform3 m (fmapObj3 f g s o) -fmapObj3 f g s (Extrude o2 h) = f $ Extrude (fmapObj2 g f s o2) h +fmapObj3 f g s (Extrude h o2) = f $ Extrude h (fmapObj2 g f s o2) fmapObj3 f g s (ExtrudeM twist sc tr o2 h) = f (ExtrudeM twist sc tr (fmapObj2 g f s o2) h) fmapObj3 f g s (RotateExtrude angle tr rot o2) = f (RotateExtrude angle tr rot (fmapObj2 g f s o2)) fmapObj3 f g s (ExtrudeOnEdgeOf o2a o2b) = f (ExtrudeOnEdgeOf (fmapObj2 g f s o2a) (fmapObj2 g f s o2b)) @@ -234,7 +234,7 @@ instance EqObj SymbolicObj3 where Cylinder r1a r2a ha =^= Cylinder r1b r2b hb = r1a == r1b && r2a == r2b && ha == hb Rotate3 x a =^= Rotate3 y b = x == y && a =^= b Transform3 x a =^= Transform3 y b = x == y && a =^= b - Extrude a x =^= Extrude b y = x == y && a =^= b + Extrude x a =^= Extrude y b = x == y && a =^= b ExtrudeM (Left twa) ma (Left ta) a (Left ha) =^= @@ -305,7 +305,7 @@ canon3 :: SymbolicObj3 -> SymbolicObj3 canon3 (Cube v) | hasZeroComponent v = emptySpace canon3 (Sphere 0) = emptySpace canon3 (Cylinder 0 _ _) = emptySpace -canon3 (Extrude _o2 0) = emptySpace +canon3 (Extrude 0 _o2) = emptySpace canon3 (Torus _ 0) = emptySpace canon3 (Ellipsoid 0 _ _) = emptySpace canon3 (Ellipsoid _ 0 _) = emptySpace diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index acc3a528..2bb86ad9 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/Graphics/Implicit/Definitions.hs @@ -332,7 +332,7 @@ data SymbolicObj3 = | Rotate3 (Quaternion ℝ) SymbolicObj3 | Transform3 (M44 ℝ) SymbolicObj3 -- 2D based - | Extrude SymbolicObj2 ℝ + | Extrude ℝ SymbolicObj2 | ExtrudeM (Either ℝ (ℝ -> ℝ)) -- twist ExtrudeMScale -- scale @@ -363,7 +363,7 @@ instance Show SymbolicObj3 where showCon "cylinder2" @| r1 @| r2 @| h Rotate3 qd s -> showCon "rotate3" @| quaternionToEuler qd @| s Transform3 m s -> showCon "transform3" @| m @| s - Extrude s d2 -> showCon "extrude" @| s @| d2 + Extrude d2 s -> showCon "extrude" @| d2 @| s ExtrudeM edfdd e ep_ddfdp_dd s edfp_ddd -> showCon "extrudeM" @|| edfdd @| e @|| ep_ddfdp_dd @| s @|| edfp_ddd RotateExtrude d ep_ddfdp_dd edfdd s -> diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs index be312679..3ee866e1 100644 --- a/Graphics/Implicit/Export/SymbolicFormats.hs +++ b/Graphics/Implicit/Export/SymbolicFormats.hs @@ -145,7 +145,7 @@ buildS3 (Transform3 m obj) = ((\x -> "["<>x<>"]") . fold . intersperse "," . fmap bf . toList <$> toList m) [buildS3 obj] -buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj] +buildS3 (Extrude h obj) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj] -- FIXME: handle scale, center. buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index 7c88de08..b81f3cf3 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -261,7 +261,7 @@ cylinder = moduleWithoutSuite "cylinder" $ \_ _ -> do then let obj2 = if sides < 0 then Prim.circle r else Prim.polygon [V2 (r*cos θ) (r*sin θ) | θ <- [2*pi*fromℕtoℝ n/fromℕtoℝ sides | n <- [0 .. sides - 1]]] - obj3 = Prim.extrude obj2 dh + obj3 = Prim.extrude dh obj2 in shift obj3 else shift $ Prim.cylinder2 r1 r2 dh @@ -533,7 +533,7 @@ extrude = moduleWithSuite "linear_extrude" $ \_ children -> do pure $ pure $ obj2UpMap ( \obj -> case height of Left constHeight | isTwistID && isScaleID scaleArg && isTransID -> - shiftAsNeeded $ Prim.withRounding r $ Prim.extrude obj constHeight + shiftAsNeeded $ Prim.withRounding r $ Prim.extrude constHeight obj _ -> shiftAsNeeded $ Prim.withRounding r $ Prim.extrudeM twistArg scaleArg translateArg obj height' ) children diff --git a/Graphics/Implicit/ObjectUtil/GetBox3.hs b/Graphics/Implicit/ObjectUtil/GetBox3.hs index 37ffbf8d..5b613757 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox3.hs +++ b/Graphics/Implicit/ObjectUtil/GetBox3.hs @@ -48,7 +48,7 @@ getBox3 (Transform3 m symbObj) = in pointsBox $ Linear.normalizePoint . (m Linear.!*) . Linear.point <$> corners box -- Misc -- 2D Based -getBox3 (Extrude symbObj h) = (V3 x1 y1 0, V3 x2 y2 h) +getBox3 (Extrude h symbObj) = (V3 x1 y1 0, V3 x2 y2 h) where (V2 x1 y1, V2 x2 y2) = getBox2 symbObj getBox3 (ExtrudeOnEdgeOf symbObj1 symbObj2) = diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs index ed25b828..cba7c23a 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs +++ b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs @@ -45,7 +45,7 @@ getImplicit3 ctx (Rotate3 q symbObj) = getImplicit3 ctx (Transform3 m symbObj) = getImplicit3 ctx symbObj . Linear.normalizePoint . (Linear.inv44 m Linear.!*) . Linear.point -- 2D Based -getImplicit3 ctx (Extrude symbObj h) = +getImplicit3 ctx (Extrude h symbObj) = let obj = getImplicit symbObj in diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs index 84801150..876d717e 100644 --- a/Graphics/Implicit/Primitives.hs +++ b/Graphics/Implicit/Primitives.hs @@ -390,8 +390,8 @@ intersect = intersectR 0 -- | Extrude a 2d object upwards. The current object-rounding value set by -- 'withRounding' is used to round the caps, but is not used by the 2D object. extrude - :: SymbolicObj2 - -> ℝ -- ^ Extrusion height + :: ℝ -- ^ Extrusion height + -> SymbolicObj2 -> SymbolicObj3 extrude = Extrude diff --git a/tests/GoldenSpec/Spec.hs b/tests/GoldenSpec/Spec.hs index 03cae0c0..939b7592 100644 --- a/tests/GoldenSpec/Spec.hs +++ b/tests/GoldenSpec/Spec.hs @@ -274,5 +274,5 @@ spec = describe "golden tests" $ do ] test_solid :: ℝ -> SymbolicObj3 - test_solid k = extrude (test_shape k) 7 + test_solid k = extrude 7 (test_shape k) in test_solid 2 diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs index 7bac9cac..3188fb72 100644 --- a/tests/Graphics/Implicit/Test/Instances.hs +++ b/tests/Graphics/Implicit/Test/Instances.hs @@ -151,7 +151,7 @@ instance Arbitrary SymbolicObj3 where [ rotate3 <$> arbitrary <*> decayArbitrary 2 , rotate3V <$> arbitrary <*> arbitrary <*> decayArbitrary 2 , transform3 <$> arbitraryInvertibleM44 <*> decayArbitrary 2 - , extrude <$> decayArbitrary 2 <*> arbitraryPos + , extrude <$> arbitraryPos <*> decayArbitrary 2 , Shared3 <$> arbitrary ] <> small where diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs index d998a90a..7d460f4f 100644 --- a/tests/ImplicitSpec.hs +++ b/tests/ImplicitSpec.hs @@ -8,7 +8,7 @@ module ImplicitSpec (spec) where -import Prelude (Fractional, fmap, pure, negate, (+), Show, Monoid, mempty, (*), (/), (<>), (-), (/=), ($), (.), pi, id) +import Prelude (Fractional, flip, fmap, pure, negate, (+), Show, Monoid, mempty, (*), (/), (<>), (-), (/=), ($), (.), pi, id) import Test.Hspec (describe, parallel, Spec) import Graphics.Implicit ( difference, @@ -273,8 +273,8 @@ transform3dSpec = describe "3d transform" $ do misc3dSpec :: Spec misc3dSpec = describe "misc 3d tests" $ do prop "object-rounding value doesn't jump from 3d to 2d" $ \r obj -> - withRounding r . extrude obj - =~= withRounding r . extrude (withRounding 0 obj) + withRounding r . flip extrude obj + =~= withRounding r . flip extrude (withRounding 0 obj) prop "cylinder with negative height is a flipped cylinder with positive height" $ \r1 r2 h -> cylinder2 r1 r2 h =~= mirror (V3 0 0 1) (cylinder2 r1 r2 (-h)) diff --git a/tests/RewriteSpec.hs b/tests/RewriteSpec.hs index d212b366..214b1d90 100644 --- a/tests/RewriteSpec.hs +++ b/tests/RewriteSpec.hs @@ -13,7 +13,6 @@ import Prelude , Double , Eq((==)) , Show - , flip , id , pure , ($) @@ -127,13 +126,13 @@ sym32Sample :: SymbolicObj3 sym32Sample = translate 1 . rotate3 0 - $ extrude sym2Sample 2 + $ extrude 2 sym2Sample sym32Expected :: SymbolicObj3 sym32Expected = scale 1 . rotate3 0 - $ extrude sym2Expected 2 + $ extrude 2 sym2Expected spec :: Spec spec = @@ -195,9 +194,9 @@ spec = c3 (translate 1 $ scale 0 $ translate (-1) - $ flip extrude 1 + $ extrude 1 $ translate 1 $ scale 0 $ translate (-1) $ circle 1 - ) `shouldBe` extrude (circle 1) 1 + ) `shouldBe` extrude 1 (circle 1)