module Graphics.OpenSCAD (
Solid,
Shape,
Facet,
Vector, Point,
render, draw,
sphere, box, cube, cylinder, obCylinder, rectangle3d, square3d, circle3d,
import3d, linearExtrude, rotateExtrude,
rectangle, square, circle, import2d, projection,
union, intersection, difference, minkowski, hull,
scale, resize, rotate, translate, mirror, multMatrix, color, transparent, up,
projection3d,
scale2d, resize2d, rotate2d, translate2d, mirror2d,
diam,
var, fn, fs, fa, def,
module Colours)
where
import Data.Colour (Colour, AlphaColour, alphaChannel, darken, over, black)
import Data.Colour.SRGB (channelRed, channelBlue, channelGreen, toSRGB)
import System.FilePath (FilePath)
import qualified Data.Colour.Names as Colours
type Vector = (Float, Float, Float)
type Point = (Float, Float)
type Path = [Int]
type Face = (Int, Int, Int)
type Transform = ((Float, Float, Float, Float), (Float, Float, Float, Float),
(Float, Float, Float, Float), (Float, Float, Float, Float))
data Facet = Fa Float | Fs Float | Fn Int | Def deriving Show
data Shape =
Rectangle Float Float
| Circle Float Facet
| Import2d FilePath
| Projection Bool Solid
| Scale2d Point Shape
| Resize2d Point Shape
| Rotate2d Point Shape
| Translate2d Point Shape
| Mirror2d Point Shape
deriving Show
data Solid =
Sphere Float Facet
| Box Float Float Float
| Cylinder Float Float Facet
| ObCylinder Float Float Float Facet
| Import3d FilePath
| Shape Shape
| Union [Solid]
| Intersection [Solid]
| Difference Solid Solid
| Minkowski [Solid]
| Hull [Solid]
| Scale Vector Solid
| Resize Vector Solid
| Rotate Vector Solid
| Translate Vector Solid
| Mirror Vector Solid
| MultMatrix Transform Solid
| Color (Colour Float) Solid
| Transparent (AlphaColour Float) Solid
| LinearExtrude Float Float Point Int Int Facet Shape
| RotateExtrude Int Facet Shape
| Var Facet [Solid]
deriving Show
render :: Solid -> String
render (Sphere x f) = "sphere(" ++ show x ++ rFacet f ++ ");\n\n"
render (Box x y z) =
"cube([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]);\n"
render (Cylinder r h f) =
"cylinder(r=" ++ show r ++ ",h=" ++ show h ++ rFacet f ++ ");\n\n"
render (ObCylinder r1 h r2 f) =
"cylinder(r1=" ++ show r1 ++ ",h=" ++ show h ++ ",r2=" ++ show r2 ++ rFacet f
++ ");\n\n"
render (Import3d f) = "import(" ++ f ++");\n\n"
render (Shape s) = rShape s
render (Union ss) = rList "union()" ss
render (Intersection ss) = rList "intersection()" ss
render (Difference s1 s2) = "difference(){" ++ render s1 ++ render s2 ++ "}\n\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(a=" ++ rVector v ++ ")" ++ render s
render (Mirror v s) = rVecSolid "mirror" v s
render (MultMatrix (a, b, c, d) s) =
"multmatrix([" ++ rQuad a ++ "," ++ rQuad b ++ "," ++ rQuad c ++ ","
++ rQuad d ++"])\n" ++ render s
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 (LinearExtrude h t sc sl c f sh) =
"linear_extrude(height=" ++ show h ++ ",twist=" ++ show t ++ ",scale="
++ rPoint sc ++ ",slices=" ++ show sl ++ ",convexity=" ++ show c ++ rFacet f
++ ")" ++ rShape sh
render (RotateExtrude c f sh) =
"rotate_extrude(convexity=" ++ show c ++ rFacet f ++ ")" ++ rShape sh
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
draw = putStrLn . render
rShape (Rectangle r f) = "square([" ++ show r ++ "," ++ show f ++ "]);\n\n"
rShape (Circle r f) = "circle(" ++ show r ++ rFacet f ++ ");\n\n"
rShape (Import2d f) = "import(" ++ f ++ ");\n\n"
rShape (Projection c s) =
"projection(cut=" ++ (if c then "true)" else "false)") ++ render s
rShape (Scale2d p s) = "scale(" ++ rPoint p ++ ")" ++ rShape s
rShape (Resize2d p s) = "resize(" ++ rPoint p ++ ")" ++ rShape s
rShape (Rotate2d p s) = "rotate(" ++ rPoint p ++ ")" ++ rShape s
rShape (Translate2d p s) = "translate(" ++ rPoint p ++ ")" ++ rShape s
rShape (Mirror2d p s) = "mirror(" ++ rPoint p ++ ")" ++ rShape s
rList n ss = n ++ "{\n" ++ concatMap render ss ++ "}"
rSolid n s = n ++ "()\n" ++ render s
rVector (a, b, c) = "[" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "]"
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
rPoint (x, y) = "[" ++ show x ++ "," ++ show y ++ "]"
showFacet :: Facet -> String
showFacet (Fa f) = "$fa=" ++ show f
showFacet (Fs f) = "$fs=" ++ show f
showFacet (Fn n) = "$fn=" ++ show n
showFacet Def = ""
sphere :: Float -> Facet -> Solid
sphere = Sphere
box :: Float -> Float -> Float -> Solid
box = Box
cube :: Float -> Solid
cube x = Box x x x
cylinder :: Float -> Float -> Facet -> Solid
cylinder = Cylinder
obCylinder :: Float -> Float -> Float -> Facet -> Solid
obCylinder = ObCylinder
import3d :: FilePath -> Solid
import3d = Import3d
import2d :: FilePath -> Shape
import2d = Import2d
union :: [Solid] -> Solid
union = Union
intersection :: [Solid] -> Solid
intersection = Intersection
difference :: Solid -> Solid -> Solid
difference = Difference
minkowski :: [Solid] -> Solid
minkowski = Minkowski
hull :: [Solid] -> Solid
hull = Hull
scale :: Vector -> Solid -> Solid
scale = Scale
resize :: Vector -> Solid -> Solid
resize = Resize
rotate :: Vector -> Solid -> Solid
rotate = Rotate
translate :: Vector -> Solid -> Solid
translate = Translate
mirror :: Vector -> Solid -> Solid
mirror = Mirror
multMatrix :: Transform -> Solid -> Solid
multMatrix = MultMatrix
up :: Float -> Solid -> Solid
up f = Translate (0, 0, f)
color :: Colour Float -> Solid -> Solid
color = Color
transparent :: AlphaColour Float -> Solid -> Solid
transparent = Transparent
linearExtrude :: Float
-> Float
-> Point
-> Int
-> Int
-> Facet
-> Shape
-> Solid
linearExtrude = LinearExtrude
rotateExtrude :: Int -> Facet -> Shape -> Solid
rotateExtrude = RotateExtrude
diam :: Float -> Float
diam = (/ 2)
rectangle :: Float -> Float -> Shape
rectangle = Rectangle
rectangle3d :: Float -> Float -> Solid
rectangle3d w d = Shape $ Rectangle w d
square :: Float -> Shape
square s = rectangle s s
square3d :: Float -> Solid
square3d s = rectangle3d s s
circle :: Float -> Facet -> Shape
circle = Circle
circle3d :: Float -> Facet -> Solid
circle3d r f = Shape $ Circle r f
projection :: Bool -> Solid -> Shape
projection = Projection
projection3d :: Bool -> Solid -> Solid
projection3d c s = Shape $ Projection c s
scale2d :: Point -> Shape -> Shape
scale2d = Scale2d
resize2d :: Point -> Shape -> Shape
resize2d = Resize2d
rotate2d :: Point -> Shape -> Shape
rotate2d = Rotate2d
translate2d :: Point -> Shape -> Shape
translate2d = Translate2d
mirror2d :: Point -> Shape -> Shape
mirror2d = Mirror2d
var :: Facet -> [Solid] -> Solid
var = Var
fa :: Float -> Facet
fa = Fa
fs :: Float -> Facet
fs = Fs
fn :: Int -> Facet
fn = Fn
def :: Facet
def = Def