OpenSCAD-0.2.1.1: UnitTest.hs
#!/usr/bin/env runghc
module Main where
import Data.Monoid
import Test.HUnit
import Test.Framework
import Test.Framework.Providers.HUnit
import Graphics.OpenSCAD
import Data.Colour (withOpacity)
import Data.List.NonEmpty (fromList)
import Data.Semigroup (sconcat)
sw = concat . words
st n e a = testCase n $ (sw e) @=?(sw $ render a)
{- About the test result values.
Running "cabal test" does not verify that the results do the intended
thing in OpenSCAD. Possibly we'll add shell tests for that at some
point, but not yet.
For now, if you change or add strings, please manually copy them into
OpenSCAD and make sure they do what you want the Model data structure
that they are testing does.
-}
tests = [
testGroup "3d-primitives" [
testGroup "Spheres" [
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)
],
testGroup "Cylinders" [
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 "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);"
(obCylinder 1 2 2 $ fn 10),
st "4" "cylinder(r1=1.0,h=2.0,r2=2.0,$fa=30.0);"
(obCylinder 1 2 2 $ fa 30)
],
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)]]),
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)]])
],
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);"
(linearExtrude 10 0 (1, 1) 10 10 def $ circle 1 def),
st "2"
"linear_extrude(height=10.0,twist=100.0,scale=[1.0,1.0],slices=10,convexity=10)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 100 (1, 1) 10 10 def $ translate (2, 0)
$ circle 1 def),
st "3"
"linear_extrude(height=10.0,twist=500.0,scale=[1.0,1.0],slices=10,convexity=10)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 500 (1, 1) 10 10 def $ translate (2, 0)
$ circle 1 def),
st "4"
"linear_extrude(height=10.0,twist=360.0,scale=[1.0,1.0],slices=100,convexity=10)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 360 (1, 1) 100 10 def $ translate (2, 0)
$ circle 1 def),
st "5"
"linear_extrude(height=10.0,twist=360.0,scale=[1.0,1.0],slices=100,convexity=10,$fn=100)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 360 (1, 1) 100 10 (fn 100) $ translate (2, 0)
$ circle 1 def),
st "6"
"linear_extrude(height=10.0,twist=0.0,scale=[3.0,3.0],slices=100,convexity=10)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 0 (3, 3) 100 10 def $ translate (2, 0) $ circle 1 def),
st "7"
"linear_extrude(height=10.0,twist=0.0,scale=[1.0,5.0],slices=100,convexity=10,$fn=100)translate([2.0,0.0])circle(1.0);"
(linearExtrude 10 0 (1, 5) 100 10 (fn 100) $ translate (2, 0)
$ circle 1 def)
],
testGroup "Rotated-Extrusion" [
st "1" "rotate_extrude(convexity=10)translate([2.0,0.0])circle(1.0);"
(rotateExtrude 10 def $ translate (2, 0) $ circle 1 def),
st "2"
"rotate_extrude(convexity=10,$fn=100)translate([2.0,0.0])circle(1.0,$fn=100);"
(rotateExtrude 10 (fn 100) $ translate (2, 0) $ circle 1 $ fn 100)
],
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
]
],
testGroup "2d-primitives" [
testGroup "Squares" [
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 "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)
],
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)]]),
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))
$ translate (0.25, 0.25, 0) (box 0.5 0.5 3))
]
],
testGroup "Transformations" [
testGroup "Size changes" [
st "scale 1" "scale([0.5,1.0,2.0])cube([1.0,1.0,1.0]);"
(scale (0.5, 1, 2) $ cube 1),
st "scale 2" "scale([0.5,2.0])square([1.0,1.0]);"
(scale (0.5, 2) $ rectangle 1 1),
st "resize 1" "resize([10.0,20.0])square([2.0,2.0]);"
(resize (10, 20) $ square 2),
st "resize 2" "resize([10.0,20.0,30.0])cube([2.0,2.0,2.0]);"
(resize (10, 20, 30) $ cube 2)
],
testGroup "Rotations" [
st "1" "rotate([180.0,0.0,0.0])cube([2.0,2.0,2.0]);"
(rotate (180, 0, 0) $ cube 2),
st "2" "rotate([0.0,180.0,0.0])cube([2.0,2.0,2.0]);"
(rotate (0, 180, 0) $ cube 2),
st "3" "rotate([0.0,180.0,180.0])cube([2.0,2.0,2.0]);"
(rotate (0, 180, 180) $ cube 2),
st "4" "rotate([180.0,0.0])square([2.0,1.0]);"
(rotate (180, 0) $ rectangle 2 1),
st "5" "rotate([0.0,180.0])square([2.0,1.0]);"
(rotate (0, 180) $ rectangle 2 1)
],
testGroup "Mirrors" [
st "1" "mirror([1.0,0.0,0.0])cube([2.0,2.0,2.0]);"
(mirror (1, 0, 0) $ cube 2),
st "2" "mirror([0.0,1.0,0.0])cube([2.0,2.0,2.0]);"
(mirror (0, 1, 0) $ cube 2),
st "3" "rotate([0.0,1.0,1.0])cube([2.0,2.0,2.0]);"
(rotate (0, 1, 1) $ cube 2),
st "4" "mirror([1.0,0.0])square([2.0,1.0]);"
(mirror (1, 0) $ rectangle 2 1),
st "2" "mirror([0.0,1.0])square([2.0,1.0]);"
(mirror (0, 1) $ rectangle 2 1)
],
st "multmatrix"
"multmatrix([[1.0,0.0,0.0,10.0],[0.0,1.0,0.0,20.0],[0.0,0.0,1.0,30.0],[0.0,0.0,0.0,1.0]])cylinder(r=2.0,h=3.0);"
(multMatrix ( (1, 0, 0, 10),
(0, 1, 0, 20),
(0, 0, 1, 30),
(0, 0, 0, 1) ) $ cylinder 2 3 def),
testGroup "Colors" [
st "color 1" "color([1.0,0.0,0.0])cube([1.0,1.0,1.0]);" (color red $ cube 1),
st "color 2" "color([1.0,0.0,0.0])square([1.0,1.0]);"
(color red $ square 1),
st "transparent 1" "color([1.0,0.0,0.0,0.7])cube([1.0,1.0,1.0]);"
(transparent (red `withOpacity` 0.7) $ cube 1),
st "transparent 2" "color([1.0,0.0,0.0,0.7])square([1.0,1.0]);"
(transparent (red `withOpacity` 0.7) $ square 1)
]
],
testGroup "Facets" [
st "facet 1" "assign($fn=100){sphere(2.0,$fn=100);}"
(var (fn 100) [sphere 2 $ fn 100]),
st "facet 2" "assign($fa=5.0){sphere(2.0,$fa=5.0);}"
(var (fa 5) [sphere 2 $ fa 5]),
st "facet 3" "assign($fs=0.1){sphere(2.0,$fs=0.1);}"
(var (fs 0.1) [sphere 2 $ fs 0.1])
],
testGroup "Combinations" [
st "union" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(union [cube 1, sphere 1.1 $ fs 0.1]),
st "difference" "difference(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(difference (cube 1) . sphere 1.1 $ fs 0.1),
st "intersection" "intersection(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(intersection [cube 1, sphere 1.1 $ fs 0.1]),
st "minkowski"
"minkowski(){cube([10.0,10.0,10.0]);cylinder(r=2.0,h=1.1,$fn=50);}"
(minkowski [cube 10, cylinder 2 1.1 $ fn 50]),
st "hull" "hull(){translate([15.0,10.0])circle(10.0);circle(10.0);}"
(hull [circle 10 def # translate (15, 10), circle 10 def])
],
testGroup "Haskell" [
st "# 3d" "translate([-3.0,-3.0,-3.0])color([1.0,0.0,0.0])cube([3.0,3.0,3.0]);"
(cube 3 # color red # translate (-3, -3, -3)),
st "# 2d"
"translate([3.0,3.0])color([1.0,0.6470588235294119,0.0])square([2.0,2.0]);"
(square 2 # color orange # translate (3, 3)),
st "Monoid 1 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(cube 1 <> sphere 1.1 (fs 0.1)),
st "Monoid 1 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
(square 1 <> circle 1.1 (fs 0.1)),
st "Monoid 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(mconcat [cube 1, sphere 1.1 $ fs 0.1]),
st "Monoid 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
(mconcat [square 1, circle 1.1 $ fs 0.1]),
st "Semigroup 1 3d" "cube([0.0,0.0,0.0]);" (solid mempty),
-- should we export a "shape" function?
st "Semigroup 1 2d" "cube([0.0,0.0,0.0]);" (mempty :: Model2d),
st "Semigroup 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(mappend (cube 1) $ sphere 1.1 (fs 0.1)),
st "Semigroup 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
(mappend (square 1) $ circle 1.1 (fs 0.1)),
st "Semigroup 3 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
(sconcat $ fromList [cube 1, sphere 1.1 $ fs 0.1]),
st "Semigroup 3 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
(sconcat $ fromList [square 1, circle 1.1 $ fs 0.1])
]
]
main = defaultMain tests