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

-- Idealy, we'd like to parse a superset of openscad code, with some improvements.

-- This file provides primitive objects for the openscad parser.

-- Allow us to use type signatures in patterns.
{-# LANGUAGE ScopedTypeVariables #-}

-- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-}

-- Export one set containing all of the primitive modules.
module Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules) where

import Prelude((.), Either(Left, Right), Bool(True, False), Maybe(Just, Nothing), ($), pure, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, (/=), (||), not, null, fmap, (<>), otherwise, error, (<*>), (<$>))

import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1), fromℕtoℝ, isScaleID)

import Graphics.Implicit.ExtOpenScad.Definitions (OVal (OObj2, OObj3, ONModule), ArgParser(APFail), Symbol(Symbol), StateC, SourcePosition)

import Graphics.Implicit.ExtOpenScad.Util.ArgParser (doc, defaultTo, example, test, eulerCharacteristic)

import qualified Graphics.Implicit.ExtOpenScad.Util.ArgParser as GIEUA (argument)

import Graphics.Implicit.ExtOpenScad.Util.OVal (OTypeMirror, caseOType, divideObjs, (<||>))

import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC)

-- Note the use of a qualified import, so we don't have the functions in this file conflict with what we're importing.
import qualified Graphics.Implicit.Primitives as Prim (withRounding, sphere, rect3, rect, translate, circle, polygon, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone)

import Control.Monad (when, mplus)

import Data.Text.Lazy (Text)

import Control.Lens ((^.))
import Linear (_m33, M34, M44, V2(V2), V3(V3), V4(V4))
import Linear.Affine (qdA)

default (ℝ)

-- | Use the old syntax when defining arguments.
argument :: OTypeMirror desiredType => Text -> ArgParser desiredType
argument :: forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
a = forall desiredType.
OTypeMirror desiredType =>
Symbol -> ArgParser desiredType
GIEUA.argument (Text -> Symbol
Symbol Text
a)

