add polyhedron support.

Examples/example26-Polyhedron.scad

@@ -0,0 +1,24 @@
+module pyramid(base, height) {
+  half = base / 2;
+
+  polyhedron(
+    points = [
+      [-half, -half, 0],
+      [ half, -half, 0],
+      [ half,  half, 0],
+      [-half,  half, 0],
+      [0, 0, height]
+    ],
+    faces = [
+      [0, 1, 2, 3],
+      [0, 1, 4],
+      [1, 2, 4],
+      [2, 3, 4],
+      [3, 0, 4]
+    ]
+  );
+}
+
+pyramid_base = 12;
+pyramid_height = 14;
+pyramid(pyramid_base, pyramid_height);

Graphics/Implicit/Canon.hs

@@ -83,6 +83,7 @@ import Graphics.Implicit.Definitions
   , SymbolicObj3
       ( Cube
       , Cylinder
+      , Polyhedron
       , Extrude
       , ExtrudeM
       , ExtrudeOnEdgeOf
@@ -176,6 +177,7 @@ fmapObj3
 fmapObj3 f _ _ (Cube v) = f $ Cube v
 fmapObj3 f _ _ (Sphere r) = f $ Sphere r
 fmapObj3 f _ _ (Cylinder r1 r2 h) = f $ Cylinder r1 r2 h
+fmapObj3 f _ _ (Polyhedron points faces) = f $ Polyhedron points faces
 fmapObj3 f _ _ (Torus r1 r2) = f $ Torus r1 r2
 fmapObj3 f _ _ (Ellipsoid a b c) = f $ Ellipsoid a b c
 fmapObj3 f _ _ (BoxFrame b e) = f $ BoxFrame b e
@@ -239,6 +241,7 @@ instance EqObj SymbolicObj3 where
   Ellipsoid a1 b1 c1 =^= Ellipsoid a2 b2 c2 = a1 == a2 && b1 == b2 && c1 == c2
   Cylinder r1a r2a ha =^= Cylinder r1b r2b hb = r1a == r1b && r2a == r2b && ha == hb
   BoxFrame b1 e1 =^= BoxFrame b2 e2 = b1 == b2 && e1 == e2
+  Polyhedron p1 f1 =^= Polyhedron p2 f2 = p1 == p2 && f1 == f2
   Link a1 b1 c1 =^= Link a2 b2 c2 = a1 == a2 && b1 == b2 && c1 == c2
   Rotate3 x a =^= Rotate3 y b = x == y && a =^= b
   Transform3 x a =^= Transform3 y b = x == y && a =^= b

Graphics/Implicit/Definitions.hs

@@ -56,6 +56,7 @@ module Graphics.Implicit.Definitions (
         Cube,
         Sphere,
         Cylinder,
+        Polyhedron,
         Rotate3,
         Transform3,
         Torus,
@@ -331,6 +332,7 @@ data SymbolicObj3 =
       Cube ℝ3 -- rounding, size.
     | Sphere ℝ -- radius
     | Cylinder ℝ ℝ ℝ --
+    | Polyhedron [ℝ3] [(ℕ,ℕ,ℕ)] -- virtexes, triangles-by-index
     -- Simple transforms
     | Rotate3 (Quaternion ℝ) SymbolicObj3
     | Transform3 (M44 ℝ) SymbolicObj3
@@ -364,6 +366,7 @@ instance Show SymbolicObj3 where
     -- centered.
     Cube sz -> showCon "cube" @| False @| sz
     Sphere d -> showCon "sphere" @| d
+    Polyhedron points tris -> showCon "polyhedron" @| points @| tris
     BoxFrame b e -> showCon "boxFrame" @| b @| e
     Link le r1 r2 -> showCon "link" @| le @| r1 @| r2
     -- NB: The arguments to 'Cylinder' are backwards compared to 'cylinder' and

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -11,8 +11,9 @@ module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
 
 import Prelude((.), fmap, Either(Left, Right), ($), (*), (-), (/), pi, error, (+), (==), take, floor, (&&), const, (<>), (<$>))
 
-import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2, Slice), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, BoxFrame, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid, Link), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
-import Graphics.Implicit.Export.TextBuilderUtils(Text, bf)
+import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2, Slice), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Polyhedron, BoxFrame, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid, Link), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
+
+import Graphics.Implicit.Export.TextBuilderUtils(Text, bf, bℕ)
 
 -- For constructing vectors of ℝs.
 import Linear (V2(V2), V3(V3), V4(V4))
