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

@@ -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);
+        }
+}

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 ... ?
+-- | 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 :: [(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.
+-- | sphere is a module without a suite.
--- this means that the parser will look for this like
+--   this means that the parser will look for this like
---       sphere(args...);
+--   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 $
+            obj2 = if sides < 0 then Prim.circle r else Prim.polygonR 0 $
-                let
+                [(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]]
-                    sides :: ℝ
-                    sides = fromIntegral fn
-                in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]]
             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"
+    r     :: ℝ <- argument "r"
-        `doc` "radius of the circle"
+               `doc` "radius of the circle"
-    fn :: ℕ <- argument "$fn"
+    sides :: ℕ <- argument "$fn"
-        `doc` "if defined, makes a regular polygon with n sides instead of a circle"
+               `doc` "if defined, makes a regular polygon with n sides instead of a circle"
-        `defaultTo` (-1)
+               `defaultTo` (-1)
-
     test "circle(r=10);"
         `eulerCharacteristic` 0
-
+    addObj2 $ if sides < 3
-    addObj2 $ if fn < 3
         then Prim.circle r
         else Prim.polygonR 0 $
-             let
+            [(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]]
-                 sides :: ℝ
-                 sides = fromIntegral fn
-            in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]]
 
 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