OpenSCAD 0.2.1.1 → 0.3.0.0

raw patch · 3 files changed

+185/−68 lines, 3 filesdep +containersdep +deepseqdep +tastydep −test-frameworkdep −test-framework-hunitdep ~HUnitdep ~basedep ~colourPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, deepseq, tasty, tasty-hunit, testpack

Dependencies removed: test-framework, test-framework-hunit

Dependency ranges changed: HUnit, base, colour, filepath

API changes (from Hackage documentation)

Files

• Graphics/OpenSCAD.hs +83/−17
• OpenSCAD.cabal +20/−15
• UnitTest.hs +82/−36

@@ -88,6 +88,10 @@ three points you get an error. At this time, no tests are done on the faces. That will probably change in the future. +Finally, polygon and polyhedron can generate errors on input that+seems to generate proper solids. If you turn on 'View->Thrown+Together', you'll see it highlighting errors in the object.+ Offset is missing even though it's documented, as it isn't supported by a released version of OpenSCAD, so presumably subject to change. It is implemented, but untested as yet. You can add it to the module's@@ -129,27 +133,62 @@ import Data.Colour.Names as Colours import Data.Colour.SRGB (channelRed, channelBlue, channelGreen, toSRGB) import Data.List (elemIndices, nub, intercalate)-import Data.List.NonEmpty (toList)+import qualified Data.List.NonEmpty as NE import Data.Semigroup (Semigroup((<>), sconcat), Monoid(mconcat, mempty, mappend))+import qualified Data.Set as Set import System.FilePath (FilePath)  -- A vector in 2 or 3-space. They are used in transformations of -- 'Model's of their type.-class Vector a where+class Eq a => Vector a where   rVector :: a -> String+  toList :: a -> [Double]+  (#*) :: a -> a -> a	   -- cross product	+  (#-) :: a -> a -> a      -- difference between two vectors  +  (#.) :: a -> a -> Double -- dot product+  v1 #. v2 = sum $ zipWith (*) (toList v1) (toList v2)++  isZero :: a -> Bool      -- is a zero vector. Arguably should use eps.+  isZero = all (== 0) . toList++  collinear :: [a] -> Bool -- are all points collinear?+  collinear [] = False+  collinear [_] = False+  collinear [v1, v2] = v1 /= v2+  collinear (v1:v2:vs)+    | v1 /= v2  = all (\v -> isZero $ (v2 #- v1) #* (v1 #- v)) vs+    | otherwise = collinear (v2:vs)+ -- | 'Vector2d' is used where 'Graphics.OpenSCAD' expects an OpenSCAD -- @vector@ of length 2. type Vector2d = (Double, Double) instance Vector Vector2d where   rVector (x, y) = "[" ++ show x ++ "," ++ show y ++ "]"+  toList (x, y) = [x, y]+  (x1, y1) #- (x2, y2) = (x1 - x2, y1 - y2)+  (x1, y1) #* (x2, y2) = (0, x1 * y2 - y1 * x2) -- for purposes of collinear  -- | 'Vector3d' is used where 'Graphics.OpenSCAD' expects an OpenSCAD -- @vector@ of length 3. type Vector3d = (Double, Double, Double) instance Vector Vector3d where-  rVector (a, b, c) = "[" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "]"+  rVector (x, y, z) = "[" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]"+  toList (x, y, z) = [x, y, z]+  (x1, y1, z1) #- (x2, y2, z2) = (x1 - x2, y1 - y2, z1 - z2)+  (x1, y1, z1) #* (x2, y2, z2) = (y1 * z2 - z1 * y2,+                                  z1 * x2 - x1 * z2,+                                  x1 * y2 - y1 * x2) +-- Coplanar only makes sense for R3, so it's not part of the Vector class+coplanar :: [Vector3d] -> Bool+coplanar vs | length vs <= 3        = True -- by definition+            | collinear $ take 3 vs = coplanar $ tail vs+            | otherwise =+                all (\v -> (v3 #- v1) #. ((v2 #- v1) #* (v #- v3)) == 0) vs'+                where (v1:v2:v3:vs') = vs++ -- | A 4x4 transformation matrix specifying a complete 3-space -- transform of a 'Model3d'. type TransMatrix =@@ -250,9 +289,12 @@ -- that functions points argument.  If you were just going to pass in -- the points, it now needs to be in an extra level of 'List'. polygon ::  Int -> [[Vector2d]] -> Model2d-polygon convexity paths = Shape . Polygon convexity points-                  $ map (concatMap (`elemIndices` points)) paths-  where points = nub $ concat paths+polygon convexity paths +  | any ((< 3) . length) paths = error "Polygon has fewer than 3 points."+  | any collinear paths = error "Points in polygon are collinear."+  | otherwise = let points = nub $ concat paths+                in Shape . Polygon convexity points+                   $ map (concatMap (`elemIndices` points)) paths  -- | 'offset' a 'Model2d's edges by @offset /delta join/@. offset :: Double -> Join -> Model2d -> Model2d@@ -282,22 +324,47 @@  -- | Turn a list of list of 'Vector3d's and an int into @polyhedron -- /points 'Sides' convexity/@. The argument to polyhedron is the list--- of paths that is the second argument to the OpenSCAD polygon+-- of paths that is the second argument to the OpenSCAD polyhedron -- function, except the points are 'Vector3d's, not the references to -- 'Vector3d's used in that functions @points@ argument.  The function -- will build the appropriate function call, using @faces@ if you pass -- in a side that uses more than 3 points, or @triangles@ if not. Note--- that @faces@ doesn't work in older versions of OpenSCAD, an--- @triangles@ is depreciate. Until a mechanism to set the version of+-- that @faces@ doesn't work in older versions of OpenSCAD, and+-- @triangles@ is depreciated. Until a mechanism to set the version of -- OpenSCAD is provided, generating the @faces@ version will cause an -- error.+--+-- Passing in 'Sides' that have fewer than three points, have+-- collinear points or have points that aren't in the same plane is an+-- error that is caught by the library. polyhedron ::  Int -> [[Vector3d]] -> Model3d-polyhedron convexity paths = Solid . Polyhedron convexity points $ sides sin-  where points = nub $ concat paths-        sin = map (concatMap (`elemIndices` points)) paths-        sides ss | any ((> 3) . length) ss  = Faces sin-                 | all ((== 3) . length) ss = Triangles sin-                 | otherwise = error "All faces must have at least 3 sides."+polyhedron convexity paths+  | any ((< 3) . length) paths = error "Some face has fewer than 3 points."+  | any collinear paths = error "Some face has collinear points."+  | any (not . coplanar) paths = error "Some face isn't coplanar."+  | length vectors /= length (nub vectors) =+    error "Some faces have different orientation."+  | 2 * length edges /= length vectors = error "Some edges are not in two faces."+  | xCross headMax xMax tailMax > 0 =+    error "Face orientations are counterclockwise."+  | otherwise = Solid . Polyhedron convexity points $ sides sidesIn+  where vectors = concatMap (\p -> zip p (tail p ++ [head p])) paths+        edges = nub $ map (Set.fromList . \(a, b) -> [a, b]) vectors+        points = nub $ concat paths+        xMax = maximum points+        faceMax = head $ filter (elem xMax) paths+        (maxFirst, maxLast) = break (== xMax) faceMax+        (headMax, tailMax)  = (if null maxFirst+                                  then last maxLast+                                  else last maxFirst,+                               if null (tail maxLast)+                                  then head maxFirst+                                  else head (tail maxLast))+        xCross a b c  = (\(a, b, c) -> a) $ (a #- b) #* (b #- c)+        sidesIn = map (concatMap (`elemIndices` points)) paths+        sides ss | any ((> 3) . length) ss  = Faces ss+                 | all ((== 3) . length) ss = Triangles ss+                 | otherwise = error "Some faces have fewer than 3 points."  -- | Transform a 'Model3d' with a 'TransMatrix' multMatrix :: TransMatrix -> Model3d -> Model3d@@ -530,11 +597,10 @@ -- | Use 'diam' to turn a diameter into a radius for circles, spheres, etc. diam :: Double -> Double diam = (/ 2)- -- Now, let Haskell work it's magic instance Vector v => Semigroup (Model v) where   a <> b = union [a, b]-  sconcat = union . toList+  sconcat = union . NE.toList  instance Vector v => Monoid (Model v) where   mempty = Solid $ Box 0 0 0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                OpenSCAD-version:             0.2.1.1+version:             0.3.0.0 synopsis:            ADT wrapper and renderer for OpenSCAD models. description:         An algebraic data type for describing OpenSCAD models,                      functions to make building such models easier, and@@ -22,24 +22,29 @@   exposed-modules:     Graphics.OpenSCAD, Graphics.OpenSCAD.Unicode   -- other-modules:          other-extensions:    UnicodeSyntax-  build-depends:       base >=4.6 && <4.8,-                       colour >=2.3 && <2.4,-                       filepath >=1.3 && <1.4,-                       semigroups >= 0.15 && < 1.0+  build-depends: base > 4.5 && < 5.0,+                 colour >=2.3 && < 2.4,+                 filepath >=1.3 && < 1.4,+                 semigroups >= 0.15 && < 1.0,+                 containers >= 0.5   -- hs-source-dirs:         default-language:    Haskell2010  Test-Suite Units   type:        exitcode-stdio-1.0   main-is:     UnitTest.hs-  build-depends: base >=4.6 && <4.8,-                 colour >=2.3 && <2.4,-                 filepath >=1.3 && <1.4,-                 HUnit >=1.2 && <1.4,+  build-depends: base > 4.5 && < 5.0,+                 colour >=2.3,+                 filepath >=1.3,+                 HUnit >=1.2,                  Cabal >= 1.18,-                 test-framework-hunit >=0.3 && < 0.5,-                 test-framework >=0.8 && < 1.0,-                 semigroups >= 0.15 && < 1.0+                 tasty-hunit >= 0.9,+                 tasty >=0.8,+                 deepseq >= 1.3,+                 testpack >= 2.1.2.1,+                 containers >= 0.5.5.1,+                 semigroups >= 0.15 && < 1.0,+                 containers >= 0.5   default-language:    Haskell2010  source-repository head@@ -47,6 +52,6 @@   location:       https://chiselapp.com/user/mwm/repository/OpenSCAD/  source-repository this-  type:           fossil-  location:       https://chiselapp.com/user/mwm/repository/OpenSCAD/-  tag:            0.2.1.1+  type:           hg+  location:       https://code.google.com/p/graphics-openscad/+  tag:            0.3.0.0

@@ -1,19 +1,26 @@ #!/usr/bin/env runghc-module Main where -import Data.Monoid-import Test.HUnit-import Test.Framework-import Test.Framework.Providers.HUnit+module Main where +import Control.DeepSeq+import Control.Exception+import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Tools import Graphics.OpenSCAD import Data.Colour (withOpacity) import Data.List.NonEmpty (fromList)-import Data.Semigroup (sconcat)+import Data.Semigroup (Semigroup((<>), sconcat), Monoid(mconcat, mempty, mappend)) +++assertError err code =+  assertRaises "Check error"  (ErrorCall err) . evaluate $ deepseq (show code) ()+ sw = concat . words-st n e a = testCase n $ (sw e) @=?(sw $ render a)+st n e a = testCase n $ (sw $ render a) @?= (sw e) + {- About the test result values.  Running "cabal test" does not verify that the results do the intended@@ -25,29 +32,29 @@ that they are testing does. -} -tests = [+tests = testGroup "Tests" [   testGroup "3d-primitives" [      testGroup "Spheres" [-        st "1" "sphere(1.0);"         (sphere 1 def),+        st "1" "sphere(1.0);"       $ sphere 1 def,         st "2" "sphere(2.0,$fn=100);" (sphere 2 $ fn 100),         st "3" "sphere(2.0,$fa=5.0);" (sphere 2 $ fa 5),         st "4" "sphere(2.0,$fs=0.1);" (sphere 2 $ fs 0.1)         ],       testGroup "Boxes" [-       st "box"  "cube([1.0,2.0,3.0]);" (box 1 2 3),-       st "cube" "cube([2.0,2.0,2.0]);" (cube 2)+       st "box"  "cube([1.0,2.0,3.0]);" $ box 1 2 3,+       st "cube" "cube([2.0,2.0,2.0]);" $ cube 2        ],       testGroup "Cylinders" [-       st "1" "cylinder(r=1.0,h=2.0);"          (cylinder 1 2 def),+       st "1" "cylinder(r=1.0,h=2.0);"         $ cylinder 1 2 def,        st "2" "cylinder(r=1.0,h=2.0,$fs=0.6);"  (cylinder 1 2 $ fs 0.6),        st "3" "cylinder(r=1.0,h=2.0,$fn=10);"   (cylinder 1 2 $ fn 10),        st "4" "cylinder(r=1.0,h=2.0,$fa=30.0);" (cylinder 1 2 $ fa 30)        ],       testGroup "Oblique-Cylinders" [-       st "1" "cylinder(r1=1.0,h=2.0,r2=2.0);"  (obCylinder 1 2 2 def),+       st "1" "cylinder(r1=1.0,h=2.0,r2=2.0);" $ obCylinder 1 2 2 def,        st "2" "cylinder(r1=1.0,h=2.0,r2=2.0,$fs=0.6);"           (obCylinder 1 2 2 $ fs 0.6),        st "3" "cylinder(r1=1.0,h=2.0,r2=2.0,$fn=10);"@@ -59,22 +66,21 @@      testGroup "Misc" [        st "import" "import(\"test.stl\");" (solid $ importFile "test.stl"),        st "polyhedron 1"-          "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],triangles=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[1,0,4],[3,1,4]],convexity=1);"-          (polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],-                         [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],-                         [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],-                         [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],-                         [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],-                         [(-10, -10, 0), (10, -10, 0), (-10, 10, 0)]]),+          "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],triangles=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[1,0,4],[3,1,4]],convexity=1);" $+          polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],+                        [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],+                        [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],+                        [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],+                        [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],+                        [(-10, -10, 0), (10, -10, 0), (-10, 10, 0)]],        st "polyhedron 2"-       "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],faces=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[0,1,3,4]],convexity=1);"-          (polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],-                         [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],-                         [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],-                         [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],-                         [(10, 10, 0), (10, -10, 0), (-10, -10, 0), (-10, 10, 0)]])+          "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[0.0,0.0,10.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0]],faces=[[0,1,2],[1,3,2],[3,4,2],[4,0,2],[4,3,1,0]],convexity=1);" $+          polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],+                        [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],+                        [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],+                        [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],+                        [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (10, 10, 0)]]        ],-      testGroup "Linear-Extrusion" [        st "1"            "linear_extrude(height=10.0,twist=0.0,scale=[1.0,1.0],slices=10,convexity=10)circle(1.0);"@@ -113,20 +119,20 @@        ],       testGroup "Surface" [-       st "Normal" "surface(file=\"test.dat\",convexity=5);"-          (surface "test.dat" False 5),-       st "Inverted" "surface(file=\"test.dat\",invert=true,convexity=5);"-          (surface "test.dat" True 5)	-- Requires  2014.QX+       st "Normal" "surface(file=\"test.dat\",convexity=5);" $+          surface "test.dat" False 5,+       st "Inverted" "surface(file=\"test.dat\",invert=true,convexity=5);" $+          surface "test.dat" True 5	-- Requires  2014.QX        ]      ],         testGroup "2d-primitives" [     testGroup "Squares" [-       st "rectangle" "square([2.0,3.0]);"   (rectangle 2 3),-       st "square"    "square([2.0,2.0]);"   (square 2)+       st "rectangle" "square([2.0,3.0]);" $ rectangle 2 3,+       st "square"    "square([2.0,2.0]);" $ square 2        ],     testGroup "Circles" [-      st "1" "circle(1.0);"         (circle 1 def),+      st "1" "circle(1.0);"        $ circle 1 def,       st "2" "circle(2.0,$fn=100);" (circle 2 $ fn 100),       st "3" "circle(2.0,$fa=5.0);" (circle 2 $ fa 5),       st "4" "circle(2.0,$fs=0.1);" (circle 2 $ fs 0.1)@@ -134,8 +140,8 @@     testGroup "Misc" [       st "import" "import(\"test.dxf\");"   (solid $ importFile "test.dxf"),       st "polygon"-         "polygon(points=[[0.0,0.0],[100.0,0.0],[0.0,100.0],[10.0,10.0],[80.0,10.0],[10.0,80.0]],paths=[[0,1,2],[3,4,5]],convexity=10);"-         (polygon 10 [[(0,0),(100,0),(0,100)],[(10,10),(80,10),(10,80)]]),+         "polygon(points=[[0.0,0.0],[100.0,0.0],[0.0,100.0],[10.0,10.0],[80.0,10.0],[10.0,80.0]],paths=[[0,1,2],[3,4,5]],convexity=10);" $+         polygon 10 [[(0,0),(100,0),(0,100)],[(10,10),(80,10),(10,80)]],       st "projection"          "projection(cut=false)scale([10.0,10.0,10.0])difference(){translate([0.0,0.0,1.0])cube([1.0,1.0,1.0]);translate([0.25,0.25,0.0])cube([0.5,0.5,3.0]);}"          (projection False . scale (10, 10, 10) . difference (up 1 (cube 1))@@ -207,6 +213,46 @@        (var (fs 0.1) [sphere 2 $ fs 0.1])     ], +  testGroup "Errors" [+    testCase "Polygon Pointcount"+    . assertError "Polygon has fewer than 3 points." $+        polygon 1 [[(0, 0), (0, 1)]],+    testCase "Polygon Linearity"+    . assertError "Points in polygon are collinear." $+        polygon 1 [[(0, 0), (0, 1), (0, 2)]],+    testCase "Polyhedron Linearity"+    . assertError "Some face has collinear points." $+        polyhedron 1 [[(0, 0, 0), (1, 0, 0), (2, 0, 0)]],+    testCase "Polyhedron Planarity" . assertError "Some face isn't coplanar." $+        polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 10, 10)],+                        [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],+                        [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],+                        [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],+                        [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (0, 0, -10)]],+    testCase "Polyhedron Edges" . assertError "Some edges are not in two faces." $+        polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],+                      [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],+                      [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],+                      [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],+                      [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],+                      [(-10, -10, 0), (10, -10, 0), (-10, 20, 0)]],+    testCase "Polyhedron Faces"+    . assertError "Some faces have different orientation." $+        polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],+                      [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],+                      [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],+                      [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],+                      [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],+                      [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]],+    testCase "Polyhedron Orientation"+    . assertError "Face orientations are counterclockwise." $+        polyhedron 1 [[(10, -10, 0), (10, 10, 0), (0, 0, 10)],+                      [(-10, -10, 0), (10, -10, 0), (0, 0, 10)],+                      [(-10, 10, 0), (-10, -10, 0), (0, 0, 10)],+                      [(10, 10, 0), (-10, 10, 0), (0, 0, 10)],+                      [(10, 10, 0), (10, -10, 0), (-10, 10, 0)],+                      [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]]+    ],    testGroup "Combinations" [     st "union" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"