diff --git a/Graphics/OpenSCAD.hs b/Graphics/OpenSCAD.hs --- a/Graphics/OpenSCAD.hs +++ b/Graphics/OpenSCAD.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} {- | Module : Graphics.OpenSCAD @@ -16,7 +16,7 @@ should always be valid OpenSCAD. If you manage to generate OpenSCAD source that causes OpenSCAD to complain, please open an issue. -The primary affect of this is that Graphics.OpenSCAD distinguishes +The primary effect of this is that Graphics.OpenSCAD distinguishes between 2d and 3d 'Model's. If you want to mix them, you must explicitly convert between them. While two-dimensional model creation could be polymorphic functions that create either, so that such models @@ -108,11 +108,13 @@ Model2d, Model3d, Vector2d, Vector3d, -- ** Other type aliases Facet, TransMatrix, + -- ** Type for 'unsafePolyhedron' 'Sides' argument + Sides(..), -- * Primitive creation -- ** 'Model2d's - rectangle, square, circle, polygon, projection, importFile, + rectangle, square, circle, polygon, unsafePolygon, projection, importFile, -- ** 'Model3d's - sphere, box, cube, cylinder, obCylinder, polyhedron, + sphere, box, cube, cylinder, obCylinder, polyhedron, unsafePolyhedron, multMatrix, linearExtrude, rotateExtrude, surface, solid, -- * Functions -- ** Combinations @@ -143,8 +145,8 @@ 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 -> a -- cross product + (#-) :: a -> a -> a -- difference between two vectors (#.) :: a -> a -> Double -- dot product v1 #. v2 = sum $ zipWith (*) (toList v1) (toList v2) @@ -218,6 +220,7 @@ | Offset Double Join Shape deriving Show +-- | The third argument to unsafePolyhedron is a 'Sides'. data Sides = Faces [[Int]] | Triangles [[Int]] deriving Show -- A 'Solid' is a 3-dimensional primitive to be used in a 'Model3d'. @@ -282,20 +285,28 @@ projection :: Bool -> Model3d -> Model2d projection c s = Shape $ Projection c s --- | Turn a list of list of 'Vector2d's and an int into @polygon --- /points path convexity/@. The argument to polygon is the list of +-- | Turn a list of lists of 'Vector2d's and an Int into @polygon +-- /convexity points path/@. The argument to polygon is the list of -- paths that is the second argument to the OpenSCAD polygon function, -- except the points are 'Vector2d's, not references to 'Vector2d's in -- 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 +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 +-- | This provides direct access to the OpenScad @polygon@ command for +-- performance reasons. This version uses the OpenSCAD arguments: +-- @polygon /convexity points path/@ to allow client code to save +-- space. However, it bypasses all the checks done by +-- 'polygon', which need the other representation. +unsafePolygon :: Int -> [Vector2d] -> [[Int]] -> Model2d +unsafePolygon convexity points paths = Shape $ Polygon convexity points paths + -- | 'offset' a 'Model2d's edges by @offset /delta join/@. offset :: Double -> Join -> Model2d -> Model2d offset d j (Shape s) = Shape $ Offset d j s @@ -323,7 +334,7 @@ obCylinder r1 h r2 f= Solid $ ObCylinder r1 h r2 f -- | Turn a list of list of 'Vector3d's and an int into @polyhedron --- /points 'Sides' convexity/@. The argument to polyhedron is the list +-- /convexity points 'Sides'/@. The argument to polyhedron is the list -- 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 @@ -366,6 +377,15 @@ | all ((== 3) . length) ss = Triangles ss | otherwise = error "Some faces have fewer than 3 points." +-- | This provides direct access to the OpenSCAD @polyhedron@ command +-- for performance reasons. This version uses the OpenSCAD arguments: +-- @polyhedron /convexity points 'Sides'/@ to allow client code to +-- save space. However, it bypasses all the checks done by +-- 'polyhedron', which needs the other representation. +unsafePolyhedron :: Int -> [Vector3d] -> Sides -> Model3d +unsafePolyhedron convexity points sides = Solid $ Polyhedron convexity points sides + + -- | Transform a 'Model3d' with a 'TransMatrix' multMatrix :: TransMatrix -> Model3d -> Model3d multMatrix t m = Solid $ MultMatrix t m @@ -430,12 +450,12 @@ color = Color -- | Render a 'Model' in a transparent color. This uses the --- 'Data.Coulor.AphaColour' color model. +-- 'Data.Colour.AlphaColour' color model. transparent :: Vector v => AlphaColour Double -> Model v -> Model v transparent = Transparent -- | A 'translate' that just goes up, since those seem to be common. -up :: Double -> Model3d -> Model3d +up :: Double -> Model3d -> Model3d up f = translate (0, 0, f) @@ -604,10 +624,14 @@ instance Vector v => Monoid (Model v) where mempty = Solid $ Box 0 0 0 + mappend (Solid (Box 0 0 0)) b = b + mappend a (Solid (Box 0 0 0)) = a mappend a b = union [a, b] - mconcat = union + mconcat [a] = a + mconcat as = union as --- | You can use '(#)' to write transformations in a more readable postfix form, + +-- | You can use '(#)' to write transformations in a more readable postfix form, -- cube 3 # color red # translate (-3, -3, -3) infixl 8 # (#) = flip ($) diff --git a/Graphics/OpenSCAD/Unicode.hs b/Graphics/OpenSCAD/Unicode.hs --- a/Graphics/OpenSCAD/Unicode.hs +++ b/Graphics/OpenSCAD/Unicode.hs @@ -17,7 +17,8 @@ infixl 6 ∪ infixr 6 ∩ infixl 9 ∖ -infixl 9 ∆ +infixl 9 ⊖ +infixl 9 ⊕ -- | (∪) = 'union' -- @@ -37,9 +38,14 @@ (∖):: Vector v => Model v -> Model v -> Model v (∖) = difference --- | (∆) = Symmetric difference +-- | (⊖) = Symmetric difference -- --- U+2206, INCREMENT -(∆) :: Vector v => Model v -> Model v -> Model v -a ∆ b = (a ∖ b) ∪ (b ∖ a) +-- U+2296, CIRCLED MINUS +(⊖) :: Vector v => Model v -> Model v -> Model v +a ⊖ b = (a ∖ b) ∪ (b ∖ a) +-- | (ࣷ) = 'minkowski' +-- +-- U+2295, CIRCLED PLUS +(⊕) :: Vector v => Model v -> Model v -> Model v +a ⊕ b = minkowski [a, b] diff --git a/OpenSCAD.cabal b/OpenSCAD.cabal --- a/OpenSCAD.cabal +++ b/OpenSCAD.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: OpenSCAD -version: 0.3.0.1 +version: 0.3.0.2 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 @@ -24,7 +24,7 @@ other-extensions: UnicodeSyntax build-depends: base > 4.5 && < 5.0, colour >=2.3 && < 2.4, - filepath >=1.3 && < 1.4, + filepath >=1.3 && < 1.5, semigroups >= 0.15 && < 1.0, containers >= 0.5 -- hs-source-dirs: @@ -53,5 +53,5 @@ source-repository this type: fossil - location: https://code.google.com/p/graphics-openscad/ - tag: 0.3.0.1 + location: https://chiselapp.com/user/mwm/repository/OpenSCAD/ + tag: 0.3.0.2 diff --git a/UnitTest.hs b/UnitTest.hs --- a/UnitTest.hs +++ b/UnitTest.hs @@ -79,7 +79,13 @@ [(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), (10, -10, 0), (10, 10, 0)]], + st "unsafePolyhedron" + "polyhedron(points=[[10.0,10.0,0.0],[10.0,-10.0,0.0],[-10.0,-10.0,0.0],[-10.0,10.0,0.0],[0.0,0.0,10.0]],faces=[[0,1,4],[1,2,4],[2,3,4],[3,0,4],[1,0,3],[2,1,3]],convexity=1);" + (unsafePolyhedron 1 [(10.0,10.0,0.0),(10.0,-10.0,0.0),(-10.0,-10.0,0.0), + (-10.0,10.0,0.0),(0.0,0.0,10)] + $ Faces [[0,1,4],[1,2,4],[2,3,4],[3,0,4],[1,0,3], + [2,1,3]]) ], testGroup "Linear-Extrusion" [ st "1" @@ -142,6 +148,10 @@ 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 "unsafePolygon" + "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=1);" + (unsafePolygon 1 [(0,0),(100,0),(0,100),(10,10),(80,10),(10,80)] + [[0,1,2],[3,4,5]]), 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)) @@ -282,6 +292,8 @@ (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 "Monoid 3 3d" "sphere(1.1,$fs=0.1);" (mconcat [sphere 1.1 $ fs 0.1]), + st "Monoid 3 2d" "square([1.0,1.0]);" (mconcat [square 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),