-- | The only thing exported here. basically, a list of modules.
primitiveModules :: [(Symbol, OVal)]
primitiveModules :: [(Symbol, OVal)]
primitiveModules =
  [
    (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
sphere [([(Text
"r", Bool
noDefault)], Maybe Bool
noSuite), ([(Text
"d", Bool
noDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cube [([(Text
"x", Bool
noDefault), (Text
"y", Bool
noDefault), (Text
"z", Bool
noDefault), (Text
"center", Bool
hasDefault), (Text
"r", Bool
hasDefault)], Maybe Bool
noSuite),([(Text
"size", Bool
noDefault), (Text
"center", Bool
hasDefault), (Text
"r", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
square [([(Text
"x", Bool
noDefault), (Text
"y", Bool
noDefault), (Text
"center", Bool
hasDefault), (Text
"r", Bool
hasDefault)], Maybe Bool
noSuite), ([(Text
"size", Bool
noDefault), (Text
"center", Bool
hasDefault), (Text
"r", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cylinder [([(Text
"r", Bool
hasDefault), (Text
"h", Bool
hasDefault), (Text
"r1", Bool
hasDefault), (Text
"r2", Bool
hasDefault), (Text
"$fn", Bool
hasDefault), (Text
"center", Bool
hasDefault)], Maybe Bool
noSuite),
                       ([(Text
"d", Bool
hasDefault), (Text
"h", Bool
hasDefault), (Text
"d1", Bool
hasDefault), (Text
"d2", Bool
hasDefault), (Text
"$fn", Bool
hasDefault), (Text
"center", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
circle [([(Text
"r", Bool
noDefault), (Text
"$fn", Bool
hasDefault)], Maybe Bool
noSuite), ([(Text
"d", Bool
noDefault), (Text
"$fn", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cone [([(Text
"r", Bool
noDefault), (Text
"h", Bool
hasDefault), (Text
"center", Bool
hasDefault)], Maybe Bool
noSuite), ([(Text
"d", Bool
noDefault), (Text
"h", Bool
hasDefault), (Text
"center", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
torus [([(Text
"r1", Bool
noDefault), (Text
"r2", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
ellipsoid [([(Text
"a", Bool
noDefault), (Text
"b", Bool
hasDefault), (Text
"c", Bool
hasDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
polygon [([(Text
"points", Bool
noDefault)], Maybe Bool
noSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
union [([(Text
"r", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
intersect [([(Text
"r", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
difference [([(Text
"r", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
translate [([(Text
"x", Bool
noDefault), (Text
"y", Bool
noDefault), (Text
"z", Bool
noDefault)], Maybe Bool
requiredSuite), ([(Text
"v", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotate [([(Text
"a", Bool
noDefault), (Text
"v", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
scale [([(Text
"v", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
extrude [([(Text
"height", Bool
hasDefault), (Text
"center", Bool
hasDefault), (Text
"twist", Bool
hasDefault), (Text
"scale", Bool
hasDefault), (Text
"translate", Bool
hasDefault), (Text
"r", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotateExtrude [([(Text
"angle", Bool
hasDefault), (Text
"r", Bool
hasDefault), (Text
"translate", Bool
hasDefault), (Text
"rotate", Bool
hasDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
shell [([(Text
"w", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
pack [([(Text
"size", Bool
noDefault), (Text
"sep", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
unit [([(Text
"unit", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
mirror [([(Text
"x", Bool
noDefault), (Text
"y", Bool
noDefault), (Text
"z", Bool
noDefault)], Maybe Bool
requiredSuite), ([(Text
"v", Bool
noDefault)], Maybe Bool
requiredSuite)]
  , (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
multmatrix [([(Text
"m", Bool
noDefault)], Maybe Bool
requiredSuite)]
  ]
  where
    hasDefault :: Bool
hasDefault = Bool
True
    noDefault :: Bool
noDefault = Bool
False
    noSuite :: Maybe Bool
    noSuite :: Maybe Bool
noSuite = forall a. Maybe a
Nothing
    requiredSuite :: Maybe Bool
requiredSuite = forall a. a -> Maybe a
Just Bool
True
    onModIze :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Text, Bool)], Maybe Bool)] -> (Symbol, OVal)
onModIze (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
func [([(Text, Bool)], Maybe Bool)]
rawInstances = (Symbol
name, Symbol
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> [([(Symbol, Bool)], Maybe Bool)]
-> OVal
ONModule Symbol
name SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
implementation [([(Symbol, Bool)], Maybe Bool)]
instances)
      where
        (Symbol
name, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
implementation) = (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
func
        instances :: [([(Symbol, Bool)], Maybe Bool)]
instances = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Text, Bool)], Maybe Bool) -> ([(Symbol, Bool)], Maybe Bool)
fixup [([(Text, Bool)], Maybe Bool)]
rawInstances
        fixup :: ([(Text, Bool)], Maybe Bool) -> ([(Symbol, Bool)], Maybe Bool)
        fixup :: ([(Text, Bool)], Maybe Bool) -> ([(Symbol, Bool)], Maybe Bool)
fixup ([(Text, Bool)]
args, Maybe Bool
suiteInfo) = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Bool) -> (Symbol, Bool)
fixupArgs [(Text, Bool)]
args, Maybe Bool
suiteInfo)
          where
            fixupArgs :: (Text, Bool) -> (Symbol, Bool)
            fixupArgs :: (Text, Bool) -> (Symbol, Bool)
fixupArgs (Text
symbol, Bool
maybeDefault) = (Text -> Symbol
Symbol Text
symbol, Bool
maybeDefault)

-- | sphere is a module without a suite.
--   this means that the parser will look for this like
--   sphere(args...);
sphere :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
sphere :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
sphere = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"sphere" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"sphere(3);"
    Text -> ArgParser ()
example Text
"sphere(r=5);"
    -- arguments:
    -- The radius, r, which is a (real) number.
    -- Because we don't provide a default, this ends right
    -- here if it doesn't get a suitable argument!
    ℝ
r <-
      do
        ℝ
radius :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r" forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of the sphere"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
radius
      forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d" forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of the sphere"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ℝ
diameterforall a. Fractional a => a -> a -> a
/ℝ
2

    -- This module adds a 3D object, a sphere of radius r,
    -- using the sphere implementation in Prim
    -- (Graphics.Implicit.Primitives)
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj3
Prim.sphere ℝ
r

-- | FIXME: square1, square2 like cylinder has?
--   FIXME: translate for square2?
cube :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cube :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cube = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"cube" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    -- examples
    Text -> ArgParser ()
example Text
"cube(size = [2,3,4], center = true, r = 0.5);"
    Text -> ArgParser ()
example Text
"cube(4);"
    -- arguments (two forms)
    (V2 ℝ
x1 ℝ
x2, V2 ℝ
y1 ℝ
y2, V2 ℝ
z1 ℝ
z2) <-
        do
            Either ℝ ℝ2
x :: Either ℝ ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x or x-interval"
            Either ℝ ℝ2
y :: Either ℝ ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y or y-interval"
            Either ℝ ℝ2
z :: Either ℝ ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z or z-interval"
            Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center? (non-intervals)"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let
                toInterval' :: ℝ -> ℝ2
                toInterval' :: ℝ -> ℝ2
toInterval' = Bool -> ℝ -> ℝ2
toInterval Bool
center
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' forall a. a -> a
id Either ℝ ℝ2
x,
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' forall a. a -> a
id Either ℝ ℝ2
y,
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' forall a. a -> a
id Either ℝ ℝ2
z)
        forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ ℝ3
size   :: Either ℝ ℝ3  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
                forall a. ArgParser a -> Text -> ArgParser a
`doc`  Text
"cube size"
            Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center?"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let (V3 ℝ
x ℝ
y ℝ
z) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id Either ℝ ℝ3
size
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
x, Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
y, Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
z)
    -- arguments shared between forms
    ℝ
r      :: ℝ    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of rounding"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    -- Tests
    Text -> ArgParser ()
test Text
"cube(4);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    Text -> ArgParser ()
test Text
"cube(size=[2,3,4]);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    Text -> ArgParser ()
test Text
"cube([2,3,4]);" -- openscad syntax
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    -- Implementation
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r forall a b. (a -> b) -> a -> b
$ ℝ3 -> ℝ3 -> SymbolicObj3
Prim.rect3 (forall a. a -> a -> a -> V3 a
V3 ℝ
x1 ℝ
y1 ℝ
z1) (forall a. a -> a -> a -> V3 a
V3 ℝ
x2 ℝ
y2 ℝ
z2)

square :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
square :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
square = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"square" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    -- examples
    Text -> ArgParser ()
example Text
"square(x=[-2,2], y=[-1,5]);"
    Text -> ArgParser ()
example Text
"square(size = [3,4], center = true, r = 0.5);"
    Text -> ArgParser ()
example Text
"square(4);"
    -- arguments (two forms)
    (V2 ℝ
x1 ℝ
x2, V2 ℝ
y1 ℝ
y2) <-
        do
            Either ℝ ℝ2
x :: Either ℝ ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x or x-interval"
            Either ℝ ℝ2
y :: Either ℝ ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y or y-interval"
            Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center? (non-intervals)"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let
                toInterval' :: ℝ -> ℝ2
                toInterval' :: ℝ -> ℝ2
toInterval' = Bool -> ℝ -> ℝ2
toInterval Bool
center
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' forall a. a -> a
id Either ℝ ℝ2
x,
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' forall a. a -> a
id Either ℝ ℝ2
y)
        forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ ℝ2
size   :: Either ℝ ℝ2  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
                forall a. ArgParser a -> Text -> ArgParser a
`doc`  Text
"square size"
            Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center?"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let (V2 ℝ
x ℝ
y) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id Either ℝ ℝ2
size
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
x, Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
y)
    -- arguments shared between forms
    ℝ
r      :: ℝ    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of rounding"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    -- Tests
    Text -> ArgParser ()
test Text
"square(2);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"square(size=[2,3]);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    -- Implementation
    SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r forall a b. (a -> b) -> a -> b
$ ℝ2 -> ℝ2 -> SymbolicObj2
Prim.rect (forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y1) (forall a. a -> a -> V2 a
V2 ℝ
x2 ℝ
y2)

cylinder :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cylinder :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cylinder = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"cylinder" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"cylinder(r=10, h=30, center=true);"
    Text -> ArgParser ()
example Text
"cylinder(r1=4, r2=6, h=10);"
    Text -> ArgParser ()
example Text
"cylinder(r=5, h=10, $fn = 6);"
    -- arguments
    (ℝ
r,ℝ
r1,ℝ
r2) <-
      do
        ℝ
radius :: ℝ  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of cylinder"
        ℝ
radius1 :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r1"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"bottom radius; overrides r"
        ℝ
radius2 :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r2"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"top radius; overrides r"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ
radius, ℝ
radius1, ℝ
radius2)
      forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of cylinder"
        ℝ
diameter1 :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d1"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"bottom diameter; overrides d"
        ℝ
diameter2 :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d2"
                        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"top diameter; overrides d"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ
diameterforall a. Fractional a => a -> a -> a
/ℝ
2, ℝ
diameter1forall a. Fractional a => a -> a -> a
/ℝ
2, ℝ
diameter2forall a. Fractional a => a -> a -> a
/ℝ
2)

    Either ℝ ℝ2
h      :: Either ℝ ℝ2    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"h"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left ℝ
1
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"height of cylinder"
    ℕ
sides  :: ℕ    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"$fn"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` (-ℕ
1)
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"number of sides, for making prisms"
    Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"center cylinder with respect to z?"
    -- Tests
    Text -> ArgParser ()
test Text
"cylinder(r=10, h=30, center=true);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"cylinder(r=5, h=10, $fn = 6);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    let
        V2 ℝ
h1 ℝ
h2 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ℝ -> ℝ2
toInterval Bool
center) forall a. a -> a
id Either ℝ ℝ2
h
        dh :: ℝ
dh = ℝ
h2 forall a. Num a => a -> a -> a
- ℝ
h1
        shift :: SymbolicObj3 -> SymbolicObj3
        shift :: SymbolicObj3 -> SymbolicObj3
shift =
            if ℝ
h1 forall a. Eq a => a -> a -> Bool
== ℝ
0
            then forall a. a -> a
id
            else forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
h1)
    -- The result is a computation state modifier that adds a 3D object,
    -- based on the args.
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall a b. (a -> b) -> a -> b
$ if ℝ
r1 forall a. Eq a => a -> a -> Bool
== ℝ
1 Bool -> Bool -> Bool
&& ℝ
r2 forall a. Eq a => a -> a -> Bool
== ℝ
1
        then let
            obj2 :: SymbolicObj2
obj2 = if ℕ
sides forall a. Ord a => a -> a -> Bool
< ℕ
0 then ℝ -> SymbolicObj2
Prim.circle ℝ
r else [ℝ2] -> SymbolicObj2
Prim.polygon
                [forall a. a -> a -> V2 a
V2 (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos ℝ
θ) (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sin ℝ
θ) | ℝ
θ <- [ℝ
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
nforall a. Fractional a => a -> a -> a
/ℕ -> ℝ
fromℕtoℝ ℕ
sides | ℕ
n <- [ℕ
0 .. ℕ
sides forall a. Num a => a -> a -> a
- ℕ
1]]]
            obj3 :: SymbolicObj3
obj3 = SymbolicObj2 -> ℝ -> SymbolicObj3
Prim.extrude SymbolicObj2
obj2 ℝ
dh
        in SymbolicObj3 -> SymbolicObj3
shift SymbolicObj3
obj3
        else SymbolicObj3 -> SymbolicObj3
shift forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ -> SymbolicObj3
Prim.cylinder2 ℝ
r1 ℝ
r2 ℝ
dh

cone :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cone :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
cone = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"cone" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"cone(r=10, h=30, center=true);"
    -- arguments
    ℝ
r <- do
        forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of cylinder"
        forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            ℝ
d <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of cylinder"
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ℝ
dforall a. Fractional a => a -> a -> a
/ℝ
2

    Either ℝ ℝ2
h :: Either ℝ ℝ2    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"h"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left ℝ
1
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"height of cylinder"
    Bool
c :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"center cylinder with respect to z?"
    -- Tests
    Text -> ArgParser ()
test Text
"cone(r=10, h=30, center=true);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"cone(r=5, h=10, $fn = 6);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    let
        V2 ℝ
h1 ℝ
h2 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ℝ -> ℝ2
toInterval Bool
c) forall a. a -> a
id Either ℝ ℝ2
h
        dh :: ℝ
dh = ℝ
h2 forall a. Num a => a -> a -> a
- ℝ
h1
        shift :: SymbolicObj3 -> SymbolicObj3
        shift :: SymbolicObj3 -> SymbolicObj3
shift =
            if ℝ
h1 forall a. Eq a => a -> a -> Bool
== ℝ
0
            then forall a. a -> a
id
            else forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
h1)
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicObj3 -> SymbolicObj3
shift forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> SymbolicObj3
Prim.cone ℝ
r ℝ
dh

torus :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
torus :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
torus = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"torus" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"torus(r1=10, r2=5);"
    -- arguments
    (ℝ
r1, ℝ
r2) <- (,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r1" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"major radius of torus"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r2" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"minor radius of torus"
    -- Tests
    Text -> ArgParser ()
test Text
"torus(r1=10, r2=5);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    -- The result is a computation state modifier that adds a 3D object,
    -- based on the args.
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> SymbolicObj3
Prim.torus ℝ
r1 ℝ
r2

ellipsoid :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
ellipsoid :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
ellipsoid = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"ellipsoid" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"ellipsoid(a=1, b=2, c=3);"
    -- arguments
    (ℝ
a, ℝ
b, ℝ
c) <- (,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"a" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"a radius of ellipsoid"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"b" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"b radius of ellipsoid"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"c" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1 forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"c radius of ellipsoid"
    -- Tests
    Text -> ArgParser ()
test Text
"ellipsoid(a=1, b=2, c=3);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    -- The result is a computation state modifier that adds a 3D object,
    -- based on the args.
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ -> SymbolicObj3
Prim.ellipsoid ℝ
a ℝ
b ℝ
c

circle :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
circle :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
circle = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"circle" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"circle(r=10); // circle"
    Text -> ArgParser ()
example Text
"circle(r=5, $fn=6); //hexagon"
    -- Arguments
    ℝ
r <-
      do
        ℝ
radius :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                       forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of the circle"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
radius
      forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d"
                         forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of the circle"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ℝ
diameterforall a. Fractional a => a -> a -> a
/ℝ
2
    ℕ
sides :: ℕ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"$fn"
               forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"if defined, makes a regular polygon with n sides instead of a circle"
               forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` (-ℕ
1)
    Text -> ArgParser ()
test Text
"circle(r=10);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"circle(d=20);"
        forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 forall a b. (a -> b) -> a -> b
$ if ℕ
sides forall a. Ord a => a -> a -> Bool
< ℕ
3
        then ℝ -> SymbolicObj2
Prim.circle ℝ
r
        else [ℝ2] -> SymbolicObj2
Prim.polygon
            [forall a. a -> a -> V2 a
V2 (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos ℝ
θ) (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sin ℝ
θ) | ℝ
θ <- [ℝ
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
nforall a. Fractional a => a -> a -> a
/ℕ -> ℝ
fromℕtoℝ ℕ
sides | ℕ
n <- [ℕ
0 .. ℕ
sides forall a. Num a => a -> a -> a
- ℕ
1]]]

-- | FIXME: 3D Polygons?
--   FIXME: handle rectangles that are not grid alligned.
--   FIXME: allow for rounding of polygon corners, specification of vertex ordering.
--   FIXME: polygons have to have more than two points, or do not generate geometry, and generate an error.
polygon :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
polygon :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
polygon = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
"polygon" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"polygon ([(0,0), (0,10), (10,0)]);"
    [ℝ2]
points :: [ℝ2]  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"points"
                        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"vertices of the polygon"
{-    r      :: ℝ     <- argument "r"
                        `doc` "rounding of the polygon corners"
    paths  :: [ℕ]   <- argument "paths"
                        `doc` "order to go through vertices"
                        `defaultTo` []
    case paths of
        [] -> addObj2 $ Prim.polygon r points
        _ -> pure $ pure []
                        `defaultTo` 0
-}
    let
      addPolyOrSquare :: [ℝ2] -> SymbolicObj2
addPolyOrSquare [ℝ2]
pts
        | [ℝ2
p1,ℝ2
p2,ℝ2
p3,ℝ2
p4] <- [ℝ2]
pts =
          let
            d1d2 :: ℝ
d1d2 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p2
            d3d4 :: ℝ
d3d4 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p3 ℝ2
p4
            d1d3 :: ℝ
d1d3 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p3
            d2d4 :: ℝ
d2d4 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p2 ℝ2
p4
            d1d4 :: ℝ
d1d4 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p4
            d2d3 :: ℝ
d2d3 = forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p2 ℝ2
p3
            isGridAligned :: ℝ2 -> ℝ2 -> Bool
            isGridAligned :: ℝ2 -> ℝ2 -> Bool
isGridAligned (V2 ℝ
x1 ℝ
y1) (V2 ℝ
x2 ℝ
y2) = ℝ
x1 forall a. Eq a => a -> a -> Bool
== ℝ
x2 Bool -> Bool -> Bool
|| ℝ
y1 forall a. Eq a => a -> a -> Bool
== ℝ
y2
          -- Rectangles have no overlapping points,
          -- the distance on each side is equal to it's opposing side,
          -- and the distance between the pairs of opposing corners are equal.
          in if (ℝ2
p1 forall a. Eq a => a -> a -> Bool
/= ℝ2
p2 Bool -> Bool -> Bool
&& ℝ2
p2 forall a. Eq a => a -> a -> Bool
/= ℝ2
p3 Bool -> Bool -> Bool
&& ℝ2
p3 forall a. Eq a => a -> a -> Bool
/= ℝ2
p4 Bool -> Bool -> Bool
&& ℝ2
p4 forall a. Eq a => a -> a -> Bool
/= ℝ2
p1)
                 Bool -> Bool -> Bool
&& (ℝ
d1d2forall a. Eq a => a -> a -> Bool
==ℝ
d3d4 Bool -> Bool -> Bool
&& ℝ
d1d3forall a. Eq a => a -> a -> Bool
==ℝ
d2d4)
                 Bool -> Bool -> Bool
&& (ℝ
d1d4forall a. Eq a => a -> a -> Bool
==ℝ
d2d3) Bool -> Bool -> Bool
&& ℝ2 -> ℝ2 -> Bool
isGridAligned ℝ2
p1 ℝ2
p2
             then ℝ2 -> ℝ2 -> SymbolicObj2
Prim.rect ℝ2
p1 ℝ2
p3
             else [ℝ2] -> SymbolicObj2
Prim.polygon [ℝ2]
pts
        | Bool
otherwise = [ℝ2] -> SymbolicObj2
Prim.polygon [ℝ2]
points
    SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 forall a b. (a -> b) -> a -> b
$ [ℝ2] -> SymbolicObj2
addPolyOrSquare [ℝ2]
points

union :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
union :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
union = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"union" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
r :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the union interface"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if ℝ
r forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.unionR ℝ
r) (forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.unionR ℝ
r) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce  forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.union      forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.union     [OVal]
children

intersect :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
intersect :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
intersect = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"intersection" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
r :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the intersection interface"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if ℝ
r forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.intersectR ℝ
r) (forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.intersectR ℝ
r) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce  forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.intersect      forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.intersect     [OVal]
children

difference :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
difference :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
difference = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"difference" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OVal]
children) forall a b. (a -> b) -> a -> b
$ forall a. Text -> ArgParser a
APFail Text
"Call to 'difference' requires at least one child"
    ℝ
r :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the difference interface"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if ℝ
r forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry (forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
Prim.differenceR ℝ
r)) (forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry (forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
Prim.differenceR ℝ
r)) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry  forall obj (f :: * -> *) a. Object obj f a => obj -> [obj] -> obj
Prim.difference)     (forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry  forall obj (f :: * -> *) a. Object obj f a => obj -> [obj] -> obj
Prim.difference)     [OVal]
children
  where
    unsafeUncurry :: (a -> [a] -> c) -> [a] -> c
    unsafeUncurry :: forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry a -> [a] -> c
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [a] -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> (a, [a])
unsafeUncons

    unsafeUncons :: [a] -> (a, [a])
    unsafeUncons :: forall a. [a] -> (a, [a])
unsafeUncons (a
a : [a]
as) = (a
a, [a]
as)
    -- NOTE: This error is guarded against during the @null children@ check in the function body.
    unsafeUncons [a]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"difference requires at least one element; zero given"

translate :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
translate :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
translate = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"translate" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"translate ([2,3]) circle (4);"
    Text -> ArgParser ()
example Text
"translate ([5,6,7]) sphere(5);"
    (V3 ℝ
x ℝ
y ℝ
z) <-
        do
            ℝ
x :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x amount to translate";
            ℝ
y :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y amount to translate";
            ℝ
z :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z amount to translate"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0;
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z);
        forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ (Either ℝ2 ℝ3)
v :: Either ℝ (Either ℝ2 ℝ3) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"vector to translate by"
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either ℝ2 ℝ3)
v of
                Left          ℝ
x       -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
0 ℝ
0
                Right (Left  (V2 ℝ
x ℝ
y)  ) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0
                Right (Right (V3 ℝ
x ℝ
y ℝ
z)) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y)) (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z)) [OVal]
children

-- | FIXME: rotating a module that is not found pures no geometry, instead of an error.
--   FIXME: error reporting on fallthrough.
--   FIXME: rotate(y=90) would be nice.
rotate :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotate :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotate = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"rotate" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    OVal
a <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"a"
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"value to rotate by; angle or list of angles"
    ℝ3
v <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
        forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Vector to rotate around if a is a single angle"
    -- caseOType matches depending on whether size can be coerced into
    -- the right object. See Graphics.Implicit.ExtOpenScad.Util
    -- Entries must be joined with the operator <||>
    -- Final entry must be fall through.
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a c. a -> (a -> c) -> c
caseOType OVal
a forall a b. (a -> b) -> a -> b
$
               ( \ℝ
θ  ->
                          (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ -> SymbolicObj2 -> SymbolicObj2
Prim.rotate forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ
deg2rad ℝ
θ) (ℝ -> ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3V (ℝ -> ℝ
deg2rad ℝ
θ) ℝ3
v) [OVal]
children
        ) forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
<||> ( \(ℝ
yz,ℝ
zx,ℝ
xy) ->
            (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ -> SymbolicObj2 -> SymbolicObj2
Prim.rotate forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ
deg2rad ℝ
xy ) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3 (forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ
deg2rad ℝ
yz) (ℝ -> ℝ
deg2rad ℝ
zx) (ℝ -> ℝ
deg2rad ℝ
xy)) ) [OVal]
children
        ) forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
<||> ( \(ℝ
yz,ℝ
zx) ->
            (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap forall a. a -> a
id (ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3 (forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ
deg2rad ℝ
yz) (ℝ -> ℝ
deg2rad ℝ
zx) ℝ
0)) [OVal]
children
        ) forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
<||> forall a b. a -> b -> a
const []
      where
        deg2rad :: ℝ -> ℝ
        deg2rad :: ℝ -> ℝ
deg2rad ℝ
x = ℝ
x forall a. Fractional a => a -> a -> a
/ ℝ
180 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi

scale :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
scale :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
scale = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"scale" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"scale(2) square(5);"
    Text -> ArgParser ()
example Text
"scale([2,3]) square(5);"
    Text -> ArgParser ()
example Text
"scale([2,3,4]) cube(5);"
    Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ))
v <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"vector or scalar to scale by"
    let
        scaleObjs :: ℝ2 -> ℝ3 -> [OVal]
scaleObjs ℝ2
stretch2 ℝ3
stretch3 =
            (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale ℝ2
stretch2) (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale ℝ3
stretch3) [OVal]
children
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ))
v of
        Left   ℝ
x              -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
x) (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
x ℝ
x)
        Right (Left (ℝ
x,ℝ
y))    -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
1)
        Right (Right (ℝ
x,ℝ
y,ℝ
z)) -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z)

-- | FIXME: avoid the approximation in getBox3. better definition of function()?
extrude :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
extrude :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
extrude = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"linear_extrude" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"linear_extrude(10) square(5);"
    Either ℝ (ℝ -> ℝ -> ℝ)
height :: Either ℝ (ℝ -> ℝ -> ℝ) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"height" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left ℝ
1
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"height to extrude to..."
    Bool
center :: Bool <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"center? (the z component)"
    Either ℝ (ℝ -> ℝ)
twistArg  :: Either ℝ (ℝ  -> ℝ) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"twist"  forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left ℝ
0
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"twist as we extrude, either a total amount to twist or a function..."
    ExtrudeMScale
scaleArg  :: ExtrudeMScale <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"scale"  forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> ExtrudeMScale
C1 ℝ
1
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"scale according to this funciton as we extrude..."
    Either ℝ2 (ℝ -> ℝ2)
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"translate"  forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
0)
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"translate according to this funciton as we extrude..."
    ℝ
r      :: ℝ   <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"      forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"round the top/bottom."
    let
        heightn :: ℝ
heightn = case Either ℝ (ℝ -> ℝ -> ℝ)
height of
                Left  ℝ
h -> ℝ
h
                Right ℝ -> ℝ -> ℝ
f -> ℝ -> ℝ -> ℝ
f ℝ
0 ℝ
0

        height' :: Either ℝ (ℝ2 -> ℝ)
        height' :: Either ℝ (ℝ2 -> ℝ)
height' = case Either ℝ (ℝ -> ℝ -> ℝ)
height of
            Left ℝ
a  -> forall a b. a -> Either a b
Left ℝ
a
            Right ℝ -> ℝ -> ℝ
f -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \(V2 ℝ
a ℝ
b) -> ℝ -> ℝ -> ℝ
f ℝ
a ℝ
b
        shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3
        shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3
shiftAsNeeded =
            if Bool
center
            then forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 (-ℝ
heightnforall a. Fractional a => a -> a -> a
/ℝ
2))
            else forall a. a -> a
id
        isTwistID :: Bool
isTwistID = case Either ℝ (ℝ -> ℝ)
twistArg of
                      Left ℝ
constant -> ℝ
constant forall a. Eq a => a -> a -> Bool
== ℝ
0
                      Right ℝ -> ℝ
_       -> Bool
False
        isTransID :: Bool
isTransID = case Either ℝ2 (ℝ -> ℝ2)
translateArg of
                      Left ℝ2
constant -> ℝ2
constant forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
0
                      Right ℝ -> ℝ2
_       -> Bool
False
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap (
        \SymbolicObj2
obj -> case Either ℝ (ℝ -> ℝ -> ℝ)
height of
            Left ℝ
constHeight | Bool
isTwistID Bool -> Bool -> Bool
&& ExtrudeMScale -> Bool
isScaleID ExtrudeMScale
scaleArg Bool -> Bool -> Bool
&& Bool
isTransID ->
                SymbolicObj3 -> SymbolicObj3
shiftAsNeeded forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> ℝ -> SymbolicObj3
Prim.extrude SymbolicObj2
obj ℝ
constHeight
            Either ℝ (ℝ -> ℝ -> ℝ)
_ ->
                SymbolicObj3 -> SymbolicObj3
shiftAsNeeded forall a b. (a -> b) -> a -> b
$ forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r forall a b. (a -> b) -> a -> b
$ Either ℝ (ℝ -> ℝ)
-> ExtrudeMScale
-> Either ℝ2 (ℝ -> ℝ2)
-> SymbolicObj2
-> Either ℝ (ℝ2 -> ℝ)
-> SymbolicObj3
Prim.extrudeM Either ℝ (ℝ -> ℝ)
twistArg ExtrudeMScale
scaleArg Either ℝ2 (ℝ -> ℝ2)
translateArg SymbolicObj2
obj Either ℝ (ℝ2 -> ℝ)
height'
        ) [OVal]
children

rotateExtrude :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotateExtrude :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
rotateExtrude = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"rotate_extrude" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"rotate_extrude() translate(20) circle(10);"
    ℝ
totalRot     :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"angle" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
360
                    forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"angle to sweep in degrees"
    ℝ
r            :: ℝ    <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"   forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    Either ℝ2 (ℝ -> ℝ2)
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"translate" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left (forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0)
    Either ℝ (ℝ -> ℝ)
rotateArg    :: Either ℝ  (ℝ -> ℝ ) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"rotate" forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` forall a b. a -> Either a b
Left ℝ
0
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap ( forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
rotateExtrudeDegrees ℝ
totalRot Either ℝ2 (ℝ -> ℝ2)
translateArg Either ℝ (ℝ -> ℝ)
rotateArg
                            ) [OVal]
children

-- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians.
-- This is a shim for scad, which expects this function to operate in degrees.
rotateExtrudeDegrees
    :: ℝ                     -- Angle to sweep to (in degs)
    -> Either ℝ2 (ℝ -> ℝ2)   -- translate
    -> Either ℝ  (ℝ -> ℝ )   -- rotate
    -> SymbolicObj2          -- object to extrude
    -> SymbolicObj3
rotateExtrudeDegrees :: ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
rotateExtrudeDegrees ℝ
totalRot Either ℝ2 (ℝ -> ℝ2)
translateArg Either ℝ (ℝ -> ℝ)
rotateArg =
  ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
Prim.rotateExtrude
    (ℝ
totalRot forall a. Num a => a -> a -> a
* ℝ
k)
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ℝ
k)) Either ℝ2 (ℝ -> ℝ2)
translateArg)
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ℝ
k)) Either ℝ (ℝ -> ℝ)
rotateArg)
  where
    tau :: ℝ
    tau :: ℝ
tau = ℝ
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi
    k :: ℝ
k = ℝ
tau forall a. Fractional a => a -> a -> a
/ ℝ
360

shell :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
shell :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
shell = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"shell" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
w :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"w"
            forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"width of the shell..."
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.shell ℝ
w) (forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.shell ℝ
w) [OVal]
children

-- Not a permanent solution! Breaks if can't pack.
pack :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
pack :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
pack = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"pack" forall a b. (a -> b) -> a -> b
$ \SourcePosition
sourcePosition [OVal]
children -> do
    Text -> ArgParser ()
example Text
"pack ([45,45], sep=2) { circle(10); circle(10); circle(10); circle(10); }"
    -- arguments
    ℝ2
size :: ℝ2 <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"size of 2D box to pack objects within"
    ℝ
sep  :: ℝ  <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"sep"
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"mandetory space between objects"
    -- The actual work...
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        let ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
others) = [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs [OVal]
children
        in if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicObj3]
obj3s
            then case ℝ2 -> ℝ -> [SymbolicObj3] -> Maybe SymbolicObj3
Prim.pack3 ℝ2
size ℝ
sep [SymbolicObj3]
obj3s of
                Just SymbolicObj3
solution -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SymbolicObj3 -> OVal
OObj3 SymbolicObj3
solution forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicObj2 -> OVal
OObj2 [SymbolicObj2]
obj2s forall a. Semigroup a => a -> a -> a
<> [OVal]
others)
                Maybe SymbolicObj3
Nothing       -> do
                    SourcePosition -> Text -> StateC ()
errorC SourcePosition
sourcePosition Text
"Can't pack given objects in given box with the present algorithm."
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure [OVal]
children
            else case ℝ2 -> ℝ -> [SymbolicObj2] -> Maybe SymbolicObj2
Prim.pack2 ℝ2
size ℝ
sep [SymbolicObj2]
obj2s of
                Just SymbolicObj2
solution -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> OVal
OObj2 SymbolicObj2
solution forall a. a -> [a] -> [a]
: [OVal]
others
                Maybe SymbolicObj2
Nothing       -> do
                    SourcePosition -> Text -> StateC ()
errorC SourcePosition
sourcePosition Text
"Can't pack given objects in given box with the present algorithm."
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure [OVal]
children

unit :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
unit :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
unit = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"unit" forall a b. (a -> b) -> a -> b
$ \SourcePosition
sourcePosition [OVal]
children -> do
    Text -> ArgParser ()
example Text
"unit(\"inch\") {..}"
    -- arguments
    Text
name :: Text <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"unit"
        forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"the unit you wish to work in"
    let
        mmRatio :: Text -> Maybe ℝ
        mmRatio :: Text -> Maybe ℝ
mmRatio Text
"inch" = forall a. a -> Maybe a
Just ℝ
25.4
        mmRatio Text
"in"   = Text -> Maybe ℝ
mmRatio Text
"inch"
        mmRatio Text
"foot" = forall a. a -> Maybe a
Just ℝ
304.8
        mmRatio Text
"ft"   = Text -> Maybe ℝ
mmRatio Text
"foot"
        mmRatio Text
"yard" = forall a. a -> Maybe a
Just ℝ
914.4
        mmRatio Text
"yd"   = Text -> Maybe ℝ
mmRatio Text
"yard"
        mmRatio Text
"mm"   = forall a. a -> Maybe a
Just ℝ
1
        mmRatio Text
"cm"   = forall a. a -> Maybe a
Just ℝ
10
        mmRatio Text
"dm"   = forall a. a -> Maybe a
Just ℝ
100
        mmRatio Text
"m"    = forall a. a -> Maybe a
Just ℝ
1000
        mmRatio Text
"km"   = forall a. a -> Maybe a
Just ℝ
1000000
        mmRatio Text
"µm"   = forall a. a -> Maybe a
Just ℝ
0.001
        mmRatio Text
"um"   = Text -> Maybe ℝ
mmRatio Text
"µm"
        mmRatio Text
"nm"   = forall a. a -> Maybe a
Just ℝ
0.0000001
        mmRatio Text
_      = forall a. Maybe a
Nothing
    -- The actual work...
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Text -> Maybe ℝ
mmRatio Text
name of
        Maybe ℝ
Nothing -> do
            SourcePosition -> Text -> StateC ()
errorC SourcePosition
sourcePosition forall a b. (a -> b) -> a -> b
$ Text
"unrecognized unit " forall a. Semigroup a => a -> a -> a
<> Text
name
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [OVal]
children
        Just ℝ
r  ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
r)) (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
r)) [OVal]
children

mirror :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
mirror :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
mirror = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"mirror" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"mirror ([1,0,0]) cube(3);"
    Text -> ArgParser ()
example Text
"mirror (v = [1,1,1]) cube(5);"
    (V3 ℝ
x ℝ
y ℝ
z) <-
        do
            ℝ
x :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x component of a mirror plane tangent vector";
            ℝ
y :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y component of a mirror plane tangent vector";
            ℝ
z :: ℝ <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z component of a mirror plane tangent vector"
                forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0;
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z);
        forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ (Either ℝ2 ℝ3)
v :: Either ℝ (Either ℝ2 ℝ3) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"mirror plane tangent vector"
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either ℝ2 ℝ3)
v of
                Left          ℝ
x       -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
0 ℝ
0
                Right (Left  (V2 ℝ
x ℝ
y)  ) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0
                Right (Right (V3 ℝ
x ℝ
y ℝ
z)) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.mirror (forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y)) (forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.mirror (forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z)) [OVal]
children

multmatrix :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
multmatrix :: (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
multmatrix = Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
"multmatrix" forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"multmatrix (m=[[1,0,0,0],[0,1,0,0],[0,0,1,0]]) cube(3);"
    Text -> ArgParser ()
example Text
"multmatrix (m=[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]) cube(3);"
    M44 ℝ
m <-
        do
            Either (M34 ℝ) (M44 ℝ)
m :: Either (M34 ℝ) (M44 ℝ) <- forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"m"
                forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"3x4 or 4x4 matrix representing affine transformation";
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either (M34 ℝ) (M44 ℝ)
m of
              Left (V3 V4 ℝ
a V4 ℝ
b V4 ℝ
c) -> forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
a V4 ℝ
b V4 ℝ
c (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
1)
              Right M44 ℝ
m44 -> M44 ℝ
m44
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        -- m44 -> m33
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (M33 ℝ -> SymbolicObj2 -> SymbolicObj2
Prim.transform (M44 ℝ
m forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) (v :: * -> *) a.
(Representable t, R3 t, R3 v) =>
Lens' (t (v a)) (M33 a)
Linear._m33)) (M44 ℝ -> SymbolicObj3 -> SymbolicObj3
Prim.transform3 M44 ℝ
m) [OVal]
children

---------------

(<|>) :: ArgParser a -> ArgParser a -> ArgParser a
<|> :: forall a. ArgParser a -> ArgParser a -> ArgParser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

moduleWithSuite :: Text -> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite :: Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithSuite Text
name SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
modArgMapper = (Text -> Symbol
Symbol Text
name, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
modArgMapper)

moduleWithoutSuite :: Text -> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite :: Text
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
moduleWithoutSuite Text
name SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
modArgMapper = (Text -> Symbol
Symbol Text
name, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])
modArgMapper)

addObj2 :: SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 :: SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 SymbolicObj2
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure [SymbolicObj2 -> OVal
OObj2 SymbolicObj2
x]

addObj3 :: SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 :: SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 SymbolicObj3
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure [SymbolicObj3 -> OVal
OObj3 SymbolicObj3
x]

objMap :: (SymbolicObj2 -> SymbolicObj2) -> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap :: (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj3 -> SymbolicObj3
obj3mod (OVal
x:[OVal]
xs) = case OVal
x of
    OObj2 SymbolicObj2
obj2 -> SymbolicObj2 -> OVal
OObj2 (SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj2
obj2) forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj3 -> SymbolicObj3
obj3mod [OVal]
xs
    OObj3 SymbolicObj3
obj3 -> SymbolicObj3 -> OVal
OObj3 (SymbolicObj3 -> SymbolicObj3
obj3mod SymbolicObj3
obj3) forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj3 -> SymbolicObj3
obj3mod [OVal]
xs
    OVal
a          -> OVal
a                    forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj3 -> SymbolicObj3
obj3mod [OVal]
xs
objMap SymbolicObj2 -> SymbolicObj2
_ SymbolicObj3 -> SymbolicObj3
_ [] = []

objReduce :: ([SymbolicObj2] -> SymbolicObj2) -> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce :: ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce [SymbolicObj2] -> SymbolicObj2
obj2reduce [SymbolicObj3] -> SymbolicObj3
obj3reduce [OVal]
l = case [OVal] -> ([SymbolicObj2], [SymbolicObj3], [OVal])
divideObjs [OVal]
l of
    (   [],    [], [OVal]
others) ->                                                       [OVal]
others
    (   [], [SymbolicObj3]
obj3s, [OVal]
others) ->                            SymbolicObj3 -> OVal
OObj3 ([SymbolicObj3] -> SymbolicObj3
obj3reduce [SymbolicObj3]
obj3s) forall a. a -> [a] -> [a]
: [OVal]
others
    ([SymbolicObj2]
obj2s,    [], [OVal]
others) -> SymbolicObj2 -> OVal
OObj2 ([SymbolicObj2] -> SymbolicObj2
obj2reduce [SymbolicObj2]
obj2s)                            forall a. a -> [a] -> [a]
: [OVal]
others
    ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
others) -> SymbolicObj2 -> OVal
OObj2 ([SymbolicObj2] -> SymbolicObj2
obj2reduce [SymbolicObj2]
obj2s) forall a. a -> [a] -> [a]
: SymbolicObj3 -> OVal
OObj3 ([SymbolicObj3] -> SymbolicObj3
obj3reduce [SymbolicObj3]
obj3s) forall a. a -> [a] -> [a]
: [OVal]
others

obj2UpMap :: (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap :: (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap SymbolicObj2 -> SymbolicObj3
obj2upmod (OVal
x:[OVal]
xs) = case OVal
x of
    OObj2 SymbolicObj2
obj2 -> SymbolicObj3 -> OVal
OObj3 (SymbolicObj2 -> SymbolicObj3
obj2upmod SymbolicObj2
obj2) forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap SymbolicObj2 -> SymbolicObj3
obj2upmod [OVal]
xs
    OVal
a          -> OVal
a                      forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap SymbolicObj2 -> SymbolicObj3
obj2upmod [OVal]
xs
obj2UpMap SymbolicObj2 -> SymbolicObj3
_ [] = []

toInterval :: Bool -> ℝ -> ℝ2
toInterval :: Bool -> ℝ -> ℝ2
toInterval Bool
center ℝ
h =
    if Bool
center
    then forall a. a -> a -> V2 a
V2 (-ℝ
hforall a. Fractional a => a -> a -> a
/ℝ
2) (ℝ
hforall a. Fractional a => a -> a -> a
/ℝ
2)
    else forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
h