From ee8373d9a9175f5f4f6553b9e253daf62e76610c Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 13 Mar 2019 01:58:08 -0400 Subject: bring in OpenSCAD (forward-ported) --- openscad/Graphics/OpenSCAD.hs | 638 ++++++++++++++++++++++++++++++++++ openscad/Graphics/OpenSCAD/Unicode.hs | 51 +++ openscad/LICENSE | 30 ++ openscad/OpenSCAD.cabal | 57 +++ openscad/README.md | 28 ++ openscad/Setup.hs | 2 + openscad/UnitTest.hs | 311 +++++++++++++++++ package.yaml | 1 + stack.yaml | 1 + 9 files changed, 1119 insertions(+) create mode 100644 openscad/Graphics/OpenSCAD.hs create mode 100644 openscad/Graphics/OpenSCAD/Unicode.hs create mode 100644 openscad/LICENSE create mode 100644 openscad/OpenSCAD.cabal create mode 100644 openscad/README.md create mode 100644 openscad/Setup.hs create mode 100644 openscad/UnitTest.hs diff --git a/openscad/Graphics/OpenSCAD.hs b/openscad/Graphics/OpenSCAD.hs new file mode 100644 index 0000000..e4efe7b --- /dev/null +++ b/openscad/Graphics/OpenSCAD.hs @@ -0,0 +1,638 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +{- | +Module : Graphics.OpenSCAD +Description : Type-checked wrappers for the OpenSCAD primitives. +Copyright : © Mike Meyer, 2014 +License : BSD4 +Maintainer : mwm@mired.org +Stability : experimental + += Overview + +The Graphics.OpenSCAD module provides abstract data types for creating +OpenSCAD model definitions calls, along with a function to render it +as a string, and some utilities. The primary goal is that the output +should always be valid OpenSCAD. If you manage to generate OpenSCAD +source that causes OpenSCAD to complain, please open an issue. + +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 +could be treated as either 2d or 3d, you'd still have to explicitly +convert models whose type was fixed as 2d by a transformation, and +'render' wouldn't work if the type was still ambiguous, ala @render $ +square 2@. + += Usage + +Standard usage is to have a @main@ function that looks like: + +@ +main = draw $ /Solid/ +@ +or +@ +main = drawL $ [/Solid/] +@ + +and then set your IDE's compile command to use @runhaskell@ or +equivalent to run your code and send the output to a .scad file. Open +that file in OpenSCAD, and set it to automatically reload if the file +changes. Recompiling your program will cause the model to be loaded +and displayed by OpenSCAD. + +The type constructors are not exported, with functions being exported +in their stead. This allows extra checking to be done on those that +need it. It also provides consistency, as otherwise you'd have to +remember whether 'box' is a constructor or a convenience function, +etc. + +Because of this, the constructors are not documented, the exported +functions are. The documentation is generally just the corresponding +OpenSCAD function name, along with the names of the arguments from the +OpenSCAD documentation. If no OpenSCAD function name is given, then +it's the same as the 'Graphics.OpenSCAD' function. You should check +the OpenSCAD documentation for usage information. + += Oddities + +'importFile' has been left polymorphic. I couldn't find a sane way to +check that you're importing the right file type, so detecting such +errors - including importing a 3d file and trying to extrude it - have +to be left up to OpenSCAD in any case. So for now, there's just +'importFile'. This does create the oddity that if you import a file +and try and render it without doing something to indicate how many +dimensions it has (one of the transformations, an extrusion or +projection, or 'solid') you'll get a compile error because the type is +ambiguous. Later, this may turn into @import2d@ and @import3d@. + +The interfaces for 'polygon's and 'polyhedron's is seriously different +from the OpenSCAD interface. Rather than expecting you to enter a list +of points and then references to them, you just enter the points +directly. If you really want to do it the OpenSCAD way, you can do +something like: + +@ +draw $ polyhedron [[(p 0, p 1, p 2), (p 0, p 2, p 3), ... ]] +where points = [.....] + p i = points !! i +@ + +Also, the OpenSCAD polyedron code recently changed. The old version +requires that the faces all be triangles, the new version allows for +them to be arbitrary polygons. 'Graphics.OpenSCAD' supports both: if +all your faces are triangles, it will use the old version. If some +have more points, the new version will be used. If any have fewer than +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 +export lists if you want to play with it. + +-} + +module Graphics.OpenSCAD ( + -- * Types + -- ** A 'Model' to be rendered, and a 'Vector' that fixes the + -- number of dimensions it has. + Model, Vector, + -- ** Types aliases with fixed dimensions + Model2d, Model3d, Vector2d, Vector3d, + -- ** Other type aliases + Facet, TransMatrix, + -- ** Type for 'unsafePolyhedron' 'Sides' argument + Sides(..), + -- * Primitive creation + -- ** 'Model2d's + rectangle, square, circle, polygon, unsafePolygon, projection, importFile, + -- ** 'Model3d's + sphere, box, cube, cylinder, obCylinder, polyhedron, unsafePolyhedron, + multMatrix, linearExtrude, rotateExtrude, surface, solid, + -- * Functions + -- ** Combinations + union, intersection, difference, minkowski, hull, + -- ** Transformations + scale, resize, rotate, translate, mirror, color, transparent, up, + -- ** Rendering + render, renderL, + -- ** 'Facet's. + var, fn, fs, fa, def, + -- ** General convenience functions + diam, draw, drawL, (#), + module Colours) + +where + +import Data.Colour (Colour, AlphaColour, alphaChannel, darken, over, black) +import Data.Colour.Names as Colours +import Data.Colour.SRGB (channelRed, channelBlue, channelGreen, toSRGB) +import Data.List (elemIndices, nub, intercalate) +import qualified Data.List.NonEmpty as NE +import Data.Semigroup (Semigroup((<>), sconcat)) +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 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 (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 = + ((Double, Double, Double, Double), (Double, Double, Double, Double), + (Double, Double, Double, Double), (Double, Double, Double, Double)) + + +-- While it's tempting to add more options to Solid, Shape or Model, +-- don't do it. Instead, add functions that add that functionality, +-- by building the appropriate structure, like cube vs. box. + +-- | A 'Facet' is used to set one of the special variables that +-- control the mesh used during generation of circular objects. They +-- appear as arguments to various constructors, as well as in the +-- 'var' function to set them for the argument objects. +data Facet = Fa Double | Fs Double | Fn Int | Def deriving Show + +-- | A 'Join' controls how edges in a 'polygon' are joined by the +-- 'offset' operation. +data Join = Bevel | Round | Miter Double deriving Show + +-- A 'Shape' is a 2-dimensional primitive to be used in a 'Model2d'. +data Shape = Rectangle Double Double + | Circle Double Facet + | Polygon Int [Vector2d] [[Int]] + | Projection Bool Model3d + | 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'. +data Solid = Sphere Double Facet + | Box Double Double Double + | Cylinder Double Double Facet + | ObCylinder Double Double Double Facet + | Polyhedron Int [Vector3d] Sides + | MultMatrix TransMatrix Model3d + | LinearExtrude Double Double Vector2d Int Int Facet Model2d + | RotateExtrude Int Facet Model2d + | Surface FilePath Bool Int + | ToSolid Model2d + deriving Show + +-- | A 'Model' is either a 'Model2d', a 'Model3d', a transformation of +-- a 'Model', a combination of 'Model's, or a 'Model' with it's +-- rendering tweaked by a 'Facet'. 'Model's can be rendered. +data Model v = Shape Shape + | Solid Solid + | Scale v (Model v) + | Resize v (Model v) + | Rotate v (Model v) + | Translate v (Model v) + | Mirror v (Model v) + | Color (Colour Double) (Model v) + | Transparent (AlphaColour Double) (Model v) + -- and combinations + | Union [Model v] + | Intersection [Model v] + | Minkowski [Model v] + | Hull [Model v] + | Difference (Model v) (Model v) + -- And oddball stuff control + | Import FilePath + | Var Facet [Model v] + deriving Show + +-- | A two-dimensional model. Note that the types do not mix +-- implicitly. You must turn a 'Model2d' into a 'Model3d' using one of +-- 'linearExtrude', 'rotateExtrude', or 'solid'. +type Model2d = Model Vector2d + +-- | A three-dimensional model. You can create a 'Model2d' from a +-- 'Model3d' using 'projection'. +type Model3d = Model Vector3d + +-- Tools for creating 'Model2d's. +-- | Create a rectangular 'Model2d' with @rectangle /x-size y-size/@. +rectangle :: Double -> Double -> Model2d +rectangle w h = Shape $ Rectangle w h + +-- | 'square' is a 'rectangle' with both sides the same size. +square :: Double -> Model2d +square s = rectangle s s + +-- | Create a circular 'Model' with @circle /radius/ 'Facet'@. +circle :: Double -> Facet -> Model2d +circle r f = Shape $ Circle r f + +-- | Project a 'Model3d' into a 'Model' with @projection /cut 'Model3d'/@. +projection :: Bool -> Model3d -> Model2d +projection c s = Shape $ Projection c s + +-- | 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 + | 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 + +-- Tools for creating Model3ds +-- | Create a sphere with @sphere /radius 'Facet'/@. +sphere :: Double -> Facet -> Model3d +sphere r f = Solid $ Sphere r f + +-- | Create a box with @cube /x-size y-size z-size/@ +box :: Double -> Double -> Double -> Model3d +box x y z = Solid $ Box x y z + +-- | A convenience function for creating a cube as a 'box' with all +-- sides the same length. +cube :: Double -> Model3d +cube x = box x x x + +-- | Create a cylinder with @cylinder /radius height 'Facet'/@. +cylinder :: Double -> Double -> Facet -> Model3d +cylinder h r f = Solid $ Cylinder h r f + +-- | Create an oblique cylinder with @cylinder /radius1 height radius2 'Facet'/@. +obCylinder :: Double -> Double -> Double -> Facet -> Model Vector3d +obCylinder r1 h r2 f= Solid $ ObCylinder r1 h r2 f + +-- | Turn a list of list of 'Vector3d's and an int into @polyhedron +-- /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 +-- 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, 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 + | 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." + +-- | 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 + +-- | Turn a 'Model2d' into a 'Model3d' exactly as is. +solid :: Model2d -> Model3d +solid = Solid . ToSolid + +-- | Extrude a 'Model2d' along a line with @linear_extrude@. +linearExtrude :: Double -- ^ height + -> Double -- ^ twist + -> Vector2d -- ^ scale + -> Int -- ^ slices + -> Int -- ^ convexity + -> Facet + -> Model2d -- ^ to extrude + -> Model3d +linearExtrude h t sc sl c f m = Solid $ LinearExtrude h t sc sl c f m + +-- | Rotate a 'Model2d' around the origin with @rotate_extrude +-- /convexity 'Facet' 'Model'/@ +rotateExtrude :: Int -> Facet -> Model2d -> Model3d +rotateExtrude c f m = Solid $ RotateExtrude c f m + +-- | Load a height map from a file with @surface /FilePath Invert Convexity/@. +surface :: FilePath -> Bool -> Int -> Model3d +surface f i c = Solid $ Surface f i c + +-- And the one polymorphic function we have. +-- | 'importFile' is @import /filename/@. +importFile :: Vector v => FilePath -> Model v +importFile = Import + + +-- Transformations +-- | Scale a 'Model', the vector specifying the scale factor for each axis. +scale :: Vector v => v -> Model v -> Model v +scale = Scale + +-- | Resize a 'Model' to occupy the dimensions given by the vector. Note that +-- this does nothing prior to the 2014 versions of OpenSCAD. +resize :: Vector v => v -> Model v -> Model v +resize = Resize + +-- | Rotate a 'Model' by different amounts around each of the three axis. +rotate :: Vector v => v -> Model v -> Model v +rotate = Rotate + +-- | Translate a 'Model' along a 'Vector'. +translate :: Vector v => v -> Model v -> Model v +translate = Translate + +-- | Mirror a 'Model' across a plane intersecting the origin. +mirror :: Vector v => v -> Model v -> Model v +mirror = Mirror + +-- | Render a 'Model' in a specific color. This doesn't use the +-- OpenSCAD color model, but instead uses the 'Data.Colour' model. The +-- 'Graphics.OpenSCAD' module rexports 'Data.Colour.Names' so you can +-- conveniently say @'color' 'red' /'Model'/@. +color :: Vector v => Colour Double -> Model v -> Model v +color = Color + +-- | Render a 'Model' in a transparent color. This uses the +-- '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 f = translate (0, 0, f) + + +-- Combinations +-- | Create the union of a list of 'Model's. +union :: Vector v => [Model v] -> Model v +union = Union + +-- | Create the intersection of a list of 'Model's. +intersection :: Vector v => [Model v] -> Model v +intersection = Intersection + +-- | The difference between two 'Model's. +difference :: Vector v => Model v -> Model v -> Model v +difference = Difference + +-- | The Minkowski sum of a list of 'Model's. +minkowski :: Vector v => [Model v] -> Model v +minkowski = Minkowski + +-- | The convex hull of a list of 'Model's. +hull :: Vector v => [Model v] -> Model v +hull = Hull + + +-- | 'render' does all the real work. It will walk the AST for a 'Model', +-- returning an OpenSCAD program in a 'String'. +render :: Vector v => Model v -> String +render (Shape s) = rShape s +render (Solid s) = rSolid s +render (Union ss) = rList "union()" ss +render (Intersection ss) = rList "intersection()" ss +render (Difference s1 s2) = "difference(){" ++ render s1 ++ render s2 ++ "}\n" +render (Minkowski ss) = rList "minkowski()" ss +render (Hull ss) = rList "hull()" ss +render (Scale v s) = rVecSolid "scale" v s +render (Resize v s) = rVecSolid "resize" v s +render (Translate v s) = rVecSolid "translate" v s +render (Rotate v s) = "rotate(" ++ rVector v ++ ")" ++ render s +render (Mirror v s) = rVecSolid "mirror" v s +render (Import f) = "import(\"" ++ f ++ "\");\n" +render (Color c s) = let r = toSRGB c in + "color(" ++ rVector (channelRed r, channelGreen r, channelBlue r) ++ ")\n" + ++ render s +render (Transparent c s) = + "color(" ++ rQuad (channelRed r, channelGreen r, channelBlue r, a) ++ ")" + ++ render s + where r = toSRGB $ toPure c + a = alphaChannel c + toPure ac = if a > 0 then darken (recip a) (ac `over` black) else black +render (Var (Fa f) ss) = rList ("assign($fa=" ++ show f ++ ")") ss +render (Var (Fs f) ss) = rList ("assign($fs=" ++ show f ++ ")") ss +render (Var (Fn n) ss) = rList ("assign($fn=" ++ show n ++ ")") ss + +-- utility for rendering Shapes. +rShape :: Shape -> String +rShape (Rectangle r f) = "square([" ++ show r ++ "," ++ show f ++ "]);\n" +rShape (Circle r f) = "circle(" ++ show r ++ rFacet f ++ ");\n" +rShape (Projection c s) = + "projection(cut=" ++ (if c then "true)" else "false)") ++ render s +rShape (Polygon c points paths) = "polygon(points=" ++ rVectorL points ++ + ",paths=" ++ show paths ++ ",convexity=" ++ show c ++ ");\n" +rShape (Offset d j s) = + "offset(delta=" ++ show d ++ "," ++ rJoin j ++ ")" ++ rShape s + +-- utility for rendering Joins +rJoin :: Join -> String +rJoin Bevel = "join_type=bevel" +rJoin Round = "join_type=round" +rJoin (Miter l) = "miter_limit=" ++ show l + +-- utilities for rendering Solids. +rSolid :: Solid -> String +rSolid (Sphere x f) = "sphere(" ++ show x ++ rFacet f ++ ");\n" +rSolid (Box x y z) = + "cube([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]);\n" +rSolid (Cylinder r h f) = + "cylinder(r=" ++ show r ++ ",h=" ++ show h ++ rFacet f ++ ");\n" +rSolid (ObCylinder r1 h r2 f) = + "cylinder(r1=" ++ show r1 ++ ",h=" ++ show h ++ ",r2=" ++ show r2 ++ rFacet f + ++ ");\n" +rSolid (Polyhedron c ps ss) = "polyhedron(points=" ++ rVectorL ps ++ rSides ss + ++ ",convexity=" ++ show c ++ ");\n" +rSolid (MultMatrix (a, b, c, d) s) = + "multmatrix([" ++ rQuad a ++ "," ++ rQuad b ++ "," ++ rQuad c ++ "," + ++ rQuad d ++"])\n" ++ render s +rSolid (LinearExtrude h t sc sl c f sh) = + "linear_extrude(height=" ++ show h ++ ",twist=" ++ show t ++ ",scale=" + ++ rVector sc ++ ",slices=" ++ show sl ++ ",convexity=" ++ show c + ++ rFacet f ++ ")" ++ render sh +rSolid (RotateExtrude c f sh) = + "rotate_extrude(convexity=" ++ show c ++ rFacet f ++ ")" ++ render sh +rSolid (Surface f i c) = + "surface(file=\"" ++ f ++ "\"," ++ (if i then "invert=true," else "") + ++ "convexity=" ++ show c ++ ");\n" +rSolid (ToSolid s) = render s + +-- render a list of vectors as an Openscad vector of vectors. +rVectorL vs = "[" ++ intercalate "," (map rVector vs) ++ "]" + +-- render a Sides. +rSides (Faces vs) = ",faces=" ++ rListL vs +rSides (Triangles vs) = ",triangles=" ++ rListL vs +rListL vs = "[" ++ intercalate "," (map show vs) ++ "]" + +-- | A convenience function to render a list of 'Model's by taking +-- their union. +renderL :: Vector v => [Model v] -> String +renderL = render . union + +-- | A convenience function to write the rendered 'Model' to +-- standard output. +draw :: Vector v => Model v -> IO () +draw = putStrLn . render + +-- | A convenience function to write a 'union' of 'Model's to +-- standard output. +drawL :: Vector v => [Model v] -> IO () +drawL = draw . Union + +-- And some misc. rendering utilities. +rList n ss = n ++ "{\n" ++ concatMap render ss ++ "}" +rVecSolid n v s = n ++ "(" ++ rVector v ++ ")\n" ++ render s +rQuad (w, x, y, z) = + "[" ++ show w ++ "," ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]" +rFacet Def = "" +rFacet f = "," ++ showFacet f + +-- render a facet setting. +showFacet :: Facet -> String +showFacet (Fa f) = "$fa=" ++ show f +showFacet (Fs f) = "$fs=" ++ show f +showFacet (Fn n) = "$fn=" ++ show n +showFacet Def = "" + +-- Convenience functions for Facets. +-- | 'var' uses @assign@ to set a 'Facet' variable for it's 'Model's. +var :: Facet -> [Model v] -> Model v +var = Var + +-- | 'fa' is used to set the @$fa@ variable in a 'Facet' or 'var'. +fa :: Double -> Facet +fa = Fa + +-- | 'fs' is used to set the @$fs@ variable in a 'Facet' or 'var'. +fs :: Double -> Facet +fs = Fs + +-- | 'fn' is used to set the @$fn@ variable in a 'Facet' or 'var'. +fn :: Int -> Facet +fn = Fn + +-- | 'def' is used where a 'Facet' is needed but we don't want to change +-- any of the values. +def :: Facet +def = Def + +-- And one last convenience function. +-- | 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 . NE.toList + +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 [a] = a + mconcat as = union as + + +-- | 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/openscad/Graphics/OpenSCAD/Unicode.hs b/openscad/Graphics/OpenSCAD/Unicode.hs new file mode 100644 index 0000000..e630941 --- /dev/null +++ b/openscad/Graphics/OpenSCAD/Unicode.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE UnicodeSyntax #-} + +{- +Module : Graphics.OpenSCAD.Unicode +Description : Unicode operators so you can write 'Model' expressions. +Copyright : © Mike Meyer, 2014 +License : BSD4 +Maintainer : mwm@mired.org +Stability : experimental +-} + +module Graphics.OpenSCAD.Unicode where + +import Data.Semigroup ((<>)) +import Graphics.OpenSCAD + +infixl 6 ∪ +infixr 6 ∩ +infixl 9 ∖ +infixl 9 ⊖ +infixl 9 ⊕ + +-- | (∪) = 'union' +-- +-- U+222A, UNION +(∪) :: Vector v => Model v -> Model v -> Model v +(∪) = (<>) + +-- | (∩) = 'intersection' +-- +-- U+2229, INTERSECTION +(∩) :: Vector v => Model v -> Model v -> Model v +a ∩ b = intersection [a, b] + +-- | (∖) = 'difference' +-- +-- U+2216, SET MINUS +(∖):: Vector v => Model v -> Model v -> Model v +(∖) = difference + +-- | (⊖) = Symmetric difference +-- +-- 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/LICENSE b/openscad/LICENSE new file mode 100644 index 0000000..20d7de7 --- /dev/null +++ b/openscad/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Mike Meyer + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Mike Meyer nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/openscad/OpenSCAD.cabal b/openscad/OpenSCAD.cabal new file mode 100644 index 0000000..ebfd955 --- /dev/null +++ b/openscad/OpenSCAD.cabal @@ -0,0 +1,57 @@ +-- Initial OpenSCAD.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: OpenSCAD +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 + functions for rendering an ADT into an OpenSCAD program. +homepage: https://chiselapp.com/user/mwm/repository/OpenSCAD/ +license: BSD3 +license-file: LICENSE +author: Mike Meyer +maintainer: mwm@mired.org +-- copyright: +category: Graphics +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + exposed-modules: Graphics.OpenSCAD, Graphics.OpenSCAD.Unicode + -- other-modules: + other-extensions: UnicodeSyntax + build-depends: base > 4.5 && < 5.0, + colour >=2.3 && < 2.4, + filepath >=1.3 && < 1.5, + 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.5 && < 5.0, + colour >=2.3, + filepath >=1.3, + HUnit >=1.2, + Cabal >= 1.18, + 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 + type: fossil + location: https://chiselapp.com/user/mwm/repository/OpenSCAD/ + +source-repository this + type: fossil + location: https://chiselapp.com/user/mwm/repository/OpenSCAD/ + tag: 0.3.0.2 diff --git a/openscad/README.md b/openscad/README.md new file mode 100644 index 0000000..2a72291 --- /dev/null +++ b/openscad/README.md @@ -0,0 +1,28 @@ +# What's Graphics.OpenSCAD + +This is a library whose primary component is an algebraic data type +for describing [OpenSCAD](http://openscad.org) models, and a function +that converts that data type into a string. There are convenience +functions to make building the model easier. + +## What's different + +Given the primitive and quirky nature of the OpenSCAD language, the +idea of "using OpenSCAD" as an assembler is both obvious, and promoted +in lieu of adding major extensions to OpenSCAD. So there are a number +of such projects, for a variety of languages. + +Any compiler that generated "assembler" that caused the assembler +program to generate errors would be considered buggy. However, none of +the alternative projects I looked at seemed to do anything about that +(my apologies if I missed one - I only looked at languages I was +interested in using). Graphics.OpenSCAD takes the attitude that errors +from OpenSCAD on the generated code are errors in +Graphics.OpenSCAD. If you manage to generate code that causes OpenSCAD +to issue an error message, please open an issue here. + +## More info + +Read the +[online docs](https://hackage.haskell.org/package/OpenSCAD-0.2.1.0/docs/Graphics-OpenSCAD.html) +at [hackage](http://hackage.haskell.org/). diff --git a/openscad/Setup.hs b/openscad/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/openscad/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/openscad/UnitTest.hs b/openscad/UnitTest.hs new file mode 100644 index 0000000..97bdfd1 --- /dev/null +++ b/openscad/UnitTest.hs @@ -0,0 +1,311 @@ +#!/usr/bin/env runghc + +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 (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 $ render a) @?= (sw e) + + +{- 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 "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],[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)]], + 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" + "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 "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)) + $ 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 "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);}" + (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 "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), + 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 diff --git a/package.yaml b/package.yaml index 5e56fa2..55f8bc7 100644 --- a/package.yaml +++ b/package.yaml @@ -22,6 +22,7 @@ dependencies: - temporary - lens - linear +- OpenSCAD library: source-dirs: . diff --git a/stack.yaml b/stack.yaml index c3e29bc..6c587d5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -34,6 +34,7 @@ resolver: lts-13.12 # - wai packages: - . +- openscad # Dependency packages to be pulled from upstream that are not in the resolver # using the same syntax as the packages field. # (e.g., acme-missiles-0.3) -- cgit v1.2.3