@@ -131,11 +132,16 @@ buildS3 _ (Cube (V3 w d h)) = call "cube" [pretty $ bf w, pretty $ bf d, pretty
 
 buildS3 _ (Sphere r) = callNaked "sphere" ["r = " <> pretty (bf r)] []
 
-buildS3 _ (Cylinder h r1 r2) = callNaked "cylinder" [
-                              "r1 = " <> pretty (bf r1)
-                             ,"r2 = " <> pretty (bf r2)
-                             , pretty $ bf h
-                             ] []
+buildS3 _ (Cylinder h r1 r2) = callNaked "cylinder" ["r1 = " <> pretty (bf r1)
+                                                    ,"r2 = " <> pretty (bf r2)
+                                                    , pretty $ bf h
+                                                    ] []
+
+buildS3 _ (Polyhedron points tris) = callNaked "polyhedron" ["points = [" <> (fold $ intersperse "," $ renderPoint <$> points) <> "] faces = [" <> (fold $ intersperse "," $ renderTri <$> tris) <> "]" ] []
+  where
+    renderPoint (V3 v1 v2 v3) = "[" <> pretty (bf v1) <> "," <> pretty (bf v2) <> "," <> pretty (bf v3) <> "]"
+    renderTri (n1,n2,n3) = "[" <> pretty (bℕ n1) <> "," <> pretty (bℕ n2) <> "," <> pretty (bℕ n3) <> "]"
+
 buildS3 res (Rotate3 q obj) =
   let (V3 x y z) = quaternionToEuler q
    in call "rotate" [pretty $ bf (rad2deg x), pretty $ bf (rad2deg y), pretty $ bf (rad2deg z)] [buildS3 res obj]
@@ -180,7 +186,7 @@ buildS2 res (Shared2 obj) = buildShared res obj
 
 buildS2 _ (Circle r) = call "circle" [pretty $ bf r] []
 
-buildS2 _ (Polygon points) = call "polygon" (fmap bvect points) []
+buildS2 _ (Polygon points) = call "polygon" (bvect <$> points) []
 
 buildS2 res (Rotate2 r obj)     = call "rotate" [pretty $ bf (rad2deg r)] [buildS2 res obj]
 

Graphics/Implicit/Export/TextBuilderUtils.hs

@@ -13,6 +13,7 @@ module Graphics.Implicit.Export.TextBuilderUtils (
      toLazyText,
      -- some special case Builders.
      bf,
+     bℕ,
      buildTruncFloat,
      buildℕ,
      buildInt
@@ -37,6 +38,10 @@ toLazyText = toLazyTextWith defaultChunkSize
 bf :: ℝ -> Text
 bf value = toLazyText . formatRealFloat Exponent Nothing $ fromℝtoFloat value
 
+-- | Serialize a value as an Integer.
+bℕ :: ℕ -> Text
+bℕ = toLazyText . decimal
+
 -- | Serialize a float with four decimal places
 buildTruncFloat :: ℝ -> Builder
 buildTruncFloat = formatRealFloat Fixed $ Just 4

Graphics/Implicit/ExtOpenScad/Primitives.hs

@@ -15,7 +15,7 @@
 -- Export one set containing all of the primitive modules.
 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, (/=), (||), not, null, fmap, (<>), otherwise, error, (<*>), (<$>))
+import Prelude((.), Either(Left, Right), Bool(True, False), Maybe(Just, Nothing), ($), pure, show, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, (/=), (||), not, null, fmap, (<>), otherwise, error, (<*>), (<$>))
 
 import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1), fromℕtoℝ, isScaleID)
 
@@ -27,10 +27,12 @@
 
 import Graphics.Implicit.ExtOpenScad.Util.OVal (OTypeMirror, caseOType, divideObjs, (<||>))
 
-import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC)
+import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC, warnC)
 
 -- 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 (withRounding, sphere, rect3, rect, translate, circle, polygon, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, slice, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone)
+import qualified Graphics.Implicit.Primitives as Prim (withRounding, sphere, rect3, rect, translate, circle, polygon, polyhedron, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, slice, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone)
+
+import Data.List (concatMap)
 
 import Control.Monad (when, mplus)
 
@@ -60,6 +62,7 @@
   , onModIze torus [([("r1", noDefault), ("r2", hasDefault)], noSuite)]
   , onModIze ellipsoid [([("a", noDefault), ("b", hasDefault), ("c", hasDefault)], noSuite)]
   , onModIze polygon [([("points", noDefault)], noSuite)]
+  , onModIze polyhedron [([("points", noDefault), ("faces", noDefault)], noSuite)]
   , onModIze union [([("r", hasDefault)], requiredSuite)]
   , onModIze intersect [([("r", hasDefault)], requiredSuite)]
   , onModIze difference [([("r", hasDefault)], requiredSuite)]
@@ -265,6 +268,25 @@
         in shift obj3
         else shift $ Prim.cylinder2 r1 r2 dh
 
