Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

98 lines (61 sloc) 3.477 kB
{-# LANGUAGE OverloadedStrings #-}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.SymbolicFormats where
import Graphics.Implicit.Definitions
import Graphics.Implicit.Export.TextBuilderUtils
import Control.Monad.Reader
import Control.Monad (sequence)
import Data.List (intersperse)
scad2 ::-> SymbolicObj2 -> Text
scad2 res obj = toLazyText $ runReader (buildS2 obj) res
scad3 ::-> SymbolicObj3 -> Text
scad3 res obj = toLazyText $ runReader (buildS3 obj) res
-- Format an openscad call given that all the modified objects are in the Reader monad...
call :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call name args [] = return $ name <> buildArgs args <> ";"
call name args [obj] = fmap ((name <> buildArgs args) <>) obj
call name args objs = do
objs' <- fmap (mconcat . map (<> "\n")) $ sequence objs
return $! name <> buildArgs args <> "{\n" <> objs' <> "}\n"
buildArgs [] = "()"
buildArgs args = "([" <> mconcat (intersperse "," args) <> "])"
buildS3 :: SymbolicObj3 -> ReaderBuilder
buildS3 (UnionR3 0 objs) = call "union" [] $ map buildS3 objs
buildS3 (DifferenceR3 0 objs) = call "difference" [] $ map buildS3 objs
buildS3 (IntersectR3 0 objs) = call " intersection" [] $ map buildS3 objs
buildS3 (Translate3 (x,y,z) obj) = call "translate" [bf x, bf y, bf z] [buildS3 obj]
buildS3 (Scale3 (x,y,z) obj) = call "scale" [bf x, bf y, bf x] [buildS3 obj]
buildS3 (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) = call "translate" [bf x1, bf y1, bf z1] [
call "cube" [bf $ x2 - x1, bf $ y2 - y1, bf $ z2 - z1] []
]
buildS3 (Cylinder h r1 r2) = call "cylinder" [
"r1 = " <> bf r1
,"r2 = " <> bf r2
, bf h
] []
buildS3 (Sphere r) = call "sphere" ["r = " <> bf r] []
buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [bf h] [buildS2 obj]
buildS3 (ExtrudeRotateR 0 twist obj h) =
call "linear_extrude" [bf h, "twist = " <> bf twist] [buildS2 obj]
buildS3 (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) = do
res <- ask
call "union" [] [
call "rotate" ["0","0", bf $ twist h] [
call "linear_extrude" [bf res, "twist = " <> bf (twist (h+res) - twist h)][
buildS2 obj
]
] | h <- init [0, res .. height]
]
buildS2 :: SymbolicObj2 -> ReaderBuilder
buildS2 (UnionR2 0 objs) = call "union" [] $ map buildS2 objs
buildS2 (DifferenceR2 0 objs) = call "difference" [] $ map buildS2 objs
buildS2 (IntersectR2 0 objs) = call "intersection" [] $ map buildS2 objs
buildS2 (Translate2 (x,y) obj) = call "translate" [bf x, bf y] $ [buildS2 obj]
buildS2 (Scale2 (x,y) obj) = call "scale" [bf x, bf y] $ [buildS2 obj]
buildS2 (RectR 0 (x1,y1) (x2,y2)) = call "translate" [bf x1, bf y1] [
call "cube" [bf $ x2 - x1, bf $ y2 - y1] []
]
buildS2 (Circle r) = call "circle" [bf r] []
buildS2 (PolygonR 0 points) = call "polygon" [buildVector [x,y] | (x,y) <- points] []
where buildVector comps = "[" <> mconcat (intersperse "," $ map bf comps) <> "]"
Jump to Line
Something went wrong with that request. Please try again.