Merge pull request #367 from isovector/auto-cap

Simplify the Haskell interface to rotateExtrude

Graphics/Implicit/Definitions.hs

@@ -71,8 +71,6 @@ import GHC.Generics (Generic)
 
 import Prelude (Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac)
 
-import Data.Maybe (Maybe)
-
 import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ)
 
 import Graphics.Implicit.IntegralUtil as N (ℕ, fromℕ, toℕ)
@@ -323,7 +321,6 @@ data SymbolicObj3 =
         (Either ℝ (ℝ2 -> ℝ))  -- height to extrude to
     | RotateExtrude
         ℝ                     -- Angle to sweep to
-        (Maybe ℝ)             -- Loop or path (rounded corner)
         (Either ℝ2 (ℝ -> ℝ2)) -- translate
         (Either ℝ  (ℝ -> ℝ )) -- rotate
         SymbolicObj2          -- object to extrude
@@ -348,8 +345,8 @@ instance Show SymbolicObj3 where
     Extrude s d2 -> showCon "extrude" @| s @| d2
     ExtrudeM edfdd e ep_ddfdp_dd s edfp_ddd ->
       showCon "extrudeM" @|| edfdd @| e @|| ep_ddfdp_dd @| s @|| edfp_ddd
-    RotateExtrude d md ep_ddfdp_dd edfdd s ->
-      showCon "rotateExtrude" @| d @| md @|| ep_ddfdp_dd @|| edfdd @| s
+    RotateExtrude d ep_ddfdp_dd edfdd s ->
+      showCon "rotateExtrude" @| d @|| ep_ddfdp_dd @|| edfdd @| s
     ExtrudeOnEdgeOf s s1 ->
       showCon "extrudeOnEdgeOf" @| s @| s1
     Shared3 s -> flip showsPrec s

Graphics/Implicit/ExtOpenScad/Primitives.hs

@@ -15,7 +15,7 @@
 -- Export one set containing all of the primitive modules.
 module Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules) where
 
-import Prelude((.), Either(Left, Right), Bool(True, False), Maybe(Just, Nothing), ($), pure, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, fromInteger, round, (/=), (||), not, null, fmap, (<>), otherwise, error)
+import Prelude((.), Either(Left, Right), Bool(True, False), Maybe(Just, Nothing), ($), pure, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, (/=), (||), not, null, fmap, (<>), otherwise, error)
 
 import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1), fromℕtoℝ, isScaleID)
 
@@ -480,14 +480,9 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \_ children -> do
     r            :: ℝ    <- argument "r"   `defaultTo` 0
     translateArg :: Either ℝ2 (ℝ -> ℝ2) <- argument "translate" `defaultTo` Left (V2 0 0)
     rotateArg    :: Either ℝ  (ℝ -> ℝ ) <- argument "rotate" `defaultTo` Left 0
-    let
-        is360m :: ℝ -> Bool
-        is360m n = 360 * fromInteger (round $ n / 360) /= n
-        cap = is360m totalRot
-            || either ( /= pure 0) (\f -> f 0 /= f totalRot) translateArg
-            || either is360m (\f -> is360m (f 0 - f totalRot)) rotateArg
-        capM = if cap then Just r else Nothing
-    pure $ pure $ obj2UpMap (Prim.rotateExtrude totalRot capM translateArg rotateArg) children
+    pure $ pure $ obj2UpMap ( Prim.withRounding r
+                            . Prim.rotateExtrude totalRot translateArg rotateArg
+                            ) children
 
 shell :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 shell = moduleWithSuite "shell" $ \_ children -> do

Graphics/Implicit/ObjectUtil/GetBox3.hs

@@ -107,7 +107,7 @@ getBox3 (ExtrudeM twist scale translate symbObj height) =
         (V3 (twistXmin + tminx) (twistYmin + tminy) 0, V3 (twistXmax + tmaxx) (twistYmax + tmaxy) h)
 -- Note: Assumes x2 is always greater than x1.
 -- FIXME: Insert the above assumption as an assertion in the type system?
-getBox3 (RotateExtrude _ _ (Left (V2 xshift yshift)) _ symbObj) =
+getBox3 (RotateExtrude _ (Left (V2 xshift yshift)) _ symbObj) =
     let
         (V2 _ y1, V2 x2 y2) = getBox2 symbObj
         r = max x2 (x2 + xshift)
@@ -116,7 +116,7 @@ getBox3 (RotateExtrude _ _ (Left (V2 xshift yshift)) _ symbObj) =
 -- FIXME: magic numbers: 0.1, 1.1, and 11.
 -- FIXME: this may use an approximation, based on sampling functions. generate a warning if the approximation part of this function is used.
 -- FIXME: re-implement the expression system, so this can recieve a function, and determine class (constant, linear)... and implement better forms of this function.
