{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- FIXME: describe why we need this.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- output SCAD code, AKA an implicitcad to openscad converter.
module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where

import Prelude((.), fmap, Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))

import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)

import Control.Monad.Reader (Reader, runReader, ask)

-- For constructing vectors of ℝs.
import Linear (V2(V2), V3(V3), V4(V4))

import Data.List (intersperse)
import Data.Function (fix)
import Data.Foldable(fold, foldMap, toList)
import Graphics.Implicit.ObjectUtil.GetBoxShared (VectorStuff(elements))

default (ℝ)

scad2 :: ℝ -> SymbolicObj2 -> Text
scad2 :: ℝ -> SymbolicObj2 -> Text
scad2 ℝ
res SymbolicObj2
obj = Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Reader ℝ Builder -> ℝ -> Builder
forall r a. Reader r a -> r -> a
runReader (SymbolicObj2 -> Reader ℝ Builder
buildS2 SymbolicObj2
obj) ℝ
res

scad3 :: ℝ -> SymbolicObj3 -> Text
scad3 :: ℝ -> SymbolicObj3 -> Text
scad3 ℝ
res SymbolicObj3
obj = Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Reader ℝ Builder -> ℝ -> Builder
forall r a. Reader r a -> r -> a
runReader (SymbolicObj3 -> Reader ℝ Builder
buildS3 SymbolicObj3
obj) ℝ
res

-- used by rotate2 and rotate3
rad2deg :: ℝ -> ℝ
rad2deg :: ℝ -> ℝ
rad2deg ℝ
r = ℝ
r ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (ℝ
180ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
forall a. Floating a => a
pi)

-- | Format an openscad call given that all the modified objects are in the Reader monad...
callToken :: (Text, Text) -> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callToken :: (Text, Text)
-> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callToken (Text, Text)
cs Builder
name [Builder]
args []    = Builder -> Reader a Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Reader a Builder) -> Builder -> Reader a Builder
forall a b. (a -> b) -> a -> b
$ Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> [Builder] -> Builder
buildArgs (Text, Text)
cs [Builder]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"
callToken (Text, Text)
cs Builder
name [Builder]
args [Reader a Builder
obj] = ((Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> [Builder] -> Builder
buildArgs (Text, Text)
cs [Builder]
args) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> Reader a Builder -> Reader a Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a Builder
obj
callToken (Text, Text)
cs Builder
name [Builder]
args [Reader a Builder]
objs  = do
  Builder
objs' <- (Builder -> Builder) -> [Builder] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") ([Builder] -> Builder)
-> ReaderT a Identity [Builder] -> Reader a Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reader a Builder] -> ReaderT a Identity [Builder]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Reader a Builder]
objs
  Builder -> Reader a Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Reader a Builder) -> Builder -> Reader a Builder
forall a b. (a -> b) -> a -> b
$! Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> [Builder] -> Builder
buildArgs (Text, Text)
cs [Builder]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"{\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
objs' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"

buildArgs :: (Text, Text) -> [Builder] -> Builder
buildArgs :: (Text, Text) -> [Builder] -> Builder
buildArgs (Text, Text)
_ [] = Builder
"()"
buildArgs (Text
c1, Text
c2) [Builder]
args = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
c1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," [Builder]
args) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
c2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

call :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call = (Text, Text)
-> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
forall a.
(Text, Text)
-> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callToken (Text
"[", Text
"]")

callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked = (Text, Text)
-> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
forall a.
(Text, Text)
-> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callToken (Text
"", Text
"")

------------------------------------------------------------------------------
-- | Class which allows us to build the contained objects in 'buildShared'.
class Build obj where
  build :: obj -> Reader ℝ Builder

instance Build SymbolicObj2 where
  build :: SymbolicObj2 -> Reader ℝ Builder
build = SymbolicObj2 -> Reader ℝ Builder
buildS2

instance Build SymbolicObj3 where
  build :: SymbolicObj3 -> Reader ℝ Builder
build = SymbolicObj3 -> Reader ℝ Builder
buildS3

