summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-03-13 01:58:08 -0400
committerAndrew Cady <d@jerkface.net>2019-03-13 01:58:08 -0400
commitee8373d9a9175f5f4f6553b9e253daf62e76610c (patch)
treeadb0201a3245ff0f40b30e52f7e4fbb01c28502f
parenteee0ea179902152ed2431adae99a15507eb1fc94 (diff)
bring in OpenSCAD (forward-ported)
-rw-r--r--openscad/Graphics/OpenSCAD.hs638
-rw-r--r--openscad/Graphics/OpenSCAD/Unicode.hs51
-rw-r--r--openscad/LICENSE30
-rw-r--r--openscad/OpenSCAD.cabal57
-rw-r--r--openscad/README.md28
-rw-r--r--openscad/Setup.hs2
-rw-r--r--openscad/UnitTest.hs311
-rw-r--r--package.yaml1
-rw-r--r--stack.yaml1
9 files changed, 1119 insertions, 0 deletions
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 @@
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3
4{- |
5Module : Graphics.OpenSCAD
6Description : Type-checked wrappers for the OpenSCAD primitives.
7Copyright : &#xa9; Mike Meyer, 2014
8License : BSD4
9Maintainer : mwm@mired.org
10Stability : experimental
11
12= Overview
13
14The Graphics.OpenSCAD module provides abstract data types for creating
15OpenSCAD model definitions calls, along with a function to render it
16as a string, and some utilities. The primary goal is that the output
17should always be valid OpenSCAD. If you manage to generate OpenSCAD
18source that causes OpenSCAD to complain, please open an issue.
19
20The primary effect of this is that Graphics.OpenSCAD distinguishes
21between 2d and 3d 'Model's. If you want to mix them, you must
22explicitly convert between them. While two-dimensional model creation
23could be polymorphic functions that create either, so that such models
24could be treated as either 2d or 3d, you'd still have to explicitly
25convert models whose type was fixed as 2d by a transformation, and
26'render' wouldn't work if the type was still ambiguous, ala @render $
27square 2@.
28
29= Usage
30
31Standard usage is to have a @main@ function that looks like:
32
33@
34main = draw $ /Solid/
35@
36or
37@
38main = drawL $ [/Solid/]
39@
40
41and then set your IDE's compile command to use @runhaskell@ or
42equivalent to run your code and send the output to a .scad file. Open
43that file in OpenSCAD, and set it to automatically reload if the file
44changes. Recompiling your program will cause the model to be loaded
45and displayed by OpenSCAD.
46
47The type constructors are not exported, with functions being exported
48in their stead. This allows extra checking to be done on those that
49need it. It also provides consistency, as otherwise you'd have to
50remember whether 'box' is a constructor or a convenience function,
51etc.
52
53Because of this, the constructors are not documented, the exported
54functions are. The documentation is generally just the corresponding
55OpenSCAD function name, along with the names of the arguments from the
56OpenSCAD documentation. If no OpenSCAD function name is given, then
57it's the same as the 'Graphics.OpenSCAD' function. You should check
58the OpenSCAD documentation for usage information.
59
60= Oddities
61
62'importFile' has been left polymorphic. I couldn't find a sane way to
63check that you're importing the right file type, so detecting such
64errors - including importing a 3d file and trying to extrude it - have
65to be left up to OpenSCAD in any case. So for now, there's just
66'importFile'. This does create the oddity that if you import a file
67and try and render it without doing something to indicate how many
68dimensions it has (one of the transformations, an extrusion or
69projection, or 'solid') you'll get a compile error because the type is
70ambiguous. Later, this may turn into @import2d@ and @import3d@.
71
72The interfaces for 'polygon's and 'polyhedron's is seriously different
73from the OpenSCAD interface. Rather than expecting you to enter a list
74of points and then references to them, you just enter the points
75directly. If you really want to do it the OpenSCAD way, you can do
76something like:
77
78@
79draw $ polyhedron [[(p 0, p 1, p 2), (p 0, p 2, p 3), ... ]]
80where points = [.....]
81 p i = points !! i
82@
83
84Also, the OpenSCAD polyedron code recently changed. The old version
85requires that the faces all be triangles, the new version allows for
86them to be arbitrary polygons. 'Graphics.OpenSCAD' supports both: if
87all your faces are triangles, it will use the old version. If some
88have more points, the new version will be used. If any have fewer than
89three points you get an error. At this time, no tests are done on the
90faces. That will probably change in the future.
91
92Finally, polygon and polyhedron can generate errors on input that
93seems to generate proper solids. If you turn on 'View->Thrown
94Together', you'll see it highlighting errors in the object.
95
96Offset is missing even though it's documented, as it isn't supported
97by a released version of OpenSCAD, so presumably subject to change. It
98is implemented, but untested as yet. You can add it to the module's
99export lists if you want to play with it.
100
101-}
102
103module Graphics.OpenSCAD (
104 -- * Types
105 -- ** A 'Model' to be rendered, and a 'Vector' that fixes the
106 -- number of dimensions it has.
107 Model, Vector,
108 -- ** Types aliases with fixed dimensions
109 Model2d, Model3d, Vector2d, Vector3d,
110 -- ** Other type aliases
111 Facet, TransMatrix,
112 -- ** Type for 'unsafePolyhedron' 'Sides' argument
113 Sides(..),
114 -- * Primitive creation
115 -- ** 'Model2d's
116 rectangle, square, circle, polygon, unsafePolygon, projection, importFile,
117 -- ** 'Model3d's
118 sphere, box, cube, cylinder, obCylinder, polyhedron, unsafePolyhedron,
119 multMatrix, linearExtrude, rotateExtrude, surface, solid,
120 -- * Functions
121 -- ** Combinations
122 union, intersection, difference, minkowski, hull,
123 -- ** Transformations
124 scale, resize, rotate, translate, mirror, color, transparent, up,
125 -- ** Rendering
126 render, renderL,
127 -- ** 'Facet's.
128 var, fn, fs, fa, def,
129 -- ** General convenience functions
130 diam, draw, drawL, (#),
131 module Colours)
132
133where
134
135import Data.Colour (Colour, AlphaColour, alphaChannel, darken, over, black)
136import Data.Colour.Names as Colours
137import Data.Colour.SRGB (channelRed, channelBlue, channelGreen, toSRGB)
138import Data.List (elemIndices, nub, intercalate)
139import qualified Data.List.NonEmpty as NE
140import Data.Semigroup (Semigroup((<>), sconcat))
141import qualified Data.Set as Set
142import System.FilePath (FilePath)
143
144-- A vector in 2 or 3-space. They are used in transformations of
145-- 'Model's of their type.
146class Eq a => Vector a where
147 rVector :: a -> String
148 toList :: a -> [Double]
149 (#*) :: a -> a -> a -- cross product
150 (#-) :: a -> a -> a -- difference between two vectors
151
152 (#.) :: a -> a -> Double -- dot product
153 v1 #. v2 = sum $ zipWith (*) (toList v1) (toList v2)
154
155 isZero :: a -> Bool -- is a zero vector. Arguably should use eps.
156 isZero = all (== 0) . toList
157
158 collinear :: [a] -> Bool -- are all points collinear?
159 collinear [] = False
160 collinear [_] = False
161 collinear [v1, v2] = v1 /= v2
162 collinear (v1:v2:vs)
163 | v1 /= v2 = all (\v -> isZero $ (v2 #- v1) #* (v1 #- v)) vs
164 | otherwise = collinear (v2:vs)
165
166-- | 'Vector2d' is used where 'Graphics.OpenSCAD' expects an OpenSCAD
167-- @vector@ of length 2.
168type Vector2d = (Double, Double)
169instance Vector Vector2d where
170 rVector (x, y) = "[" ++ show x ++ "," ++ show y ++ "]"
171 toList (x, y) = [x, y]
172 (x1, y1) #- (x2, y2) = (x1 - x2, y1 - y2)
173 (x1, y1) #* (x2, y2) = (0, x1 * y2 - y1 * x2) -- for purposes of collinear
174
175-- | 'Vector3d' is used where 'Graphics.OpenSCAD' expects an OpenSCAD
176-- @vector@ of length 3.
177type Vector3d = (Double, Double, Double)
178instance Vector Vector3d where
179 rVector (x, y, z) = "[" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]"
180 toList (x, y, z) = [x, y, z]
181 (x1, y1, z1) #- (x2, y2, z2) = (x1 - x2, y1 - y2, z1 - z2)
182 (x1, y1, z1) #* (x2, y2, z2) = (y1 * z2 - z1 * y2,
183 z1 * x2 - x1 * z2,
184 x1 * y2 - y1 * x2)
185
186-- Coplanar only makes sense for R3, so it's not part of the Vector class
187coplanar :: [Vector3d] -> Bool
188coplanar vs | length vs <= 3 = True -- by definition
189 | collinear $ take 3 vs = coplanar $ tail vs
190 | otherwise =
191 all (\v -> (v3 #- v1) #. ((v2 #- v1) #* (v #- v3)) == 0) vs'
192 where (v1:v2:v3:vs') = vs
193
194
195-- | A 4x4 transformation matrix specifying a complete 3-space
196-- transform of a 'Model3d'.
197type TransMatrix =
198 ((Double, Double, Double, Double), (Double, Double, Double, Double),
199 (Double, Double, Double, Double), (Double, Double, Double, Double))
200
201
202-- While it's tempting to add more options to Solid, Shape or Model,
203-- don't do it. Instead, add functions that add that functionality,
204-- by building the appropriate structure, like cube vs. box.
205
206-- | A 'Facet' is used to set one of the special variables that
207-- control the mesh used during generation of circular objects. They
208-- appear as arguments to various constructors, as well as in the
209-- 'var' function to set them for the argument objects.
210data Facet = Fa Double | Fs Double | Fn Int | Def deriving Show
211
212-- | A 'Join' controls how edges in a 'polygon' are joined by the
213-- 'offset' operation.
214data Join = Bevel | Round | Miter Double deriving Show
215
216-- A 'Shape' is a 2-dimensional primitive to be used in a 'Model2d'.
217data Shape = Rectangle Double Double
218 | Circle Double Facet
219 | Polygon Int [Vector2d] [[Int]]
220 | Projection Bool Model3d
221 | Offset Double Join Shape
222 deriving Show
223
224-- | The third argument to unsafePolyhedron is a 'Sides'.
225data Sides = Faces [[Int]] | Triangles [[Int]] deriving Show
226
227-- A 'Solid' is a 3-dimensional primitive to be used in a 'Model3d'.
228data Solid = Sphere Double Facet
229 | Box Double Double Double
230 | Cylinder Double Double Facet
231 | ObCylinder Double Double Double Facet
232 | Polyhedron Int [Vector3d] Sides
233 | MultMatrix TransMatrix Model3d
234 | LinearExtrude Double Double Vector2d Int Int Facet Model2d
235 | RotateExtrude Int Facet Model2d
236 | Surface FilePath Bool Int
237 | ToSolid Model2d
238 deriving Show
239
240-- | A 'Model' is either a 'Model2d', a 'Model3d', a transformation of
241-- a 'Model', a combination of 'Model's, or a 'Model' with it's
242-- rendering tweaked by a 'Facet'. 'Model's can be rendered.
243data Model v = Shape Shape
244 | Solid Solid
245 | Scale v (Model v)
246 | Resize v (Model v)
247 | Rotate v (Model v)
248 | Translate v (Model v)
249 | Mirror v (Model v)
250 | Color (Colour Double) (Model v)
251 | Transparent (AlphaColour Double) (Model v)
252 -- and combinations
253 | Union [Model v]
254 | Intersection [Model v]
255 | Minkowski [Model v]
256 | Hull [Model v]
257 | Difference (Model v) (Model v)
258 -- And oddball stuff control
259 | Import FilePath
260 | Var Facet [Model v]
261 deriving Show
262
263-- | A two-dimensional model. Note that the types do not mix
264-- implicitly. You must turn a 'Model2d' into a 'Model3d' using one of
265-- 'linearExtrude', 'rotateExtrude', or 'solid'.
266type Model2d = Model Vector2d
267
268-- | A three-dimensional model. You can create a 'Model2d' from a
269-- 'Model3d' using 'projection'.
270type Model3d = Model Vector3d
271
272-- Tools for creating 'Model2d's.
273-- | Create a rectangular 'Model2d' with @rectangle /x-size y-size/@.
274rectangle :: Double -> Double -> Model2d
275rectangle w h = Shape $ Rectangle w h
276
277-- | 'square' is a 'rectangle' with both sides the same size.
278square :: Double -> Model2d
279square s = rectangle s s
280
281-- | Create a circular 'Model' with @circle /radius/ 'Facet'@.
282circle :: Double -> Facet -> Model2d
283circle r f = Shape $ Circle r f
284
285-- | Project a 'Model3d' into a 'Model' with @projection /cut 'Model3d'/@.
286projection :: Bool -> Model3d -> Model2d
287projection c s = Shape $ Projection c s
288
289-- | Turn a list of lists of 'Vector2d's and an Int into @polygon
290-- /convexity points path/@. The argument to polygon is the list of
291-- paths that is the second argument to the OpenSCAD polygon function,
292-- except the points are 'Vector2d's, not references to 'Vector2d's in
293-- that functions points argument. If you were just going to pass in
294-- the points, it now needs to be in an extra level of 'List'.
295polygon :: Int -> [[Vector2d]] -> Model2d
296polygon convexity paths
297 | any ((< 3) . length) paths = error "Polygon has fewer than 3 points."
298 | any collinear paths = error "Points in polygon are collinear."
299 | otherwise = let points = nub $ concat paths
300 in Shape . Polygon convexity points
301 $ map (concatMap (`elemIndices` points)) paths
302
303-- | This provides direct access to the OpenScad @polygon@ command for
304-- performance reasons. This version uses the OpenSCAD arguments:
305-- @polygon /convexity points path/@ to allow client code to save
306-- space. However, it bypasses all the checks done by
307-- 'polygon', which need the other representation.
308unsafePolygon :: Int -> [Vector2d] -> [[Int]] -> Model2d
309unsafePolygon convexity points paths = Shape $ Polygon convexity points paths
310
311-- | 'offset' a 'Model2d's edges by @offset /delta join/@.
312offset :: Double -> Join -> Model2d -> Model2d
313offset d j (Shape s) = Shape $ Offset d j s
314
315-- Tools for creating Model3ds
316-- | Create a sphere with @sphere /radius 'Facet'/@.
317sphere :: Double -> Facet -> Model3d
318sphere r f = Solid $ Sphere r f
319
320-- | Create a box with @cube /x-size y-size z-size/@
321box :: Double -> Double -> Double -> Model3d
322box x y z = Solid $ Box x y z
323
324-- | A convenience function for creating a cube as a 'box' with all
325-- sides the same length.
326cube :: Double -> Model3d
327cube x = box x x x
328
329-- | Create a cylinder with @cylinder /radius height 'Facet'/@.
330cylinder :: Double -> Double -> Facet -> Model3d
331cylinder h r f = Solid $ Cylinder h r f
332
333-- | Create an oblique cylinder with @cylinder /radius1 height radius2 'Facet'/@.
334obCylinder :: Double -> Double -> Double -> Facet -> Model Vector3d
335obCylinder r1 h r2 f= Solid $ ObCylinder r1 h r2 f
336
337-- | Turn a list of list of 'Vector3d's and an int into @polyhedron
338-- /convexity points 'Sides'/@. The argument to polyhedron is the list
339-- of paths that is the second argument to the OpenSCAD polyhedron
340-- function, except the points are 'Vector3d's, not the references to
341-- 'Vector3d's used in that functions @points@ argument. The function
342-- will build the appropriate function call, using @faces@ if you pass
343-- in a side that uses more than 3 points, or @triangles@ if not. Note
344-- that @faces@ doesn't work in older versions of OpenSCAD, and
345-- @triangles@ is depreciated. Until a mechanism to set the version of
346-- OpenSCAD is provided, generating the @faces@ version will cause an
347-- error.
348--
349-- Passing in 'Sides' that have fewer than three points, have
350-- collinear points or have points that aren't in the same plane is an
351-- error that is caught by the library.
352polyhedron :: Int -> [[Vector3d]] -> Model3d
353polyhedron convexity paths
354 | any ((< 3) . length) paths = error "Some face has fewer than 3 points."
355 | any collinear paths = error "Some face has collinear points."
356 | any (not . coplanar) paths = error "Some face isn't coplanar."
357 | length vectors /= length (nub vectors) =
358 error "Some faces have different orientation."
359 | 2 * length edges /= length vectors = error "Some edges are not in two faces."
360 | xCross headMax xMax tailMax > 0 =
361 error "Face orientations are counterclockwise."
362 | otherwise = Solid . Polyhedron convexity points $ sides sidesIn
363 where vectors = concatMap (\p -> zip p (tail p ++ [head p])) paths
364 edges = nub $ map (Set.fromList . \(a, b) -> [a, b]) vectors
365 points = nub $ concat paths
366 xMax = maximum points
367 faceMax = head $ filter (elem xMax) paths
368 (maxFirst, maxLast) = break (== xMax) faceMax
369 (headMax, tailMax) = (if null maxFirst
370 then last maxLast
371 else last maxFirst,
372 if null (tail maxLast)
373 then head maxFirst
374 else head (tail maxLast))
375 xCross a b c = (\(a, b, c) -> a) $ (a #- b) #* (b #- c)
376 sidesIn = map (concatMap (`elemIndices` points)) paths
377 sides ss | any ((> 3) . length) ss = Faces ss
378 | all ((== 3) . length) ss = Triangles ss
379 | otherwise = error "Some faces have fewer than 3 points."
380
381-- | This provides direct access to the OpenSCAD @polyhedron@ command
382-- for performance reasons. This version uses the OpenSCAD arguments:
383-- @polyhedron /convexity points 'Sides'/@ to allow client code to
384-- save space. However, it bypasses all the checks done by
385-- 'polyhedron', which needs the other representation.
386unsafePolyhedron :: Int -> [Vector3d] -> Sides -> Model3d
387unsafePolyhedron convexity points sides = Solid $ Polyhedron convexity points sides
388
389
390-- | Transform a 'Model3d' with a 'TransMatrix'
391multMatrix :: TransMatrix -> Model3d -> Model3d
392multMatrix t m = Solid $ MultMatrix t m
393
394-- | Turn a 'Model2d' into a 'Model3d' exactly as is.
395solid :: Model2d -> Model3d
396solid = Solid . ToSolid
397
398-- | Extrude a 'Model2d' along a line with @linear_extrude@.
399linearExtrude :: Double -- ^ height
400 -> Double -- ^ twist
401 -> Vector2d -- ^ scale
402 -> Int -- ^ slices
403 -> Int -- ^ convexity
404 -> Facet
405 -> Model2d -- ^ to extrude
406 -> Model3d
407linearExtrude h t sc sl c f m = Solid $ LinearExtrude h t sc sl c f m
408
409-- | Rotate a 'Model2d' around the origin with @rotate_extrude
410-- /convexity 'Facet' 'Model'/@
411rotateExtrude :: Int -> Facet -> Model2d -> Model3d
412rotateExtrude c f m = Solid $ RotateExtrude c f m
413
414-- | Load a height map from a file with @surface /FilePath Invert Convexity/@.
415surface :: FilePath -> Bool -> Int -> Model3d
416surface f i c = Solid $ Surface f i c
417
418-- And the one polymorphic function we have.
419-- | 'importFile' is @import /filename/@.
420importFile :: Vector v => FilePath -> Model v
421importFile = Import
422
423
424-- Transformations
425-- | Scale a 'Model', the vector specifying the scale factor for each axis.
426scale :: Vector v => v -> Model v -> Model v
427scale = Scale
428
429-- | Resize a 'Model' to occupy the dimensions given by the vector. Note that
430-- this does nothing prior to the 2014 versions of OpenSCAD.
431resize :: Vector v => v -> Model v -> Model v
432resize = Resize
433
434-- | Rotate a 'Model' by different amounts around each of the three axis.
435rotate :: Vector v => v -> Model v -> Model v
436rotate = Rotate
437
438-- | Translate a 'Model' along a 'Vector'.
439translate :: Vector v => v -> Model v -> Model v
440translate = Translate
441
442-- | Mirror a 'Model' across a plane intersecting the origin.
443mirror :: Vector v => v -> Model v -> Model v
444mirror = Mirror
445
446-- | Render a 'Model' in a specific color. This doesn't use the
447-- OpenSCAD color model, but instead uses the 'Data.Colour' model. The
448-- 'Graphics.OpenSCAD' module rexports 'Data.Colour.Names' so you can
449-- conveniently say @'color' 'red' /'Model'/@.
450color :: Vector v => Colour Double -> Model v -> Model v
451color = Color
452
453-- | Render a 'Model' in a transparent color. This uses the
454-- 'Data.Colour.AlphaColour' color model.
455transparent :: Vector v => AlphaColour Double -> Model v -> Model v
456transparent = Transparent
457
458-- | A 'translate' that just goes up, since those seem to be common.
459up :: Double -> Model3d -> Model3d
460up f = translate (0, 0, f)
461
462
463-- Combinations
464-- | Create the union of a list of 'Model's.
465union :: Vector v => [Model v] -> Model v
466union = Union
467
468-- | Create the intersection of a list of 'Model's.
469intersection :: Vector v => [Model v] -> Model v
470intersection = Intersection
471
472-- | The difference between two 'Model's.
473difference :: Vector v => Model v -> Model v -> Model v
474difference = Difference
475
476-- | The Minkowski sum of a list of 'Model's.
477minkowski :: Vector v => [Model v] -> Model v
478minkowski = Minkowski
479
480-- | The convex hull of a list of 'Model's.
481hull :: Vector v => [Model v] -> Model v
482hull = Hull
483
484
485-- | 'render' does all the real work. It will walk the AST for a 'Model',
486-- returning an OpenSCAD program in a 'String'.
487render :: Vector v => Model v -> String
488render (Shape s) = rShape s
489render (Solid s) = rSolid s
490render (Union ss) = rList "union()" ss
491render (Intersection ss) = rList "intersection()" ss
492render (Difference s1 s2) = "difference(){" ++ render s1 ++ render s2 ++ "}\n"
493render (Minkowski ss) = rList "minkowski()" ss
494render (Hull ss) = rList "hull()" ss
495render (Scale v s) = rVecSolid "scale" v s
496render (Resize v s) = rVecSolid "resize" v s
497render (Translate v s) = rVecSolid "translate" v s
498render (Rotate v s) = "rotate(" ++ rVector v ++ ")" ++ render s
499render (Mirror v s) = rVecSolid "mirror" v s
500render (Import f) = "import(\"" ++ f ++ "\");\n"
501render (Color c s) = let r = toSRGB c in
502 "color(" ++ rVector (channelRed r, channelGreen r, channelBlue r) ++ ")\n"
503 ++ render s
504render (Transparent c s) =
505 "color(" ++ rQuad (channelRed r, channelGreen r, channelBlue r, a) ++ ")"
506 ++ render s
507 where r = toSRGB $ toPure c
508 a = alphaChannel c
509 toPure ac = if a > 0 then darken (recip a) (ac `over` black) else black
510render (Var (Fa f) ss) = rList ("assign($fa=" ++ show f ++ ")") ss
511render (Var (Fs f) ss) = rList ("assign($fs=" ++ show f ++ ")") ss
512render (Var (Fn n) ss) = rList ("assign($fn=" ++ show n ++ ")") ss
513
514-- utility for rendering Shapes.
515rShape :: Shape -> String
516rShape (Rectangle r f) = "square([" ++ show r ++ "," ++ show f ++ "]);\n"
517rShape (Circle r f) = "circle(" ++ show r ++ rFacet f ++ ");\n"
518rShape (Projection c s) =
519 "projection(cut=" ++ (if c then "true)" else "false)") ++ render s
520rShape (Polygon c points paths) = "polygon(points=" ++ rVectorL points ++
521 ",paths=" ++ show paths ++ ",convexity=" ++ show c ++ ");\n"
522rShape (Offset d j s) =
523 "offset(delta=" ++ show d ++ "," ++ rJoin j ++ ")" ++ rShape s
524
525-- utility for rendering Joins
526rJoin :: Join -> String
527rJoin Bevel = "join_type=bevel"
528rJoin Round = "join_type=round"
529rJoin (Miter l) = "miter_limit=" ++ show l
530
531-- utilities for rendering Solids.
532rSolid :: Solid -> String
533rSolid (Sphere x f) = "sphere(" ++ show x ++ rFacet f ++ ");\n"
534rSolid (Box x y z) =
535 "cube([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]);\n"
536rSolid (Cylinder r h f) =
537 "cylinder(r=" ++ show r ++ ",h=" ++ show h ++ rFacet f ++ ");\n"
538rSolid (ObCylinder r1 h r2 f) =
539 "cylinder(r1=" ++ show r1 ++ ",h=" ++ show h ++ ",r2=" ++ show r2 ++ rFacet f
540 ++ ");\n"
541rSolid (Polyhedron c ps ss) = "polyhedron(points=" ++ rVectorL ps ++ rSides ss
542 ++ ",convexity=" ++ show c ++ ");\n"
543rSolid (MultMatrix (a, b, c, d) s) =
544 "multmatrix([" ++ rQuad a ++ "," ++ rQuad b ++ "," ++ rQuad c ++ ","
545 ++ rQuad d ++"])\n" ++ render s
546rSolid (LinearExtrude h t sc sl c f sh) =
547 "linear_extrude(height=" ++ show h ++ ",twist=" ++ show t ++ ",scale="
548 ++ rVector sc ++ ",slices=" ++ show sl ++ ",convexity=" ++ show c
549 ++ rFacet f ++ ")" ++ render sh
550rSolid (RotateExtrude c f sh) =
551 "rotate_extrude(convexity=" ++ show c ++ rFacet f ++ ")" ++ render sh
552rSolid (Surface f i c) =
553 "surface(file=\"" ++ f ++ "\"," ++ (if i then "invert=true," else "")
554 ++ "convexity=" ++ show c ++ ");\n"
555rSolid (ToSolid s) = render s
556
557-- render a list of vectors as an Openscad vector of vectors.
558rVectorL vs = "[" ++ intercalate "," (map rVector vs) ++ "]"
559
560-- render a Sides.
561rSides (Faces vs) = ",faces=" ++ rListL vs
562rSides (Triangles vs) = ",triangles=" ++ rListL vs
563rListL vs = "[" ++ intercalate "," (map show vs) ++ "]"
564
565-- | A convenience function to render a list of 'Model's by taking
566-- their union.
567renderL :: Vector v => [Model v] -> String
568renderL = render . union
569
570-- | A convenience function to write the rendered 'Model' to
571-- standard output.
572draw :: Vector v => Model v -> IO ()
573draw = putStrLn . render
574
575-- | A convenience function to write a 'union' of 'Model's to
576-- standard output.
577drawL :: Vector v => [Model v] -> IO ()
578drawL = draw . Union
579
580-- And some misc. rendering utilities.
581rList n ss = n ++ "{\n" ++ concatMap render ss ++ "}"
582rVecSolid n v s = n ++ "(" ++ rVector v ++ ")\n" ++ render s
583rQuad (w, x, y, z) =
584 "[" ++ show w ++ "," ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]"
585rFacet Def = ""
586rFacet f = "," ++ showFacet f
587
588-- render a facet setting.
589showFacet :: Facet -> String
590showFacet (Fa f) = "$fa=" ++ show f
591showFacet (Fs f) = "$fs=" ++ show f
592showFacet (Fn n) = "$fn=" ++ show n
593showFacet Def = ""
594
595-- Convenience functions for Facets.
596-- | 'var' uses @assign@ to set a 'Facet' variable for it's 'Model's.
597var :: Facet -> [Model v] -> Model v
598var = Var
599
600-- | 'fa' is used to set the @$fa@ variable in a 'Facet' or 'var'.
601fa :: Double -> Facet
602fa = Fa
603
604-- | 'fs' is used to set the @$fs@ variable in a 'Facet' or 'var'.
605fs :: Double -> Facet
606fs = Fs
607
608-- | 'fn' is used to set the @$fn@ variable in a 'Facet' or 'var'.
609fn :: Int -> Facet
610fn = Fn
611
612-- | 'def' is used where a 'Facet' is needed but we don't want to change
613-- any of the values.
614def :: Facet
615def = Def
616
617-- And one last convenience function.
618-- | Use 'diam' to turn a diameter into a radius for circles, spheres, etc.
619diam :: Double -> Double
620diam = (/ 2)
621-- Now, let Haskell work it's magic
622instance Vector v => Semigroup (Model v) where
623 a <> b = union [a, b]
624 sconcat = union . NE.toList
625
626instance Vector v => Monoid (Model v) where
627 mempty = Solid $ Box 0 0 0
628 mappend (Solid (Box 0 0 0)) b = b
629 mappend a (Solid (Box 0 0 0)) = a
630 mappend a b = union [a, b]
631 mconcat [a] = a
632 mconcat as = union as
633
634
635-- | You can use '(#)' to write transformations in a more readable postfix form,
636-- cube 3 # color red # translate (-3, -3, -3)
637infixl 8 #
638(#) = 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 @@
1{-# LANGUAGE UnicodeSyntax #-}
2
3{-
4Module : Graphics.OpenSCAD.Unicode
5Description : Unicode operators so you can write 'Model' expressions.
6Copyright : &#xa9; Mike Meyer, 2014
7License : BSD4
8Maintainer : mwm@mired.org
9Stability : experimental
10-}
11
12module Graphics.OpenSCAD.Unicode where
13
14import Data.Semigroup ((<>))
15import Graphics.OpenSCAD
16
17infixl 6 ∪
18infixr 6 ∩
19infixl 9 ∖
20infixl 9 ⊖
21infixl 9 ⊕
22
23-- | (&#x222A;) = 'union'
24--
25-- U+222A, UNION
26(∪) :: Vector v => Model v -> Model v -> Model v
27(∪) = (<>)
28
29-- | (&#x2229;) = 'intersection'
30--
31-- U+2229, INTERSECTION
32(∩) :: Vector v => Model v -> Model v -> Model v
33a ∩ b = intersection [a, b]
34
35-- | (&#x2216;) = 'difference'
36--
37-- U+2216, SET MINUS
38(∖):: Vector v => Model v -> Model v -> Model v
39(∖) = difference
40
41-- | (&#x2296;) = Symmetric difference
42--
43-- U+2296, CIRCLED MINUS
44(⊖) :: Vector v => Model v -> Model v -> Model v
45a ⊖ b = (a ∖ b) ∪ (b ∖ a)
46
47-- | (&#2295;) = 'minkowski'
48--
49-- U+2295, CIRCLED PLUS
50(⊕) :: Vector v => Model v -> Model v -> Model v
51a ⊕ 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 @@
1Copyright (c) 2014, Mike Meyer
2
3All rights reserved.
4
5Redistribution and use in source and binary forms, with or without
6modification, are permitted provided that the following conditions are met:
7
8 * Redistributions of source code must retain the above copyright
9 notice, this list of conditions and the following disclaimer.
10
11 * Redistributions in binary form must reproduce the above
12 copyright notice, this list of conditions and the following
13 disclaimer in the documentation and/or other materials provided
14 with the distribution.
15
16 * Neither the name of Mike Meyer nor the names of other
17 contributors may be used to endorse or promote products derived
18 from this software without specific prior written permission.
19
20THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30OF 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 @@
1-- Initial OpenSCAD.cabal generated by cabal init. For further
2-- documentation, see http://haskell.org/cabal/users-guide/
3
4name: OpenSCAD
5version: 0.3.0.2
6synopsis: ADT wrapper and renderer for OpenSCAD models.
7description: An algebraic data type for describing OpenSCAD models,
8 functions to make building such models easier, and
9 functions for rendering an ADT into an OpenSCAD program.
10homepage: https://chiselapp.com/user/mwm/repository/OpenSCAD/
11license: BSD3
12license-file: LICENSE
13author: Mike Meyer
14maintainer: mwm@mired.org
15-- copyright:
16category: Graphics
17build-type: Simple
18extra-source-files: README.md
19cabal-version: >=1.10
20
21library
22 exposed-modules: Graphics.OpenSCAD, Graphics.OpenSCAD.Unicode
23 -- other-modules:
24 other-extensions: UnicodeSyntax
25 build-depends: base > 4.5 && < 5.0,
26 colour >=2.3 && < 2.4,
27 filepath >=1.3 && < 1.5,
28 semigroups >= 0.15 && < 1.0,
29 containers >= 0.5
30 -- hs-source-dirs:
31 default-language: Haskell2010
32
33Test-Suite Units
34 type: exitcode-stdio-1.0
35 main-is: UnitTest.hs
36 build-depends: base > 4.5 && < 5.0,
37 colour >=2.3,
38 filepath >=1.3,
39 HUnit >=1.2,
40 Cabal >= 1.18,
41 tasty-hunit >= 0.9,
42 tasty >=0.8,
43 deepseq >= 1.3,
44 testpack >= 2.1.2.1,
45 containers >= 0.5.5.1,
46 semigroups >= 0.15 && < 1.0,
47 containers >= 0.5
48 default-language: Haskell2010
49
50source-repository head
51 type: fossil
52 location: https://chiselapp.com/user/mwm/repository/OpenSCAD/
53
54source-repository this
55 type: fossil
56 location: https://chiselapp.com/user/mwm/repository/OpenSCAD/
57 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 @@
1# What's Graphics.OpenSCAD
2
3This is a library whose primary component is an algebraic data type
4for describing [OpenSCAD](http://openscad.org) models, and a function
5that converts that data type into a string. There are convenience
6functions to make building the model easier.
7
8## What's different
9
10Given the primitive and quirky nature of the OpenSCAD language, the
11idea of "using OpenSCAD" as an assembler is both obvious, and promoted
12in lieu of adding major extensions to OpenSCAD. So there are a number
13of such projects, for a variety of languages.
14
15Any compiler that generated "assembler" that caused the assembler
16program to generate errors would be considered buggy. However, none of
17the alternative projects I looked at seemed to do anything about that
18(my apologies if I missed one - I only looked at languages I was
19interested in using). Graphics.OpenSCAD takes the attitude that errors
20from OpenSCAD on the generated code are errors in
21Graphics.OpenSCAD. If you manage to generate code that causes OpenSCAD
22to issue an error message, please open an issue here.
23
24## More info
25
26Read the
27[online docs](https://hackage.haskell.org/package/OpenSCAD-0.2.1.0/docs/Graphics-OpenSCAD.html)
28at [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 @@
1import Distribution.Simple
2main = 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 @@
1#!/usr/bin/env runghc
2
3module Main where
4
5import Control.DeepSeq
6import Control.Exception
7import Test.Tasty
8import Test.Tasty.HUnit
9import Test.HUnit.Tools
10import Graphics.OpenSCAD
11import Data.Colour (withOpacity)
12import Data.List.NonEmpty (fromList)
13import Data.Semigroup (Semigroup((<>), sconcat), Monoid(mconcat, mempty, mappend))
14
15
16
17assertError err code =
18 assertRaises "Check error" (ErrorCall err) . evaluate $ deepseq (show code) ()
19
20sw = concat . words
21st n e a = testCase n $ (sw $ render a) @?= (sw e)
22
23
24{- About the test result values.
25
26Running "cabal test" does not verify that the results do the intended
27thing in OpenSCAD. Possibly we'll add shell tests for that at some
28point, but not yet.
29
30For now, if you change or add strings, please manually copy them into
31OpenSCAD and make sure they do what you want the Model data structure
32that they are testing does.
33-}
34
35tests = testGroup "Tests" [
36 testGroup "3d-primitives" [
37 testGroup "Spheres" [
38 st "1" "sphere(1.0);" $ sphere 1 def,
39 st "2" "sphere(2.0,$fn=100);" (sphere 2 $ fn 100),
40 st "3" "sphere(2.0,$fa=5.0);" (sphere 2 $ fa 5),
41 st "4" "sphere(2.0,$fs=0.1);" (sphere 2 $ fs 0.1)
42 ],
43
44 testGroup "Boxes" [
45 st "box" "cube([1.0,2.0,3.0]);" $ box 1 2 3,
46 st "cube" "cube([2.0,2.0,2.0]);" $ cube 2
47 ],
48
49 testGroup "Cylinders" [
50 st "1" "cylinder(r=1.0,h=2.0);" $ cylinder 1 2 def,
51 st "2" "cylinder(r=1.0,h=2.0,$fs=0.6);" (cylinder 1 2 $ fs 0.6),
52 st "3" "cylinder(r=1.0,h=2.0,$fn=10);" (cylinder 1 2 $ fn 10),
53 st "4" "cylinder(r=1.0,h=2.0,$fa=30.0);" (cylinder 1 2 $ fa 30)
54 ],
55
56 testGroup "Oblique-Cylinders" [
57 st "1" "cylinder(r1=1.0,h=2.0,r2=2.0);" $ obCylinder 1 2 2 def,
58 st "2" "cylinder(r1=1.0,h=2.0,r2=2.0,$fs=0.6);"
59 (obCylinder 1 2 2 $ fs 0.6),
60 st "3" "cylinder(r1=1.0,h=2.0,r2=2.0,$fn=10);"
61 (obCylinder 1 2 2 $ fn 10),
62 st "4" "cylinder(r1=1.0,h=2.0,r2=2.0,$fa=30.0);"
63 (obCylinder 1 2 2 $ fa 30)
64 ],
65
66 testGroup "Misc" [
67 st "import" "import(\"test.stl\");" (solid $ importFile "test.stl"),
68 st "polyhedron 1"
69 "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);" $
70 polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],
71 [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],
72 [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],
73 [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],
74 [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],
75 [(-10, -10, 0), (10, -10, 0), (-10, 10, 0)]],
76 st "polyhedron 2"
77 "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);" $
78 polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],
79 [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],
80 [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],
81 [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],
82 [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (10, 10, 0)]],
83 st "unsafePolyhedron"
84 "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);"
85 (unsafePolyhedron 1 [(10.0,10.0,0.0),(10.0,-10.0,0.0),(-10.0,-10.0,0.0),
86 (-10.0,10.0,0.0),(0.0,0.0,10)]
87 $ Faces [[0,1,4],[1,2,4],[2,3,4],[3,0,4],[1,0,3],
88 [2,1,3]])
89 ],
90 testGroup "Linear-Extrusion" [
91 st "1"
92 "linear_extrude(height=10.0,twist=0.0,scale=[1.0,1.0],slices=10,convexity=10)circle(1.0);"
93 (linearExtrude 10 0 (1, 1) 10 10 def $ circle 1 def),
94 st "2"
95 "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);"
96 (linearExtrude 10 100 (1, 1) 10 10 def $ translate (2, 0)
97 $ circle 1 def),
98 st "3"
99 "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);"
100 (linearExtrude 10 500 (1, 1) 10 10 def $ translate (2, 0)
101 $ circle 1 def),
102 st "4"
103 "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);"
104 (linearExtrude 10 360 (1, 1) 100 10 def $ translate (2, 0)
105 $ circle 1 def),
106 st "5"
107 "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);"
108 (linearExtrude 10 360 (1, 1) 100 10 (fn 100) $ translate (2, 0)
109 $ circle 1 def),
110 st "6"
111 "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);"
112 (linearExtrude 10 0 (3, 3) 100 10 def $ translate (2, 0) $ circle 1 def),
113 st "7"
114 "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);"
115 (linearExtrude 10 0 (1, 5) 100 10 (fn 100) $ translate (2, 0)
116 $ circle 1 def)
117 ],
118
119 testGroup "Rotated-Extrusion" [
120 st "1" "rotate_extrude(convexity=10)translate([2.0,0.0])circle(1.0);"
121 (rotateExtrude 10 def $ translate (2, 0) $ circle 1 def),
122 st "2"
123 "rotate_extrude(convexity=10,$fn=100)translate([2.0,0.0])circle(1.0,$fn=100);"
124 (rotateExtrude 10 (fn 100) $ translate (2, 0) $ circle 1 $ fn 100)
125 ],
126
127 testGroup "Surface" [
128 st "Normal" "surface(file=\"test.dat\",convexity=5);" $
129 surface "test.dat" False 5,
130 st "Inverted" "surface(file=\"test.dat\",invert=true,convexity=5);" $
131 surface "test.dat" True 5 -- Requires 2014.QX
132 ]
133 ],
134
135 testGroup "2d-primitives" [
136 testGroup "Squares" [
137 st "rectangle" "square([2.0,3.0]);" $ rectangle 2 3,
138 st "square" "square([2.0,2.0]);" $ square 2
139 ],
140 testGroup "Circles" [
141 st "1" "circle(1.0);" $ circle 1 def,
142 st "2" "circle(2.0,$fn=100);" (circle 2 $ fn 100),
143 st "3" "circle(2.0,$fa=5.0);" (circle 2 $ fa 5),
144 st "4" "circle(2.0,$fs=0.1);" (circle 2 $ fs 0.1)
145 ],
146 testGroup "Misc" [
147 st "import" "import(\"test.dxf\");" (solid $ importFile "test.dxf"),
148 st "polygon"
149 "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);" $
150 polygon 10 [[(0,0),(100,0),(0,100)],[(10,10),(80,10),(10,80)]],
151 st "unsafePolygon"
152 "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);"
153 (unsafePolygon 1 [(0,0),(100,0),(0,100),(10,10),(80,10),(10,80)]
154 [[0,1,2],[3,4,5]]),
155 st "projection"
156 "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]);}"
157 (projection False . scale (10, 10, 10) . difference (up 1 (cube 1))
158 $ translate (0.25, 0.25, 0) (box 0.5 0.5 3))
159 ]
160 ],
161
162 testGroup "Transformations" [
163 testGroup "Size changes" [
164 st "scale 1" "scale([0.5,1.0,2.0])cube([1.0,1.0,1.0]);"
165 (scale (0.5, 1, 2) $ cube 1),
166 st "scale 2" "scale([0.5,2.0])square([1.0,1.0]);"
167 (scale (0.5, 2) $ rectangle 1 1),
168 st "resize 1" "resize([10.0,20.0])square([2.0,2.0]);"
169 (resize (10, 20) $ square 2),
170 st "resize 2" "resize([10.0,20.0,30.0])cube([2.0,2.0,2.0]);"
171 (resize (10, 20, 30) $ cube 2)
172 ],
173
174 testGroup "Rotations" [
175 st "1" "rotate([180.0,0.0,0.0])cube([2.0,2.0,2.0]);"
176 (rotate (180, 0, 0) $ cube 2),
177 st "2" "rotate([0.0,180.0,0.0])cube([2.0,2.0,2.0]);"
178 (rotate (0, 180, 0) $ cube 2),
179 st "3" "rotate([0.0,180.0,180.0])cube([2.0,2.0,2.0]);"
180 (rotate (0, 180, 180) $ cube 2),
181 st "4" "rotate([180.0,0.0])square([2.0,1.0]);"
182 (rotate (180, 0) $ rectangle 2 1),
183 st "5" "rotate([0.0,180.0])square([2.0,1.0]);"
184 (rotate (0, 180) $ rectangle 2 1)
185 ],
186 testGroup "Mirrors" [
187 st "1" "mirror([1.0,0.0,0.0])cube([2.0,2.0,2.0]);"
188 (mirror (1, 0, 0) $ cube 2),
189 st "2" "mirror([0.0,1.0,0.0])cube([2.0,2.0,2.0]);"
190 (mirror (0, 1, 0) $ cube 2),
191 st "3" "rotate([0.0,1.0,1.0])cube([2.0,2.0,2.0]);"
192 (rotate (0, 1, 1) $ cube 2),
193 st "4" "mirror([1.0,0.0])square([2.0,1.0]);"
194 (mirror (1, 0) $ rectangle 2 1),
195 st "2" "mirror([0.0,1.0])square([2.0,1.0]);"
196 (mirror (0, 1) $ rectangle 2 1)
197 ],
198
199 st "multmatrix"
200 "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);"
201 (multMatrix ( (1, 0, 0, 10),
202 (0, 1, 0, 20),
203 (0, 0, 1, 30),
204 (0, 0, 0, 1) ) $ cylinder 2 3 def),
205
206 testGroup "Colors" [
207 st "color 1" "color([1.0,0.0,0.0])cube([1.0,1.0,1.0]);" (color red $ cube 1),
208 st "color 2" "color([1.0,0.0,0.0])square([1.0,1.0]);"
209 (color red $ square 1),
210 st "transparent 1" "color([1.0,0.0,0.0,0.7])cube([1.0,1.0,1.0]);"
211 (transparent (red `withOpacity` 0.7) $ cube 1),
212 st "transparent 2" "color([1.0,0.0,0.0,0.7])square([1.0,1.0]);"
213 (transparent (red `withOpacity` 0.7) $ square 1)
214 ]
215 ],
216
217 testGroup "Facets" [
218 st "facet 1" "assign($fn=100){sphere(2.0,$fn=100);}"
219 (var (fn 100) [sphere 2 $ fn 100]),
220 st "facet 2" "assign($fa=5.0){sphere(2.0,$fa=5.0);}"
221 (var (fa 5) [sphere 2 $ fa 5]),
222 st "facet 3" "assign($fs=0.1){sphere(2.0,$fs=0.1);}"
223 (var (fs 0.1) [sphere 2 $ fs 0.1])
224 ],
225
226 testGroup "Errors" [
227 testCase "Polygon Pointcount"
228 . assertError "Polygon has fewer than 3 points." $
229 polygon 1 [[(0, 0), (0, 1)]],
230 testCase "Polygon Linearity"
231 . assertError "Points in polygon are collinear." $
232 polygon 1 [[(0, 0), (0, 1), (0, 2)]],
233 testCase "Polyhedron Linearity"
234 . assertError "Some face has collinear points." $
235 polyhedron 1 [[(0, 0, 0), (1, 0, 0), (2, 0, 0)]],
236 testCase "Polyhedron Planarity" . assertError "Some face isn't coplanar." $
237 polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 10, 10)],
238 [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],
239 [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],
240 [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],
241 [(-10, 10, 0), (-10, -10, 0), (10, -10, 0), (0, 0, -10)]],
242 testCase "Polyhedron Edges" . assertError "Some edges are not in two faces." $
243 polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],
244 [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],
245 [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],
246 [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],
247 [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],
248 [(-10, -10, 0), (10, -10, 0), (-10, 20, 0)]],
249 testCase "Polyhedron Faces"
250 . assertError "Some faces have different orientation." $
251 polyhedron 1 [[(10, 10, 0), (10, -10, 0), (0, 0, 10)],
252 [(10, -10, 0), (-10, -10, 0), (0, 0, 10)],
253 [(-10, -10, 0), (-10, 10, 0), (0, 0, 10)],
254 [(-10, 10, 0), (10, 10, 0), (0, 0, 10)],
255 [(10, -10, 0), (10, 10, 0), (-10, 10, 0)],
256 [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]],
257 testCase "Polyhedron Orientation"
258 . assertError "Face orientations are counterclockwise." $
259 polyhedron 1 [[(10, -10, 0), (10, 10, 0), (0, 0, 10)],
260 [(-10, -10, 0), (10, -10, 0), (0, 0, 10)],
261 [(-10, 10, 0), (-10, -10, 0), (0, 0, 10)],
262 [(10, 10, 0), (-10, 10, 0), (0, 0, 10)],
263 [(10, 10, 0), (10, -10, 0), (-10, 10, 0)],
264 [(10, -10, 0), (-10, -10, 0), (-10, 10, 0)]]
265 ],
266
267 testGroup "Combinations" [
268 st "union" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
269 (union [cube 1, sphere 1.1 $ fs 0.1]),
270 st "difference" "difference(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
271 (difference (cube 1) . sphere 1.1 $ fs 0.1),
272 st "intersection" "intersection(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
273 (intersection [cube 1, sphere 1.1 $ fs 0.1]),
274 st "minkowski"
275 "minkowski(){cube([10.0,10.0,10.0]);cylinder(r=2.0,h=1.1,$fn=50);}"
276 (minkowski [cube 10, cylinder 2 1.1 $ fn 50]),
277 st "hull" "hull(){translate([15.0,10.0])circle(10.0);circle(10.0);}"
278 (hull [circle 10 def # translate (15, 10), circle 10 def])
279 ],
280
281 testGroup "Haskell" [
282 st "# 3d" "translate([-3.0,-3.0,-3.0])color([1.0,0.0,0.0])cube([3.0,3.0,3.0]);"
283 (cube 3 # color red # translate (-3, -3, -3)),
284 st "# 2d"
285 "translate([3.0,3.0])color([1.0,0.6470588235294119,0.0])square([2.0,2.0]);"
286 (square 2 # color orange # translate (3, 3)),
287 st "Monoid 1 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
288 (cube 1 <> sphere 1.1 (fs 0.1)),
289 st "Monoid 1 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
290 (square 1 <> circle 1.1 (fs 0.1)),
291 st "Monoid 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
292 (mconcat [cube 1, sphere 1.1 $ fs 0.1]),
293 st "Monoid 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
294 (mconcat [square 1, circle 1.1 $ fs 0.1]),
295 st "Monoid 3 3d" "sphere(1.1,$fs=0.1);" (mconcat [sphere 1.1 $ fs 0.1]),
296 st "Monoid 3 2d" "square([1.0,1.0]);" (mconcat [square 1]),
297 st "Semigroup 1 3d" "cube([0.0,0.0,0.0]);" (solid mempty),
298 -- should we export a "shape" function?
299 st "Semigroup 1 2d" "cube([0.0,0.0,0.0]);" (mempty :: Model2d),
300 st "Semigroup 2 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
301 (mappend (cube 1) $ sphere 1.1 (fs 0.1)),
302 st "Semigroup 2 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
303 (mappend (square 1) $ circle 1.1 (fs 0.1)),
304 st "Semigroup 3 3d" "union(){cube([1.0,1.0,1.0]);sphere(1.1,$fs=0.1);}"
305 (sconcat $ fromList [cube 1, sphere 1.1 $ fs 0.1]),
306 st "Semigroup 3 2d" "union(){square([1.0,1.0]);circle(1.1,$fs=0.1);}"
307 (sconcat $ fromList [square 1, circle 1.1 $ fs 0.1])
308 ]
309 ]
310
311main = 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:
22- temporary 22- temporary
23- lens 23- lens
24- linear 24- linear
25- OpenSCAD
25 26
26library: 27library:
27 source-dirs: . 28 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
34# - wai 34# - wai
35packages: 35packages:
36- . 36- .
37- openscad
37# Dependency packages to be pulled from upstream that are not in the resolver 38# Dependency packages to be pulled from upstream that are not in the resolver
38# using the same syntax as the packages field. 39# using the same syntax as the packages field.
39# (e.g., acme-missiles-0.3) 40# (e.g., acme-missiles-0.3)