+polyhedron :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
+polyhedron = moduleWithoutSuite "polyhedron" $ \_ _ -> do
+    example "polyhedron(points=[[0,0,0], [2,0,0], [2,2,0], [0,2,0], [1, 1, 2]], faces=[[0,1,2,3], [0,5,1], [1,5,2], [2,5,3], [3,5,4], [4,5,0]]);"
+    -- arguments
+    points :: [ℝ3] <- argument "points" `defaultTo` [] `doc` "list of points to construct faces from"
+    faces :: [[ℕ]] <- argument "faces" `defaultTo` [] `doc` "list of sets of indices into points, used to create faces on the polyhedron."
+    -- A tri is constructed of three indexes into the points.
+    -- This decomposes our faces into tris.
+    let
+      tris = concatMap trianglesFromFace faces
+      in
+      addObj3 $ Prim.polyhedron points tris
+      where
+        -- FIXME: use warnC here, instead of error.
+        trianglesFromFace :: [ℕ] -> [(ℕ,ℕ,ℕ)]
+        trianglesFromFace [p1,p2,p3] = [(p1,p2,p3)]
+        trianglesFromFace (p1:p2:p3:xs) = ((p1,p2,p3):trianglesFromFace (p1:p3:xs))
+        trianglesFromFace ys = error $ "too few points:" <> (show ys) <> "\n"
+
 cone :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 cone = moduleWithoutSuite "cone" $ \_ _ -> do
     example "cone(r=10, h=30, center=true);"
@@ -351,8 +373,7 @@
         else Prim.polygon
             [V2 (r*cos θ) (r*sin θ) | θ <- [2*pi*fromℕtoℝ n/fromℕtoℝ sides | n <- [0 .. sides - 1]]]
 
--- | FIXME: 3D Polygons?
---   FIXME: handle rectangles that are not grid alligned.
+-- | FIXME: handle rectangles that are not grid alligned.
 --   FIXME: allow for rounding of polygon corners, specification of vertex ordering.
 --   FIXME: polygons have to have more than two points, or do not generate geometry, and generate an error.
 polygon :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))

Graphics/Implicit/ObjectUtil/GetBox3.hs

@@ -5,13 +5,19 @@
 
 module Graphics.Implicit.ObjectUtil.GetBox3 (getBox3) where
 
-import Prelude(uncurry, pure, Bool(False), Either (Left, Right), (==), max, (/), (-), (+), fmap, unzip, ($), (<$>), (.), minimum, maximum, min, (>), (*), (<), abs, either, const, otherwise, take, fst, snd)
+import Prelude(foldl, uncurry, pure, Bool(False), Either (Left, Right), (==), max, (/), (-), (+), fmap, unzip, ($), (<$>), (.), minimum, maximum, min, (>), (*), (<), abs, either, const, otherwise, take, fst, snd)
+
+-- For Maybe types.
+import Data.Maybe (fromMaybe, Maybe(Just, Nothing))
+
+import Linear (V2(V2), V3(V3))
+import qualified Linear (rotate, point, normalizePoint, (!*))
 
 import Graphics.Implicit.Definitions
     ( Fastℕ,
       fromFastℕ,
       ExtrudeMScale(C2, C1),
-      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude, Torus, Ellipsoid, BoxFrame, Link),
+      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Polyhedron, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude, Torus, Ellipsoid, BoxFrame, Link),
       Box3,
       ℝ,
       fromFastℕtoℝ,
@@ -21,9 +27,6 @@ import Graphics.Implicit.ObjectUtil.GetBox2 (getBox2, getBox2R)
 
 import Graphics.Implicit.ObjectUtil.GetBoxShared (corners, pointsBox, getBoxShared)
 
-import Linear (V2(V2), V3(V3))
-import qualified Linear
-
 -- FIXME: many variables are being ignored here. no rounding for intersect, or difference.. etc.
 
 -- Get a Box3 around the given object.
@@ -33,6 +36,15 @@ getBox3 (Shared3 obj) = getBoxShared obj
 getBox3 (Cube size) = (pure 0, size)
 getBox3 (Sphere r) = (pure (-r), pure r)
 getBox3 (Cylinder h r1 r2) = (V3 (-r) (-r) 0, V3 r r h ) where r = max r1 r2
+getBox3 (Polyhedron points _) = (minimum_point, maximum_point)
+  where
+    (minimum_point, maximum_point) = fromMaybe (V3 0 0 0, V3 0 0 0) maybeVs
+    maybeVs :: (Maybe (V3 ℝ,V3 ℝ))
+    maybeVs = foldl findMinMax Nothing points
+      where
+        findMinMax :: (Maybe (V3 ℝ,V3 ℝ)) -> V3 ℝ -> (Maybe (V3 ℝ,V3 ℝ))
+        findMinMax Nothing newV3 = Just (newV3, newV3)
+        findMinMax (Just (V3 minx miny minz,V3 maxx maxy maxz)) (V3 newx newy newz) = Just (V3 (min minx newx) (min miny newy) (min minz newz), V3 (max maxx newx) (max maxy newy) (max maxz newz))
 getBox3 (Torus r1 r2) =
   let r = r1 + r2
   in (V3 (-r) (-r) (-r2), V3 r r r2)