Flip extrude arguments

Closes Haskell-Things#451
sorki · Jan 4, 2024 · b9f8e32 · b9f8e32
1 parent eacfe58
commit b9f8e32
Show file tree

Hide file tree

Showing 13 changed files with 25 additions and 23 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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/programs/implicitsnap.hs b/programs/implicitsnap.hs
@@ -201,7 +201,7 @@ executeAndExport content callback maybeFormat =
               unionWarning    = if null objs
                                 then ""
                                 else " \nWARNING: Multiple objects detected. Adding a Union around them."
-              output3d        = maybe (TL.toStrict . jsTHREE) getOutputHandler3 maybeFormat $ discreteAprox res $ extrude target res
+              output3d        = maybe (TL.toStrict . jsTHREE) getOutputHandler3 maybeFormat $ discreteAprox res $ extrude res target
               output2d        = maybe (TL.toStrict . svg) getOutputHandler2 maybeFormat $ discreteAprox res target
           if fromMaybe "jsTHREE" maybeFormat == "jsTHREE"
             then encodeUtf8 output3d <> callbackF True True w (scadMessages <> unionWarning)

diff --git 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
@@ -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
@@ -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
@@ -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)