From 085248ff786769a80fc5676720a2a7ebf5874247 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Tue, 7 May 2019 18:42:52 +0100 Subject: [PATCH] comments and spacing changes, and use an integral for counting sides of a polygon, instead of doubles. also, add a tester for polygons. --- Examples/example14.escad | 10 +++ Graphics/Implicit/ExtOpenScad/Primitives.hs | 97 +++++---------------- 2 files changed, 31 insertions(+), 76 deletions(-) create mode 100644 Examples/example14.escad diff --git a/Examples/example14.escad b/Examples/example14.escad new file mode 100644 index 0000000..2764e55 --- /dev/null +++ b/Examples/example14.escad @@ -0,0 +1,10 @@ +// example7.escad -- A twisted rounded extrusion of the rounded union of 5 hexagonical solids. +linear_extrude (height = 40, center=true, twist=90, r=5){ + union ( r = 8) { + circle (10,$fn=6); + translate ([22,0]) circle (10,$fn=6); + translate ([0,22]) circle (10,$fn=6); + translate ([-22,0]) circle (10,$fn=6); + translate ([0,-22]) circle (10,$fn=6); + } +} diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index c42058d..20e40a5 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -2,7 +2,7 @@ -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE --- Idealy, we'd like to parse openscad code, with some improvements, for backwards compatability. +-- Idealy, we'd like to parse a superset of openscad code, with some improvements. -- This file provides primitive objects for the openscad parser. @@ -12,9 +12,9 @@ -- Export one set containing all of the primitive object's patern matches. module Graphics.Implicit.ExtOpenScad.Primitives (primitives) where -import Prelude(String, IO, Either(Left, Right), Bool(False), Maybe(Just, Nothing), Fractional, ($), return, either, id, (-), (==), (&&), (<), fromIntegral, (*), cos, sin, pi, (/), (>), const, uncurry, realToFrac, fmap, fromInteger, round, (/=), (||), not, null, map, (++), putStrLn) +import Prelude(String, IO, Either(Left, Right), Bool(False), Maybe(Just, Nothing), Fractional, ($), return, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, realToFrac, fmap, fromInteger, round, (/=), (||), not, null, map, (++), putStrLn) -import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3) +import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, fromℕtoℝ) import Graphics.Implicit.ExtOpenScad.Definitions (OVal (OObj2, OObj3), ArgParser) @@ -22,7 +22,7 @@ import Graphics.Implicit.ExtOpenScad.Util.ArgParser (doc, defaultTo, argument, e import Graphics.Implicit.ExtOpenScad.Util.OVal (caseOType, divideObjs, (<||>)) --- note the use of a qualified import, so we don't have the functions in this file conflict with what we're importing. +-- 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 (sphere, rect3R, rectR, translate, circle, polygonR, extrudeR, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, rotate3V, rotate3, scale, extrudeR, extrudeRM, rotateExtrude, shell, pack3, pack2) import Data.Maybe (isNothing) @@ -32,13 +32,13 @@ import Control.Monad (mplus) import Data.VectorSpace (VectorSpace, Scalar, (*^)) import GHC.Real (RealFrac) --- The only thing exported here. basically, a list of ... ? -primitives :: [(String, [OVal] -> ArgParser (IO [OVal]) )] +-- | The only thing exported here. basically, a list of functions, which accept OVal arguments and retrun an ArgParser ? +primitives :: [(String, [OVal] -> ArgParser (IO [OVal]))] primitives = [ sphere, cube, square, cylinder, circle, polygon, union, difference, intersect, translate, scale, rotate, extrude, pack, shell, rotateExtrude, unit ] --- sphere is a module without a suite. --- this means that the parser will look for this like --- sphere(args...); +-- | sphere is a module without a suite. +-- this means that the parser will look for this like +-- sphere(args...); sphere :: (String, [OVal] -> ArgParser (IO [OVal])) sphere = moduleWithoutSuite "sphere" $ do example "sphere(3);" @@ -56,16 +56,13 @@ sphere = moduleWithoutSuite "sphere" $ do cube :: (String, [OVal] -> ArgParser (IO [OVal])) cube = moduleWithoutSuite "cube" $ do - -- examples example "cube(size = [2,3,4], center = true, r = 0.5);" example "cube(4);" - -- arguments shared between forms r :: ℝ <- argument "r" `doc` "radius of rounding" `defaultTo` 0 - -- arguments (two forms) ((x1,x2), (y1,y2), (z1,z2)) <- do @@ -79,7 +76,7 @@ cube = moduleWithoutSuite "cube" $ do `doc` "should center? (non-intervals)" `defaultTo` False let - toInterval' :: Fractional t => t -> (t, t) + toInterval' :: ℝ -> (ℝ, ℝ) toInterval' = toInterval center return (either toInterval' id x, either toInterval' id y, @@ -92,28 +89,23 @@ cube = moduleWithoutSuite "cube" $ do `defaultTo` False let (x,y, z) = either (\w -> (w,w,w)) id size return (toInterval center x, toInterval center y, toInterval center z) - -- Tests test "cube(4);" `eulerCharacteristic` 2 test "cube(size=[2,3,4]);" `eulerCharacteristic` 2 - addObj3 $ Prim.rect3R r (x1, y1, z1) (x2, y2, z2) square :: (String, [OVal] -> ArgParser (IO [OVal])) square = moduleWithoutSuite "square" $ do - -- examples example "square(x=[-2,2], y=[-1,5]);" example "square(size = [3,4], center = true, r = 0.5);" example "square(4);" - -- arguments shared between forms r :: ℝ <- argument "r" `doc` "radius of rounding" `defaultTo` 0 - -- arguments (two forms) ((x1,x2), (y1,y2)) <- do @@ -125,7 +117,7 @@ square = moduleWithoutSuite "square" $ do `doc` "should center? (non-intervals)" `defaultTo` False let - toInterval' :: Fractional t => t -> (t, t) + toInterval' :: ℝ -> (ℝ, ℝ) toInterval' = toInterval center return (either toInterval' id x, either toInterval' id y) @@ -137,22 +129,18 @@ square = moduleWithoutSuite "square" $ do `defaultTo` False let (x,y) = either (\w -> (w,w)) id size return (toInterval center x, toInterval center y) - -- Tests test "square(2);" `eulerCharacteristic` 0 test "square(size=[2,3]);" `eulerCharacteristic` 0 - addObj2 $ Prim.rectR r (x1, y1) (x2, y2) cylinder :: (String, [OVal] -> ArgParser (IO [OVal])) cylinder = moduleWithoutSuite "cylinder" $ do - example "cylinder(r=10, h=30, center=true);" example "cylinder(r1=4, r2=6, h=10);" example "cylinder(r=5, h=10, $fn = 6);" - -- arguments r :: ℝ <- argument "r" `defaultTo` 1 @@ -166,19 +154,17 @@ cylinder = moduleWithoutSuite "cylinder" $ do r2 :: ℝ <- argument "r2" `defaultTo` 1 `doc` "top radius; overrides r" - fn :: ℕ <- argument "$fn" + sides :: ℕ <- argument "$fn" `defaultTo` (-1) `doc` "number of sides, for making prisms" center :: Bool <- argument "center" `defaultTo` False `doc` "center cylinder with respect to z?" - -- Tests test "cylinder(r=10, h=30, center=true);" `eulerCharacteristic` 0 test "cylinder(r=5, h=10, $fn = 6);" `eulerCharacteristic` 0 - let (h1, h2) = either (toInterval center) id h dh = h2 - h1 @@ -187,49 +173,36 @@ cylinder = moduleWithoutSuite "cylinder" $ do if h1 == 0 then id else Prim.translate (0,0,h1) - -- The result is a computation state modifier that adds a 3D object, -- based on the args. addObj3 $ if r1 == 1 && r2 == 1 then let - obj2 = if fn < 0 then Prim.circle r else Prim.polygonR 0 $ - let - sides :: ℝ - sides = fromIntegral fn - in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]] + obj2 = if sides < 0 then Prim.circle r else Prim.polygonR 0 $ + [(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]] obj3 = Prim.extrudeR 0 obj2 dh in shift obj3 else shift $ Prim.cylinder2 r1 r2 dh circle :: (String, [OVal] -> ArgParser (IO [OVal])) circle = moduleWithoutSuite "circle" $ do - example "circle(r=10); // circle" example "circle(r=5, $fn=6); //hexagon" - -- Arguments - r :: ℝ <- argument "r" - `doc` "radius of the circle" - fn :: ℕ <- argument "$fn" - `doc` "if defined, makes a regular polygon with n sides instead of a circle" - `defaultTo` (-1) - + r :: ℝ <- argument "r" + `doc` "radius of the circle" + sides :: ℕ <- argument "$fn" + `doc` "if defined, makes a regular polygon with n sides instead of a circle" + `defaultTo` (-1) test "circle(r=10);" `eulerCharacteristic` 0 - - addObj2 $ if fn < 3 + addObj2 $ if sides < 3 then Prim.circle r else Prim.polygonR 0 $ - let - sides :: ℝ - sides = fromIntegral fn - in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]] + [(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]] polygon :: (String, [OVal] -> ArgParser (IO [OVal])) polygon = moduleWithoutSuite "polygon" $ do - example "polygon ([(0,0), (0,10), (10,0)]);" - points :: [ℝ2] <- argument "points" `doc` "vertices of the polygon" paths :: [ℕ] <- argument "paths" @@ -242,7 +215,6 @@ polygon = moduleWithoutSuite "polygon" $ do [] -> addObj2 $ Prim.polygonR r points _ -> return $ return [] - union :: (String, [OVal] -> ArgParser (IO [OVal])) union = moduleWithSuite "union" $ \children -> do r :: ℝ <- argument "r" @@ -272,10 +244,8 @@ difference = moduleWithSuite "difference" $ \children -> do translate :: (String, [OVal] -> ArgParser (IO [OVal])) translate = moduleWithSuite "translate" $ \children -> do - example "translate ([2,3]) circle (4);" example "translate ([5,6,7]) sphere(5);" - (x,y,z) <- do x :: ℝ <- argument "x" @@ -293,7 +263,6 @@ translate = moduleWithSuite "translate" $ \children -> do Left x -> (x,0,0) Right (Left (x,y) ) -> (x,y,0) Right (Right (x,y,z)) -> (x,y,z) - return $ return $ objMap (Prim.translate (x,y)) (Prim.translate (x,y,z)) children @@ -308,7 +277,6 @@ rotate = moduleWithSuite "rotate" $ \children -> do v <- argument "v" `defaultTo` (0, 0, 1) `doc` "Vector to rotate around if a is a single angle" - -- caseOType matches depending on whether size can be coerced into -- the right object. See Graphics.Implicit.ExtOpenScad.Util -- Entries must be joined with the operator <||> @@ -324,17 +292,14 @@ rotate = moduleWithSuite "rotate" $ \children -> do scale :: (String, [OVal] -> ArgParser (IO [OVal])) scale = moduleWithSuite "scale" $ \children -> do - example "scale(2) square(5);" example "scale([2,3]) square(5);" example "scale([2,3,4]) cube(5);" v <- argument "v" `doc` "vector or scalar to scale by" - let scaleObjs stretch2 stretch3 = objMap (Prim.scale stretch2) (Prim.scale stretch3) children - return $ return $ case v of Left x -> scaleObjs (x,1) (x,1,1) Right (Left (x,y)) -> scaleObjs (x,y) (x,y,1) @@ -343,7 +308,6 @@ scale = moduleWithSuite "scale" $ \children -> do extrude :: (String, [OVal] -> ArgParser (IO [OVal])) extrude = moduleWithSuite "linear_extrude" $ \children -> do example "linear_extrude(10) square(5);" - height :: Either ℝ (ℝ -> ℝ -> ℝ) <- argument "height" `defaultTo` Left 1 `doc` "height to extrude to..." center :: Bool <- argument "center" `defaultTo` False @@ -356,7 +320,6 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do `doc` "translate according to this funciton as we extrude..." r :: ℝ <- argument "r" `defaultTo` 0 `doc` "round the top?" - let heightn = case height of Left h -> h @@ -365,21 +328,17 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do height' = case height of Right f -> Right $ uncurry f Left a -> Left a - shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3 shiftAsNeeded = if center then Prim.translate (0,0,-heightn/2.0) else id - funcify :: (VectorSpace a, Fractional (Scalar a)) => Either a (ℝ -> a) -> ℝ -> a funcify (Left val) h = realToFrac (h/heightn) *^ val funcify (Right f ) h = f h - twist' = fmap funcify twist scale' = fmap funcify scaleArg translate' = fmap funcify translateArg - return $ return $ obj2UpMap ( \obj -> case height of Left constHeight | isNothing twist && isNothing scaleArg && isNothing translateArg -> @@ -391,13 +350,11 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do rotateExtrude :: (String, [OVal] -> ArgParser (IO [OVal])) rotateExtrude = moduleWithSuite "rotate_extrude" $ \children -> do example "rotate_extrude() translate(20) circle(10);" - totalRot :: ℝ <- argument "a" `defaultTo` 360 `doc` "angle to sweep" r :: ℝ <- argument "r" `defaultTo` 0 translateArg :: Either ℝ2 (ℝ -> ℝ2) <- argument "translate" `defaultTo` Left (0,0) rotateArg :: Either ℝ (ℝ -> ℝ ) <- argument "rotate" `defaultTo` Left 0 - let is360m :: RealFrac a => a -> Bool is360m n = 360 * fromInteger (round $ n / 360) /= n @@ -405,11 +362,8 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \children -> do || either ( /= (0,0)) (\f -> f 0 /= f totalRot) translateArg || either is360m (\f -> is360m (f 0 - f totalRot)) rotateArg capM = if cap then Just r else Nothing - return $ return $ obj2UpMap (Prim.rotateExtrude totalRot capM translateArg rotateArg) children - - {- rotateExtrudeStatement :: (String, [OVal] -> ArgParser (IO [OVal])) rotateExtrudeStatement = moduleWithSuite "rotate_extrude" $ \suite -> do @@ -426,21 +380,17 @@ shell :: (String, [OVal] -> ArgParser (IO [OVal])) shell = moduleWithSuite "shell" $ \children -> do w :: ℝ <- argument "w" `doc` "width of the shell..." - return $ return $ objMap (Prim.shell w) (Prim.shell w) children -- Not a permanent solution! Breaks if can't pack. pack :: (String, [OVal] -> ArgParser (IO [OVal])) pack = moduleWithSuite "pack" $ \children -> do - example "pack ([45,45], sep=2) { circle(10); circle(10); circle(10); circle(10); }" - -- arguments size :: ℝ2 <- argument "size" `doc` "size of 2D box to pack objects within" sep :: ℝ <- argument "sep" `doc` "mandetory space between objects" - -- The actual work... return $ let (obj2s, obj3s, others) = divideObjs children @@ -458,13 +408,10 @@ pack = moduleWithSuite "pack" $ \children -> do unit :: (String, [OVal] -> ArgParser (IO [OVal])) unit = moduleWithSuite "unit" $ \children -> do - example "unit(\"inch\") {..}" - -- arguments name :: String <- argument "unit" `doc` "the unit you wish to work in" - let mmRatio :: Fractional a => String -> Maybe a mmRatio "inch" = Just 25.4 @@ -482,7 +429,6 @@ unit = moduleWithSuite "unit" $ \children -> do mmRatio "um" = mmRatio "µm" mmRatio "nm" = Just 0.0000001 mmRatio _ = Nothing - -- The actual work... return $ case mmRatio name of Nothing -> do @@ -491,7 +437,6 @@ unit = moduleWithSuite "unit" $ \children -> do Just r -> return $ objMap (Prim.scale (r,r)) (Prim.scale (r,r,r)) children - --------------- (<|>) :: ArgParser a -> ArgParser a -> ArgParser a