------------------------------------------------------------------------------
-- | Unpack a dimensionality-polymorphic vector into multiple arguments.
vectAsArgs :: VectorStuff vec => vec -> [Builder]
vectAsArgs :: vec -> [Builder]
vectAsArgs = (ℝ -> Builder) -> [ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ -> Builder
bf ([ℝ] -> [Builder]) -> (vec -> [ℝ]) -> vec -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> [ℝ]
forall vec. VectorStuff vec => vec -> [ℝ]
elements

------------------------------------------------------------------------------
-- | Unpack a dimensionality-polymorphic vector into a single argument.
bvect :: VectorStuff vec => vec -> Builder
bvect :: vec -> Builder
bvect vec
v = Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ vec -> [Builder]
forall vec. VectorStuff vec => vec -> [Builder]
vectAsArgs vec
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"

------------------------------------------------------------------------------
-- | Build the common combinators.
buildShared :: forall obj f a. (Build obj, VectorStuff (f a)) => SharedObj obj f a -> Reader ℝ Builder

buildShared :: SharedObj obj f a -> Reader ℝ Builder
buildShared SharedObj obj f a
Empty = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"union" [] []

buildShared SharedObj obj f a
Full = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"difference" [] [Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"union" [] []]

buildShared (Complement obj
obj) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"complement" [] [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

buildShared (UnionR ℝ
r [obj]
objs) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"union" [] ([Reader ℝ Builder] -> Reader ℝ Builder)
-> [Reader ℝ Builder] -> Reader ℝ Builder
forall a b. (a -> b) -> a -> b
$ obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build (obj -> Reader ℝ Builder) -> [obj] -> [Reader ℝ Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [obj]
objs

buildShared (IntersectR ℝ
r [obj]
objs) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"intersection" [] ([Reader ℝ Builder] -> Reader ℝ Builder)
-> [Reader ℝ Builder] -> Reader ℝ Builder
forall a b. (a -> b) -> a -> b
$ obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build (obj -> Reader ℝ Builder) -> [obj] -> [Reader ℝ Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [obj]
objs

buildShared (DifferenceR ℝ
r obj
obj [obj]
objs) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"difference" [] ([Reader ℝ Builder] -> Reader ℝ Builder)
-> [Reader ℝ Builder] -> Reader ℝ Builder
forall a b. (a -> b) -> a -> b
$ obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build (obj -> Reader ℝ Builder) -> [obj] -> [Reader ℝ Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> obj
obj obj -> [obj] -> [obj]
forall a. a -> [a] -> [a]
: [obj]
objs

buildShared (Translate f a
v obj
obj) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"translate" (ℝ -> Builder
bf (ℝ -> Builder) -> [ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [ℝ]
forall vec. VectorStuff vec => vec -> [ℝ]
elements f a
v) [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

buildShared (Scale f a
v obj
obj) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"scale" (ℝ -> Builder
bf (ℝ -> Builder) -> [ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [ℝ]
forall vec. VectorStuff vec => vec -> [ℝ]
elements f a
v) [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

buildShared (Mirror f a
v obj
obj) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked Builder
"mirror" [ Builder
"v=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> f a -> Builder
forall vec. VectorStuff vec => vec -> Builder
bvect f a
v ] [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

-- NOTE(sandy): This @r == 0@ guard says we only emit "outset" if it has r = 0,
-- erroring otherwise saying "cannot provide roundness." But this is not
-- a roundness parameter!
buildShared (Outset ℝ
r obj
obj) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"outset" [] [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

-- NOTE(sandy): This @r == 0@ guard says we only emit "shell" if it has r = 0,
-- erroring otherwise saying "cannot provide roundness." But this is not
-- a roundness parameter!
buildShared (Shell ℝ
r obj
obj) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"shell" [] [obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj]

buildShared (WithRounding ℝ
r obj
obj) | ℝ
r ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0 = obj -> Reader ℝ Builder
forall obj. Build obj => obj -> Reader ℝ Builder
build obj
obj

buildShared(UnionR ℝ
_ [obj]
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared(IntersectR ℝ
_ [obj]
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared(DifferenceR ℝ
_ obj
_ [obj]
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared(Outset ℝ
_ obj
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared(Shell ℝ
_ obj
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared(EmbedBoxedObj (f a -> a, (f a, f a))
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildShared (WithRounding ℝ
_ obj
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."

-- | First, the 3D objects.
buildS3 :: SymbolicObj3 -> Reader ℝ Builder

buildS3 :: SymbolicObj3 -> Reader ℝ Builder
buildS3 (Shared3 SharedObj SymbolicObj3 V3 ℝ
obj) = SharedObj SymbolicObj3 V3 ℝ -> Reader ℝ Builder
forall obj (f :: * -> *) a.
(Build obj, VectorStuff (f a)) =>
SharedObj obj f a -> Reader ℝ Builder
buildShared SharedObj SymbolicObj3 V3 ℝ
obj

buildS3 (Cube (V3 ℝ
w ℝ
d ℝ
h)) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"cube" [ℝ -> Builder
bf ℝ
w, ℝ -> Builder
bf ℝ
d, ℝ -> Builder
bf ℝ
h] []

buildS3 (Sphere ℝ
r) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked Builder
"sphere" [Builder
"r = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
r] []

buildS3 (Cylinder ℝ
h ℝ
r1 ℝ
r2) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked Builder
"cylinder" [
                              Builder
"r1 = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
r1
                             ,Builder
"r2 = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
r2
                             , ℝ -> Builder
bf ℝ
h
                             ] []
buildS3 (Rotate3 Quaternion ℝ
q SymbolicObj3
obj) =
  let (ℝ
x,ℝ
y,ℝ
z) = Quaternion ℝ -> (ℝ, ℝ, ℝ)
forall a. RealFloat a => Quaternion a -> (a, a, a)
quaternionToEuler Quaternion ℝ
q
   in Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"rotate" [ℝ -> Builder
bf (ℝ -> ℝ
rad2deg ℝ
x), ℝ -> Builder
bf (ℝ -> ℝ
rad2deg ℝ
y), ℝ -> Builder
bf (ℝ -> ℝ
rad2deg ℝ
z)] [SymbolicObj3 -> Reader ℝ Builder
buildS3 SymbolicObj3
obj]

buildS3 (Transform3 M44 ℝ
m SymbolicObj3
obj) =
    Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"multmatrix"
      ((\Builder
x -> Builder
"["Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
xBuilder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
"]") (Builder -> Builder) -> (V4 ℝ -> Builder) -> V4 ℝ -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder) -> (V4 ℝ -> [Builder]) -> V4 ℝ -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ([Builder] -> [Builder])
-> (V4 ℝ -> [Builder]) -> V4 ℝ -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ℝ -> Builder) -> [ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ -> Builder
bf ([ℝ] -> [Builder]) -> (V4 ℝ -> [ℝ]) -> V4 ℝ -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V4 ℝ -> [ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (V4 ℝ -> Builder) -> [V4 ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M44 ℝ -> [V4 ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList M44 ℝ
m)
      [SymbolicObj3 -> Reader ℝ Builder
buildS3 SymbolicObj3
obj]

buildS3 (Extrude SymbolicObj2
obj ℝ
h) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked Builder
"linear_extrude" [Builder
"height = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
h] [SymbolicObj2 -> Reader ℝ Builder
buildS2 SymbolicObj2
obj]

-- FIXME: handle scale, center.
buildS3 (ExtrudeM Either ℝ (ℝ -> ℝ)
twist ExtrudeMScale
scale (Left ℝ2
translate) SymbolicObj2
obj (Left ℝ
height)) |ExtrudeMScale -> Bool
isScaleID ExtrudeMScale
scale Bool -> Bool -> Bool
&& ℝ2
translate ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0 = do
  ℝ
res <- ReaderT ℝ Identity ℝ
forall r (m :: * -> *). MonadReader r m => m r
ask
  let
    twist' :: ℝ -> ℝ
twist' = case Either ℝ (ℝ -> ℝ)
twist of
               Left ℝ
twval  -> ℝ -> ℝ -> ℝ
forall a b. a -> b -> a
const ℝ
twval
               Right ℝ -> ℝ
twfun -> ℝ -> ℝ
twfun
  Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"union" [] [
             Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"rotate" [Builder
"0",Builder
"0", ℝ -> Builder
bf (ℝ -> Builder) -> ℝ -> Builder
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ
twist' ℝ
h] [
                        Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked Builder
"linear_extrude" [Builder
"height = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf ℝ
res, Builder
"twist = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ℝ -> Builder
bf (ℝ -> ℝ
twist' (ℝ
hℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
res) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ -> ℝ
twist' ℝ
h)][
                                   SymbolicObj2 -> Reader ℝ Builder
buildS2 SymbolicObj2
obj
                                  ]
                       ] |  ℝ
h <- Int -> [ℝ] -> [ℝ]
forall a. Int -> [a] -> [a]
take (ℝ -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (ℝ
res ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
height)) ([ℝ] -> [ℝ]) -> [ℝ] -> [ℝ]
forall a b. (a -> b) -> a -> b
$ ((ℝ -> [ℝ]) -> ℝ -> [ℝ]) -> ℝ -> [ℝ]
forall a. (a -> a) -> a
fix (\ℝ -> [ℝ]
f ℝ
x -> ℝ
x ℝ -> [ℝ] -> [ℝ]
forall a. a -> [a] -> [a]
: ℝ -> [ℝ]
f (ℝ
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
res)) ℝ
0
            ]

-- FIXME: where are RotateExtrude, ExtrudeOnEdgeOf?

buildS3 ExtrudeM{} = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildS3 RotateExtrude{} = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."
buildS3(ExtrudeOnEdgeOf SymbolicObj2
_ SymbolicObj2
_) = [Char] -> Reader ℝ Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot provide roundness when exporting openscad; unsupported in target format."

-- Now the 2D objects/transforms.

buildS2 :: SymbolicObj2 -> Reader ℝ Builder

buildS2 :: SymbolicObj2 -> Reader ℝ Builder
buildS2 (Shared2 SharedObj SymbolicObj2 V2 ℝ
obj) = SharedObj SymbolicObj2 V2 ℝ -> Reader ℝ Builder
forall obj (f :: * -> *) a.
(Build obj, VectorStuff (f a)) =>
SharedObj obj f a -> Reader ℝ Builder
buildShared SharedObj SymbolicObj2 V2 ℝ
obj

buildS2 (Circle ℝ
r) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"circle" [ℝ -> Builder
bf ℝ
r] []

buildS2 (Polygon [ℝ2]
points) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"polygon" ((ℝ2 -> Builder) -> [ℝ2] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ2 -> Builder
forall vec. VectorStuff vec => vec -> Builder
bvect [ℝ2]
points) []

buildS2 (Rotate2 ℝ
r SymbolicObj2
obj)     = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"rotate" [ℝ -> Builder
bf (ℝ -> ℝ
rad2deg ℝ
r)] [SymbolicObj2 -> Reader ℝ Builder
buildS2 SymbolicObj2
obj]

buildS2 (Transform2 M33 ℝ
m SymbolicObj2
obj) =
    let toM44 :: V3 (V3 a) -> V4 (V4 a)
toM44 (V3 (V3 a
a a
b a
c) (V3 a
d a
e a
f) (V3 a
g a
h a
i)) =
          (V4 a -> V4 a -> V4 a -> V4 a -> V4 (V4 a)
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
b a
c a
0)
              (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
d a
e a
f a
0)
              (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
g a
h a
i a
0)
              (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
1)
          )
    in
    Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"multmatrix"
      ((\Builder
x -> Builder
"["Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
xBuilder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
"]") (Builder -> Builder) -> (V4 ℝ -> Builder) -> V4 ℝ -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder) -> (V4 ℝ -> [Builder]) -> V4 ℝ -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ([Builder] -> [Builder])
-> (V4 ℝ -> [Builder]) -> V4 ℝ -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ℝ -> Builder) -> [ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ℝ -> Builder
bf ([ℝ] -> [Builder]) -> (V4 ℝ -> [ℝ]) -> V4 ℝ -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V4 ℝ -> [ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (V4 ℝ -> Builder) -> [V4 ℝ] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M44 ℝ -> [V4 ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (M33 ℝ -> M44 ℝ
forall a. Num a => V3 (V3 a) -> V4 (V4 a)
toM44 M33 ℝ
m))
      [SymbolicObj2 -> Reader ℝ Builder
buildS2 SymbolicObj2
obj]

buildS2 (Square (V2 ℝ
w ℝ
h)) = Builder -> [Builder] -> [Reader ℝ Builder] -> Reader ℝ Builder
forall a.
Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
call Builder
"square" [ℝ -> Builder
bf ℝ
w, ℝ -> Builder
bf ℝ
h] []