mirror of
https://github.com/Haskell-Things/ImplicitCAD.git
synced 2024-09-17 16:08:01 +03:00
Merge pull request #269 from FlyingGaz/issue268
Support XY-scaling on linear_extrude (resolves #268)
This commit is contained in:
Julia Longtin
GitHub
commit
9ac59e955e
@ -33,7 +33,7 @@ import Graphics.Implicit.Primitives as P (translate, scale, complement, union, i
|
||||
import Graphics.Implicit.ExtOpenScad as E (runOpenscad)
|
||||
|
||||
-- typesclasses and types defining the world, or part of the world.
|
||||
import Graphics.Implicit.Definitions as W (ℝ, SymbolicObj2, SymbolicObj3)
|
||||
import Graphics.Implicit.Definitions as W (ℝ, SymbolicObj2, SymbolicObj3, ExtrudeRMScale(C1, C2, Fn))
|
||||
|
||||
-- Functions for writing files based on the result of operations on primitives.
|
||||
import qualified Graphics.Implicit.Export as Export (writeSVG, writeDXF2, writeSTL, writeBinSTL, writeOBJ, writeSCAD2, writeSCAD3, writeTHREEJS, writeGCodeHacklabLaser, writePNG)
|
||||
|
||||
@ -70,13 +70,16 @@ module Graphics.Implicit.Definitions (
|
||||
ExtrudeRM,
|
||||
ExtrudeOnEdgeOf,
|
||||
RotateExtrude),
|
||||
ExtrudeRMScale(C1, C2, Fn),
|
||||
fromℕtoℝ,
|
||||
fromFastℕtoℝ,
|
||||
fromℝtoFloat
|
||||
fromℝtoFloat,
|
||||
toScaleFn,
|
||||
isScaleID,
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude (Show, Double, Either, show, (*), (/), fromIntegral, Float, realToFrac)
|
||||
import Prelude (Show, Double, Either(Left, Right), Bool(True, False), show, (*), (/), fromIntegral, Float, realToFrac)
|
||||
|
||||
import Data.Maybe (Maybe)
|
||||
|
||||
@ -142,6 +145,9 @@ instance Show (ℝ -> ℝ) where
|
||||
instance Show (ℝ -> ℝ2) where
|
||||
show _ = "<expand ℝ -> ℝ2>"
|
||||
|
||||
instance Show (ℝ -> Either ℝ ℝ2) where
|
||||
show _ = "<function ℝ -> Either ℝ ℝ2>"
|
||||
|
||||
instance Show (ℝ2 -> ℝ) where
|
||||
show _ = "<collapse ℝ2 -> ℝ>"
|
||||
|
||||
@ -276,7 +282,7 @@ data SymbolicObj3 =
|
||||
| ExtrudeRM
|
||||
ℝ -- rounding radius
|
||||
(Either ℝ (ℝ -> ℝ)) -- twist
|
||||
(Either ℝ (ℝ -> ℝ)) -- scale
|
||||
ExtrudeRMScale -- scale
|
||||
(Either ℝ2 (ℝ -> ℝ2)) -- translate
|
||||
SymbolicObj2 -- object to extrude
|
||||
(Either ℝ (ℝ2 -> ℝ)) -- height to extrude to
|
||||
@ -289,3 +295,20 @@ data SymbolicObj3 =
|
||||
| ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
|
||||
deriving Show
|
||||
|
||||
data ExtrudeRMScale =
|
||||
C1 ℝ -- constant ℝ
|
||||
| C2 ℝ2 -- constant ℝ2
|
||||
| Fn (ℝ -> Either ℝ ℝ2) -- function mapping height to either ℝ or ℝ2
|
||||
deriving Show
|
||||
|
||||
toScaleFn :: ExtrudeRMScale -> ℝ -> ℝ2
|
||||
toScaleFn (C1 s) _ = (s, s)
|
||||
toScaleFn (C2 s) _ = s
|
||||
toScaleFn (Fn f) z = case f z of
|
||||
Left s -> (s, s)
|
||||
Right s -> s
|
||||
|
||||
isScaleID :: ExtrudeRMScale -> Bool
|
||||
isScaleID (C1 1) = True
|
||||
isScaleID (C2 (1, 1)) = True
|
||||
isScaleID _ = False
|
||||
|
||||
@ -10,7 +10,7 @@ module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
|
||||
|
||||
import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))
|
||||
|
||||
import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(RectR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf))
|
||||
import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(RectR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf), isScaleID)
|
||||
import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)
|
||||
|
||||
import Control.Monad.Reader (Reader, runReader, ask)
|
||||
@ -91,7 +91,7 @@ buildS3 (ExtrudeR r obj h) | r == 0 = callNaked "linear_extrude" ["height = " <>
|
||||
buildS3 (ExtrudeRotateR r twist obj h) | r == 0 = callNaked "linear_extrude" ["height = " <> bf h, "twist = " <> bf twist] [buildS2 obj]
|
||||
|
||||
-- FIXME: handle scale, center.
|
||||
buildS3 (ExtrudeRM r twist (Left scale) (Left translate) obj (Left height)) | r == 0 && scale == 1 && translate == (0,0) = do
|
||||
buildS3 (ExtrudeRM r twist scale (Left translate) obj (Left height)) | r == 0 && isScaleID scale && translate == (0,0) = do
|
||||
res <- ask
|
||||
let
|
||||
twist' = case twist of
|
||||
|
||||
@ -17,7 +17,7 @@ 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)
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, fromℕtoℝ)
|
||||
import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeRMScale(C1), fromℕtoℝ, isScaleID)
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Definitions (OVal (OObj2, OObj3, ONModule), ArgParser, Symbol(Symbol), StateC, SourcePosition)
|
||||
|
||||
@ -428,7 +428,7 @@ extrude = moduleWithSuite "linear_extrude" $ \_ children -> do
|
||||
`doc` "center? (the z component)"
|
||||
twistArg :: Either ℝ (ℝ -> ℝ) <- argument "twist" `defaultTo` Left 0
|
||||
`doc` "twist as we extrude, either a total amount to twist or a function..."
|
||||
scaleArg :: Either ℝ (ℝ -> ℝ) <- argument "scale" `defaultTo` Left 1
|
||||
scaleArg :: ExtrudeRMScale <- argument "scale" `defaultTo` C1 1
|
||||
`doc` "scale according to this funciton as we extrude..."
|
||||
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- argument "translate" `defaultTo` Left (0,0)
|
||||
`doc` "translate according to this funciton as we extrude..."
|
||||
@ -450,15 +450,12 @@ extrude = moduleWithSuite "linear_extrude" $ \_ children -> do
|
||||
isTwistID = case twistArg of
|
||||
Left constant -> constant == 0
|
||||
Right _ -> False
|
||||
isScaleID = case scaleArg of
|
||||
Left constant -> constant == 1
|
||||
Right _ -> False
|
||||
isTransID = case translateArg of
|
||||
Left constant -> constant == (0,0)
|
||||
Right _ -> False
|
||||
pure $ pure $ obj2UpMap (
|
||||
\obj -> case height of
|
||||
Left constHeight | isTwistID && isScaleID && isTransID ->
|
||||
Left constHeight | isTwistID && isScaleID scaleArg && isTransID ->
|
||||
shiftAsNeeded $ Prim.extrudeR r obj constHeight
|
||||
_ ->
|
||||
shiftAsNeeded $ Prim.extrudeRM r twistArg scaleArg translateArg obj height'
|
||||
|
||||
@ -16,7 +16,7 @@ module Graphics.Implicit.ExtOpenScad.Util.OVal(OTypeMirror, (<||>), fromOObj, to
|
||||
|
||||
import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return)
|
||||
|
||||
import Graphics.Implicit.Definitions(ℝ, ℕ, SymbolicObj2, SymbolicObj3, fromℕtoℝ)
|
||||
import Graphics.Implicit.Definitions(ℝ, ℝ2, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeRMScale(C1, C2, Fn), fromℕtoℝ)
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3))
|
||||
|
||||
@ -118,6 +118,16 @@ instance (OTypeMirror a, OTypeMirror b) => OTypeMirror (Either a b) where
|
||||
toOObj (Right x) = toOObj x
|
||||
toOObj (Left x) = toOObj x
|
||||
|
||||
instance OTypeMirror ExtrudeRMScale where
|
||||
fromOObj (fromOObj -> Just (x :: ℝ)) = Just $ C1 x
|
||||
fromOObj (fromOObj -> Just (x :: ℝ2)) = Just $ C2 x
|
||||
fromOObj (fromOObj -> Just (x :: (ℝ -> Either ℝ ℝ2))) = Just $ Fn x
|
||||
fromOObj _ = Nothing
|
||||
|
||||
toOObj (C1 x) = toOObj x
|
||||
toOObj (C2 x) = toOObj x
|
||||
toOObj (Fn x) = toOObj x
|
||||
|
||||
-- A string representing each type.
|
||||
oTypeStr :: OVal -> Text
|
||||
oTypeStr OUndefined = "Undefined"
|
||||
|
||||
@ -5,9 +5,9 @@
|
||||
|
||||
module Graphics.Implicit.ObjectUtil.GetBox3 (getBox3) where
|
||||
|
||||
import Prelude(Eq, Bool(False), Fractional, Either (Left, Right), (==), (||), max, (/), (-), (+), fmap, unzip, ($), filter, not, (.), unzip3, minimum, maximum, min, (>), (&&), head, (*), (<), abs, either, error, const, otherwise, take, fst, snd)
|
||||
import Prelude(Eq, Bool(False), Fractional, Either (Left, Right), (==), (||), max, (/), (-), (+), fmap, unzip, ($), (<$>), filter, not, (.), unzip3, minimum, maximum, min, (>), (&&), head, (*), (<), abs, either, error, const, otherwise, take, fst, snd)
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, Fastℕ, Box3, SymbolicObj3 (Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Shell3, Outset3, EmbedBoxedObj3, ExtrudeR, ExtrudeOnEdgeOf, ExtrudeRM, RotateExtrude, ExtrudeRotateR), SymbolicObj2 (Rotate2, RectR), (⋯*), fromFastℕtoℝ, fromFastℕ)
|
||||
import Graphics.Implicit.Definitions (ℝ, Fastℕ, Box3, SymbolicObj3 (Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Shell3, Outset3, EmbedBoxedObj3, ExtrudeR, ExtrudeOnEdgeOf, ExtrudeRM, RotateExtrude, ExtrudeRotateR), SymbolicObj2 (Rotate2, RectR), ExtrudeRMScale(C1, C2), (⋯*), fromFastℕtoℝ, fromFastℕ, toScaleFn)
|
||||
|
||||
import Graphics.Implicit.ObjectUtil.GetBox2 (getBox2, getBox2R)
|
||||
|
||||
@ -141,17 +141,18 @@ getBox3 (ExtrudeRM _ twist scale translate symbObj height) =
|
||||
|
||||
(twistXmin, twistYmin, twistXmax, twistYmax) =
|
||||
let
|
||||
scale' = case scale of
|
||||
Left sval -> sval
|
||||
Right sfun -> maximum $ fmap (abs . sfun) hrange
|
||||
smin v = min v (scale' * v)
|
||||
smax v = max v (scale' * v)
|
||||
both f (a, b) = (f a, f b)
|
||||
(scalex', scaley') = case scale of
|
||||
C1 s -> (s, s)
|
||||
C2 s -> s
|
||||
s -> both maximum . unzip $ both abs . toScaleFn s <$> hrange
|
||||
smin s v = min v (s * v)
|
||||
smax s v = max v (s * v)
|
||||
-- FIXME: assumes minimums are negative, and maximums are positive.
|
||||
scaleVal d = scale' * d
|
||||
scaleEach ((d1, d2),(d3, d4)) = (scaleVal d1, scaleVal d2, scaleVal d3, scaleVal d4)
|
||||
scaleEach ((d1, d2),(d3, d4)) = (scalex' * d1, scaley' * d2, scalex' * d3, scaley' * d4)
|
||||
in case twist of
|
||||
Left twval -> if twval == 0
|
||||
then (smin x1, smin y1, smax x2, smax y2)
|
||||
then (smin scalex' x1, smin scaley' y1, smax scalex' x2, smax scaley' y2)
|
||||
else scaleEach $ getBox2R symbObj twval
|
||||
Right _ -> scaleEach $ getBox2R symbObj 360 -- we can't range functions yet, so assume a full circle.
|
||||
|
||||
|
||||
@ -10,7 +10,7 @@ import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max,
|
||||
import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, ℝ3, (⋯/), Obj3,
|
||||
SymbolicObj3(Shell3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3,
|
||||
Outset3, Rect3R, Sphere, Cylinder, Complement3, EmbedBoxedObj3, Rotate3V,
|
||||
ExtrudeR, ExtrudeRM, ExtrudeOnEdgeOf, RotateExtrude, ExtrudeRotateR), fromℕtoℝ, (⋅), minℝ)
|
||||
ExtrudeR, ExtrudeRM, ExtrudeOnEdgeOf, RotateExtrude, ExtrudeRotateR), fromℕtoℝ, toScaleFn, (⋅), minℝ)
|
||||
|
||||
import Graphics.Implicit.MathUtil (rmaximum, rminimum, rmax)
|
||||
|
||||
@ -139,13 +139,9 @@ getImplicit3 (ExtrudeRM r twist scale translate symbObj height) =
|
||||
(xTrans, yTrans) = case trans of
|
||||
Left tval -> tval
|
||||
Right tfun -> tfun z
|
||||
scaleVec :: Either ℝ (ℝ -> ℝ) -> ℝ -> ℝ2 -> ℝ2
|
||||
scaleVec scale' s (x,y) =
|
||||
case scale' of
|
||||
Left sval -> if sval == 1
|
||||
then (x,y)
|
||||
else (x/sval , y/sval)
|
||||
Right sfun -> (x/sfun s, y/sfun s)
|
||||
scaleVec :: ℝ -> ℝ2 -> ℝ2
|
||||
scaleVec z (x, y) = let (sx, sy) = toScaleFn scale z
|
||||
in (x / sx, y / sy)
|
||||
rotateVec :: ℝ -> ℝ2 -> ℝ2
|
||||
rotateVec θ (x,y)
|
||||
| θ == 0 = (x,y)
|
||||
@ -159,7 +155,7 @@ getImplicit3 (ExtrudeRM r twist scale translate symbObj height) =
|
||||
res = rmax r
|
||||
(obj
|
||||
. rotateVec (-k*twistVal twist z h)
|
||||
. scaleVec scale z
|
||||
. scaleVec z
|
||||
. translatePos translate z
|
||||
$ (x,y))
|
||||
(abs (z - h/2) - h/2)
|
||||
|
||||
@ -74,7 +74,8 @@ import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, Box2,
|
||||
ExtrudeRM,
|
||||
RotateExtrude,
|
||||
ExtrudeOnEdgeOf
|
||||
)
|
||||
),
|
||||
ExtrudeRMScale
|
||||
)
|
||||
import Graphics.Implicit.MathUtil (pack)
|
||||
import Graphics.Implicit.ObjectUtil (getBox2, getBox3, getImplicit2, getImplicit3)
|
||||
@ -245,7 +246,7 @@ extrudeRotateR = ExtrudeRotateR
|
||||
|
||||
extrudeRM :: ℝ
|
||||
-> Either ℝ (ℝ -> ℝ)
|
||||
-> Either ℝ (ℝ -> ℝ)
|
||||
-> ExtrudeRMScale
|
||||
-> Either ℝ2 (ℝ -> ℝ2)
|
||||
-> SymbolicObj2
|
||||
-> Either ℝ (ℝ2 -> ℝ)
|
||||
|
||||
@ -12,7 +12,7 @@ import Prelude (($), (*), (/), String, IO, cos, pi, fmap, zip3, Either(Left, Rig
|
||||
import Criterion.Main (Benchmark, bgroup, bench, nf, nfAppIO, defaultMain)
|
||||
|
||||
-- The parts of ImplicitCAD we know how to benchmark.
|
||||
import Graphics.Implicit (union, circle, sphere, SymbolicObj2, SymbolicObj3, writeDXF2, writeSVG, writePNG2, writeSTL, writeBinSTL, unionR, translate, difference, extrudeRM, rect3R)
|
||||
import Graphics.Implicit (union, circle, sphere, SymbolicObj2, SymbolicObj3, ExtrudeRMScale(C1), writeDXF2, writeSVG, writePNG2, writeSTL, writeBinSTL, unionR, translate, difference, extrudeRM, rect3R)
|
||||
import Graphics.Implicit.Export.SymbolicObj2 (symbolicGetContour)
|
||||
import Graphics.Implicit.Export.SymbolicObj3 (symbolicGetMesh)
|
||||
|
||||
@ -36,7 +36,7 @@ obj2d_1 =
|
||||
|
||||
-- | An extruded version of obj2d_1, should be identical to the website's example, and example5.escad.
|
||||
object1 :: SymbolicObj3
|
||||
object1 = extrudeRM 0 (Right twist) (Left 1) (Left (0,0)) obj2d_1 (Left 40)
|
||||
object1 = extrudeRM 0 (Right twist) (C1 1) (Left (0,0)) obj2d_1 (Left 40)
|
||||
where
|
||||
twist :: ℝ -> ℝ
|
||||
twist h = 35*cos(h*2*pi/60)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user