-getBox3 (RotateExtrude rot _ (Right f) rotate symbObj) =
+getBox3 (RotateExtrude rot (Right f) rotate symbObj) =
     let
         samples :: Fastℕ
         samples = 11

Graphics/Implicit/ObjectUtil/GetImplicit3.hs

@@ -5,14 +5,13 @@
 
 module Graphics.Implicit.ObjectUtil.GetImplicit3 (getImplicit3) where
 
-import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, minimum, ($), sin, pi, (.), Bool(True, False), ceiling, floor, pure, (==), otherwise)
+import Prelude ((||), (/=), either, round, fromInteger, Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, minimum, ($), sin, pi, (.), Bool(True, False), ceiling, floor, pure, (==), otherwise)
 
 import Graphics.Implicit.Definitions
     ( objectRounding, ObjectContext, ℕ, SymbolicObj3(Cube, Sphere, Cylinder, Rotate3, Extrude, ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3), Obj3, ℝ2, ℝ, fromℕtoℝ, toScaleFn )
 
 import Graphics.Implicit.MathUtil ( rmax, rmaximum )
 
-import Data.Maybe (fromMaybe, isJust)
 import qualified Linear as Q
 
 import qualified Data.Either as Either (either)
@@ -96,16 +95,22 @@ getImplicit3 _ (ExtrudeOnEdgeOf symbObj1 symbObj2) =
         obj2 = getImplicit symbObj2
     in
         \(V3 x y z) -> obj1 $ V2 (obj2 (V2 x y)) z
-getImplicit3 _ (RotateExtrude totalRotation round translate rotate symbObj) =
+getImplicit3 ctx (RotateExtrude totalRotation translate rotate symbObj) =
     let
         tau :: ℝ
         tau = 2 * pi
         k :: ℝ
         k   = tau / 360
         totalRotation' = totalRotation*k
         obj = getImplicit symbObj
-        capped = isJust round
-        round' = fromMaybe 0 round
+
+        is360m :: ℝ -> Bool
+        is360m n = 360 * fromInteger (round $ n / 360) /= n
+        capped
+             = is360m totalRotation
+            || either ( /= pure 0) (\f -> f 0 /= f totalRotation) translate
+            || either is360m (\f -> is360m (f 0 - f totalRotation)) rotate
+        round' = objectRounding ctx
         translate' :: ℝ -> ℝ2
         translate' = Either.either
                 (\(V2 a b) θ -> V2 (a*θ/totalRotation') (b*θ/totalRotation'))

Graphics/Implicit/Primitives.hs

@@ -379,13 +379,15 @@ extrudeM
 extrudeM = ExtrudeM
 
 
-rotateExtrude :: ℝ            -- ^ Angle to sweep to (in rad)
-    -> Maybe ℝ                -- ^ Loop or path (rounded corner)
-    -> Either ℝ2 (ℝ -> ℝ2)    -- ^ translate
-    -> Either ℝ  (ℝ -> ℝ )    -- ^ rotate
-    -> SymbolicObj2           -- ^ object to extrude
+rotateExtrude
+    :: ℝ                    -- ^ Angle to sweep to (in rad)
+    -> Either ℝ2 (ℝ -> ℝ2)  -- ^ translate
+    -> Either ℝ  (ℝ -> ℝ )  -- ^ rotate
+    -> SymbolicObj2         -- ^ object to extrude
     -> SymbolicObj3
-rotateExtrude = RotateExtrude
+rotateExtrude 0 _ _ _ = emptySpace
+rotateExtrude _ _ _ (Shared Empty) = emptySpace
+rotateExtrude theta t r obj = RotateExtrude theta t r obj
 
 extrudeOnEdgeOf :: SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
 extrudeOnEdgeOf = ExtrudeOnEdgeOf

tests/GoldenSpec/Spec.hs

@@ -143,4 +143,17 @@ spec = describe "golden tests" $ do
       , sphere 1.54
       ]
 
+  golden "hook" 2 $
+    union
+      [ translate (V3 0 60 0) $
+          rotateExtrude 270 (Left 0) (Left 0) $
+            translate (V2 40 0) $
+              circle 10
+      , rotateExtrude 90 (Left 0) (Left 0) $
+          translate (V2 20 0) $
+            circle 10
+      , translate (V3 20 0 0) $
+          rotate3 (V3 (pi / 2) 0 0) $
+            cylinder 10 80
+      ]