{- 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)

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 :: Text -> ArgParser desiredType
argument Text
a = Symbol -> ArgParser desiredType
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]))
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 = Maybe Bool
forall a. Maybe a
Nothing
    requiredSuite :: Maybe Bool
requiredSuite = Bool -> Maybe Bool
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 = (([(Text, Bool)], Maybe Bool) -> ([(Symbol, Bool)], Maybe Bool))
-> [([(Text, Bool)], Maybe Bool)]
-> [([(Symbol, Bool)], Maybe Bool)]
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) = (((Text, Bool) -> (Symbol, Bool))
-> [(Text, Bool)] -> [(Symbol, Bool)]
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r" ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of the sphere"
        ℝ -> ArgParser ℝ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
radius
      ArgParser ℝ -> ArgParser ℝ -> ArgParser ℝ
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d" ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of the sphere"
        ℝ -> ArgParser ℝ
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ -> ArgParser ℝ) -> ℝ -> ArgParser ℝ
forall a b. (a -> b) -> a -> b
$ ℝ
diameterℝ -> ℝ -> ℝ
forall 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 (SymbolicObj3 -> ArgParser (StateC [OVal]))
-> SymbolicObj3 -> ArgParser (StateC [OVal])
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x or x-interval"
            Either ℝ ℝ2
y :: Either ℝ ℝ2 <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y or y-interval"
            Either ℝ ℝ2
z :: Either ℝ ℝ2 <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z or z-interval"
            Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                ArgParser Bool -> Text -> ArgParser Bool
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center? (non-intervals)"
                ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let
                toInterval' :: ℝ -> ℝ2
                toInterval' :: ℝ -> ℝ2
toInterval' = Bool -> ℝ -> ℝ2
toInterval Bool
center
            (ℝ2, ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2, ℝ2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
x,
                    (ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
y,
                    (ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
z)
        ArgParser (ℝ2, ℝ2, ℝ2)
-> ArgParser (ℝ2, ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2, ℝ2)
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ ℝ3
size   :: Either ℝ ℝ3  <- Text -> ArgParser (Either ℝ ℝ3)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
                ArgParser (Either ℝ ℝ3) -> Text -> ArgParser (Either ℝ ℝ3)
forall a. ArgParser a -> Text -> ArgParser a
`doc`  Text
"cube size"
            Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                ArgParser Bool -> Text -> ArgParser Bool
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center?"
                ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let (V3 ℝ
x ℝ
y ℝ
z) = (ℝ -> ℝ3) -> (ℝ3 -> ℝ3) -> Either ℝ ℝ3 -> ℝ3
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ3 -> ℝ3
forall a. a -> a
id Either ℝ ℝ3
size
            (ℝ2, ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2, ℝ2)
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      :: ℝ    <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of rounding"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    -- Tests
    Text -> ArgParser ()
test Text
"cube(4);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    Text -> ArgParser ()
test Text
"cube(size=[2,3,4]);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    Text -> ArgParser ()
test Text
"cube([2,3,4]);" -- openscad syntax
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
2
    -- Implementation
    SymbolicObj3 -> ArgParser (StateC [OVal])
addObj3 (SymbolicObj3 -> ArgParser (StateC [OVal]))
-> SymbolicObj3 -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ3 -> ℝ3 -> SymbolicObj3
Prim.rect3 (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x1 ℝ
y1 ℝ
z1) (ℝ -> ℝ -> ℝ -> ℝ3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x or x-interval"
            Either ℝ ℝ2
y :: Either ℝ ℝ2 <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y or y-interval"
            Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                ArgParser Bool -> Text -> ArgParser Bool
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center? (non-intervals)"
                ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let
                toInterval' :: ℝ -> ℝ2
                toInterval' :: ℝ -> ℝ2
toInterval' = Bool -> ℝ -> ℝ2
toInterval Bool
center
            (ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
x,
                    (ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
toInterval' ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
y)
        ArgParser (ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2)
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ ℝ2
size   :: Either ℝ ℝ2  <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc`  Text
"square size"
            Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                ArgParser Bool -> Text -> ArgParser Bool
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"should center?"
                ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
            let (V2 ℝ
x ℝ
y) = (ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ℝ -> ℝ2
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ2 -> ℝ2
forall a. a -> a
id Either ℝ ℝ2
size
            (ℝ2, ℝ2) -> ArgParser (ℝ2, ℝ2)
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      :: ℝ    <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of rounding"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    -- Tests
    Text -> ArgParser ()
test Text
"square(2);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"square(size=[2,3]);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    -- Implementation
    SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 (SymbolicObj2 -> ArgParser (StateC [OVal]))
-> SymbolicObj2 -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r (SymbolicObj2 -> SymbolicObj2) -> SymbolicObj2 -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ℝ2 -> ℝ2 -> SymbolicObj2
Prim.rect (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y1) (ℝ -> ℝ -> ℝ2
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 :: ℝ  <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of cylinder"
        ℝ
radius1 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r1"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"bottom radius; overrides r"
        ℝ
radius2 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r2"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
1
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"top radius; overrides r"
        (ℝ, ℝ, ℝ) -> ArgParser (ℝ, ℝ, ℝ)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ
radius, ℝ
radius1, ℝ
radius2)
      ArgParser (ℝ, ℝ, ℝ) -> ArgParser (ℝ, ℝ, ℝ) -> ArgParser (ℝ, ℝ, ℝ)
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ  <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of cylinder"
        ℝ
diameter1 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d1"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"bottom diameter; overrides d"
        ℝ
diameter2 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d2"
                        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
2
                        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"top diameter; overrides d"
        (ℝ, ℝ, ℝ) -> ArgParser (ℝ, ℝ, ℝ)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ
diameterℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2, ℝ
diameter1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2, ℝ
diameter2ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2)

    Either ℝ ℝ2
h      :: Either ℝ ℝ2    <- Text -> ArgParser (Either ℝ ℝ2)
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"h"
                ArgParser (Either ℝ ℝ2) -> Either ℝ ℝ2 -> ArgParser (Either ℝ ℝ2)
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> Either ℝ ℝ2
forall a b. a -> Either a b
Left ℝ
1
                ArgParser (Either ℝ ℝ2) -> Text -> ArgParser (Either ℝ ℝ2)
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"height of cylinder"
    ℕ
sides  :: ℕ    <- Text -> ArgParser ℕ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"$fn"
                ArgParser ℕ -> ℕ -> ArgParser ℕ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` (-ℕ
1)
                ArgParser ℕ -> Text -> ArgParser ℕ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"number of sides, for making prisms"
    Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center"
                ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
                ArgParser Bool -> Text -> ArgParser Bool
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);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"cylinder(r=5, h=10, $fn = 6);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    let
        V2 ℝ
h1 ℝ
h2 = (ℝ -> ℝ2) -> (ℝ2 -> ℝ2) -> Either ℝ ℝ2 -> ℝ2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ℝ -> ℝ2
toInterval Bool
center) ℝ2 -> ℝ2
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 ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
0
            then SymbolicObj3 -> SymbolicObj3
forall a. a -> a
id
            else ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (ℝ -> ℝ -> ℝ -> ℝ3
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 (SymbolicObj3 -> ArgParser (StateC [OVal]))
-> SymbolicObj3 -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ if ℝ
r1 ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
1 Bool -> Bool -> Bool
&& ℝ
r2 ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
1
        then let
            obj2 :: SymbolicObj2
obj2 = if ℕ
sides ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
< ℕ
0 then ℝ -> SymbolicObj2
Prim.circle ℝ
r else [ℝ2] -> SymbolicObj2
Prim.polygon
                [ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 (ℝ
rℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
cos ℝ
θ) (ℝ
rℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
sin ℝ
θ) | ℝ
θ <- [ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
forall a. Floating a => a
piℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
nℝ -> ℝ -> ℝ
forall 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 (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ -> SymbolicObj3
Prim.cylinder2 ℝ
r1 ℝ
r2 ℝ
dh

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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
                       ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"radius of the circle"
        ℝ -> ArgParser ℝ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
radius
      ArgParser ℝ -> ArgParser ℝ -> ArgParser ℝ
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
        ℝ
diameter :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"d"
                         ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"diameter of the circle"
        ℝ -> ArgParser ℝ
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ -> ArgParser ℝ) -> ℝ -> ArgParser ℝ
forall a b. (a -> b) -> a -> b
$ ℝ
diameterℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
    ℕ
sides :: ℕ <- Text -> ArgParser ℕ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"$fn"
               ArgParser ℕ -> Text -> ArgParser ℕ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"if defined, makes a regular polygon with n sides instead of a circle"
               ArgParser ℕ -> ℕ -> ArgParser ℕ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` (-ℕ
1)
    Text -> ArgParser ()
test Text
"circle(r=10);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    Text -> ArgParser ()
test Text
"circle(d=20);"
        ArgParser () -> ℕ -> ArgParser ()
forall a. ArgParser a -> ℕ -> ArgParser a
`eulerCharacteristic` ℕ
0
    SymbolicObj2 -> ArgParser (StateC [OVal])
addObj2 (SymbolicObj2 -> ArgParser (StateC [OVal]))
-> SymbolicObj2 -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ if ℕ
sides ℕ -> ℕ -> Bool
forall a. Ord a => a -> a -> Bool
< ℕ
3
        then ℝ -> SymbolicObj2
Prim.circle ℝ
r
        else [ℝ2] -> SymbolicObj2
Prim.polygon
            [ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 (ℝ
rℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
cos ℝ
θ) (ℝ
rℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
sin ℝ
θ) | ℝ
θ <- [ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
forall a. Floating a => a
piℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℕ -> ℝ
fromℕtoℝ ℕ
nℝ -> ℝ -> ℝ
forall 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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
_ -> do
    Text -> ArgParser ()
example Text
"polygon ([(0,0), (0,10), (10,0)]);"
    [ℝ2]
points :: [ℝ2]  <- Text -> ArgParser [ℝ2]
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"points"
                        ArgParser [ℝ2] -> Text -> ArgParser [ℝ2]
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 = ℝ2 -> ℝ2 -> ℝ
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p2
            d3d4 :: ℝ
d3d4 = ℝ2 -> ℝ2 -> ℝ
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p3 ℝ2
p4
            d1d3 :: ℝ
d1d3 = ℝ2 -> ℝ2 -> ℝ
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p3
            d2d4 :: ℝ
d2d4 = ℝ2 -> ℝ2 -> ℝ
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p2 ℝ2
p4
            d1d4 :: ℝ
d1d4 = ℝ2 -> ℝ2 -> ℝ
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA ℝ2
p1 ℝ2
p4
            d2d3 :: ℝ
d2d3 = ℝ2 -> ℝ2 -> ℝ
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 ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ
x2 Bool -> Bool -> Bool
|| ℝ
y1 ℝ -> ℝ -> Bool
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 ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
/= ℝ2
p2 Bool -> Bool -> Bool
&& ℝ2
p2 ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
/= ℝ2
p3 Bool -> Bool -> Bool
&& ℝ2
p3 ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
/= ℝ2
p4 Bool -> Bool -> Bool
&& ℝ2
p4 ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
/= ℝ2
p1)
                 Bool -> Bool -> Bool
&& (ℝ
d1d2ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
==ℝ
d3d4 Bool -> Bool -> Bool
&& ℝ
d1d3ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
==ℝ
d2d4)
                 Bool -> Bool -> Bool
&& (ℝ
d1d4ℝ -> ℝ -> Bool
forall 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 (SymbolicObj2 -> ArgParser (StateC [OVal]))
-> SymbolicObj2 -> ArgParser (StateC [OVal])
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
r :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the union interface"
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ if ℝ
r ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (ℝ -> [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.unionR ℝ
r) (ℝ -> [SymbolicObj3] -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.unionR ℝ
r) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce  [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.union      [SymbolicObj3] -> SymbolicObj3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
r :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the intersection interface"
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ if ℝ
r ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce (ℝ -> [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.intersectR ℝ
r) (ℝ -> [SymbolicObj3] -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> [obj] -> obj
Prim.intersectR ℝ
r) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce  [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => [obj] -> obj
Prim.intersect      [SymbolicObj3] -> SymbolicObj3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Bool -> ArgParser () -> ArgParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([OVal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OVal]
children) (ArgParser () -> ArgParser ()) -> ArgParser () -> ArgParser ()
forall a b. (a -> b) -> a -> b
$ Text -> ArgParser ()
forall a. Text -> ArgParser a
APFail Text
"Call to 'difference' requires at least one child"
    ℝ
r :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"
        ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"Radius of rounding for the difference interface"
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ if ℝ
r ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
        then ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce ((SymbolicObj2 -> [SymbolicObj2] -> SymbolicObj2)
-> [SymbolicObj2] -> SymbolicObj2
forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry (ℝ -> SymbolicObj2 -> [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
Prim.differenceR ℝ
r)) ((SymbolicObj3 -> [SymbolicObj3] -> SymbolicObj3)
-> [SymbolicObj3] -> SymbolicObj3
forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry (ℝ -> SymbolicObj3 -> [SymbolicObj3] -> SymbolicObj3
forall obj (f :: * -> *) a.
Object obj f a =>
ℝ -> obj -> [obj] -> obj
Prim.differenceR ℝ
r)) [OVal]
children
        else ([SymbolicObj2] -> SymbolicObj2)
-> ([SymbolicObj3] -> SymbolicObj3) -> [OVal] -> [OVal]
objReduce ((SymbolicObj2 -> [SymbolicObj2] -> SymbolicObj2)
-> [SymbolicObj2] -> SymbolicObj2
forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry  SymbolicObj2 -> [SymbolicObj2] -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => obj -> [obj] -> obj
Prim.difference)     ((SymbolicObj3 -> [SymbolicObj3] -> SymbolicObj3)
-> [SymbolicObj3] -> SymbolicObj3
forall a c. (a -> [a] -> c) -> [a] -> c
unsafeUncurry  SymbolicObj3 -> [SymbolicObj3] -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => obj -> [obj] -> obj
Prim.difference)     [OVal]
children
  where
    unsafeUncurry :: (a -> [a] -> c) -> [a] -> c
    unsafeUncurry :: (a -> [a] -> c) -> [a] -> c
unsafeUncurry a -> [a] -> c
f = (a -> [a] -> c) -> (a, [a]) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [a] -> c
f ((a, [a]) -> c) -> ([a] -> (a, [a])) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> (a, [a])
forall a. [a] -> (a, [a])
unsafeUncons

    unsafeUncons :: [a] -> (a, [a])
    unsafeUncons :: [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]
_ = [Char] -> (a, [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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x amount to translate";
            ℝ
y :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y amount to translate";
            ℝ
z :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z amount to translate"
                ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0;
            ℝ3 -> ArgParser ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z);
        ArgParser ℝ3 -> ArgParser ℝ3 -> ArgParser ℝ3
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ (Either ℝ2 ℝ3)
v :: Either ℝ (Either ℝ2 ℝ3) <- Text -> ArgParser (Either ℝ (Either ℝ2 ℝ3))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
                ArgParser (Either ℝ (Either ℝ2 ℝ3))
-> Text -> ArgParser (Either ℝ (Either ℝ2 ℝ3))
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"vector to translate by"
            ℝ3 -> ArgParser ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ3 -> ArgParser ℝ3) -> ℝ3 -> ArgParser ℝ3
forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either ℝ2 ℝ3)
v of
                Left          ℝ
x       -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
0 ℝ
0
                Right (Left  (V2 ℝ
x ℝ
y)  ) -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0
                Right (Right (V3 ℝ
x ℝ
y ℝ
z)) -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y)) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (ℝ -> ℝ -> ℝ -> ℝ3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    OVal
a <- Text -> ArgParser OVal
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"a"
        ArgParser OVal -> Text -> ArgParser OVal
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"value to rotate by; angle or list of angles"
    ℝ3
v <- Text -> ArgParser ℝ3
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
        ArgParser ℝ3 -> ℝ3 -> ArgParser ℝ3
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1
        ArgParser ℝ3 -> Text -> ArgParser ℝ3
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.
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ OVal -> (OVal -> [OVal]) -> [OVal]
forall a c. a -> (a -> c) -> c
caseOType OVal
a ((OVal -> [OVal]) -> [OVal]) -> (OVal -> [OVal]) -> [OVal]
forall a b. (a -> b) -> a -> b
$
               ( \ℝ
θ  ->
                          (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ -> SymbolicObj2 -> SymbolicObj2
Prim.rotate (ℝ -> SymbolicObj2 -> SymbolicObj2)
-> ℝ -> SymbolicObj2 -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ
deg2rad ℝ
θ) (ℝ -> ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3V (ℝ -> ℝ
deg2rad ℝ
θ) ℝ3
v) [OVal]
children
        ) (ℝ -> [OVal]) -> (OVal -> [OVal]) -> OVal -> [OVal]
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 (ℝ -> SymbolicObj2 -> SymbolicObj2)
-> ℝ -> SymbolicObj2 -> SymbolicObj2
forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ
deg2rad ℝ
xy ) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3 (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ
deg2rad ℝ
yz) (ℝ -> ℝ
deg2rad ℝ
zx) (ℝ -> ℝ
deg2rad ℝ
xy)) ) [OVal]
children
        ) ((ℝ, ℝ, ℝ) -> [OVal]) -> (OVal -> [OVal]) -> OVal -> [OVal]
forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
<||> ( \(ℝ
yz,ℝ
zx) ->
            (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
forall a. a -> a
id (ℝ3 -> SymbolicObj3 -> SymbolicObj3
Prim.rotate3 (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ
deg2rad ℝ
yz) (ℝ -> ℝ
deg2rad ℝ
zx) ℝ
0)) [OVal]
children
        ) ((ℝ, ℝ) -> [OVal]) -> (OVal -> [OVal]) -> OVal -> [OVal]
forall desiredType out.
OTypeMirror desiredType =>
(desiredType -> out) -> (OVal -> out) -> OVal -> out
<||> [OVal] -> OVal -> [OVal]
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 <- Text -> ArgParser (Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ)))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
        ArgParser (Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ)))
-> Text -> ArgParser (Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ)))
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 (ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale ℝ2
stretch2) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale ℝ3
stretch3) [OVal]
children
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either (ℝ, ℝ) (ℝ, ℝ, ℝ))
v of
        Left   ℝ
x              -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
x) (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
x ℝ
x)
        Right (Left (ℝ
x,ℝ
y))    -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
1)
        Right (Right (ℝ
x,ℝ
y,ℝ
z)) -> ℝ2 -> ℝ3 -> [OVal]
scaleObjs (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y) (ℝ -> ℝ -> ℝ -> ℝ3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"linear_extrude(10) square(5);"
    Either ℝ (ℝ -> ℝ -> ℝ)
height :: Either ℝ (ℝ -> ℝ -> ℝ) <- Text -> ArgParser (Either ℝ (ℝ -> ℝ -> ℝ))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"height" ArgParser (Either ℝ (ℝ -> ℝ -> ℝ))
-> Either ℝ (ℝ -> ℝ -> ℝ) -> ArgParser (Either ℝ (ℝ -> ℝ -> ℝ))
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> Either ℝ (ℝ -> ℝ -> ℝ)
forall a b. a -> Either a b
Left ℝ
1
        ArgParser (Either ℝ (ℝ -> ℝ -> ℝ))
-> Text -> ArgParser (Either ℝ (ℝ -> ℝ -> ℝ))
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"height to extrude to..."
    Bool
center :: Bool <- Text -> ArgParser Bool
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"center" ArgParser Bool -> Bool -> ArgParser Bool
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` Bool
False
        ArgParser Bool -> Text -> ArgParser Bool
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"center? (the z component)"
    Either ℝ (ℝ -> ℝ)
twistArg  :: Either ℝ (ℝ  -> ℝ) <- Text -> ArgParser (Either ℝ (ℝ -> ℝ))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"twist"  ArgParser (Either ℝ (ℝ -> ℝ))
-> Either ℝ (ℝ -> ℝ) -> ArgParser (Either ℝ (ℝ -> ℝ))
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> Either ℝ (ℝ -> ℝ)
forall a b. a -> Either a b
Left ℝ
0
        ArgParser (Either ℝ (ℝ -> ℝ))
-> Text -> ArgParser (Either ℝ (ℝ -> ℝ))
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 <- Text -> ArgParser ExtrudeMScale
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"scale"  ArgParser ExtrudeMScale -> ExtrudeMScale -> ArgParser ExtrudeMScale
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> ExtrudeMScale
C1 ℝ
1
        ArgParser ExtrudeMScale -> Text -> ArgParser ExtrudeMScale
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"scale according to this funciton as we extrude..."
    Either ℝ2 (ℝ -> ℝ2)
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- Text -> ArgParser (Either ℝ2 (ℝ -> ℝ2))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"translate"  ArgParser (Either ℝ2 (ℝ -> ℝ2))
-> Either ℝ2 (ℝ -> ℝ2) -> ArgParser (Either ℝ2 (ℝ -> ℝ2))
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ2 -> Either ℝ2 (ℝ -> ℝ2)
forall a b. a -> Either a b
Left (ℝ -> ℝ2
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
0)
        ArgParser (Either ℝ2 (ℝ -> ℝ2))
-> Text -> ArgParser (Either ℝ2 (ℝ -> ℝ2))
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"translate according to this funciton as we extrude..."
    ℝ
r      :: ℝ   <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"      ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
        ArgParser ℝ -> Text -> ArgParser ℝ
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  -> ℝ -> Either ℝ (ℝ2 -> ℝ)
forall a b. a -> Either a b
Left ℝ
a
            Right ℝ -> ℝ -> ℝ
f -> (ℝ2 -> ℝ) -> Either ℝ (ℝ2 -> ℝ)
forall a b. b -> Either a b
Right ((ℝ2 -> ℝ) -> Either ℝ (ℝ2 -> ℝ))
-> (ℝ2 -> ℝ) -> Either ℝ (ℝ2 -> ℝ)
forall a b. (a -> b) -> a -> b
$ \(V2 ℝ
a ℝ
b) -> ℝ -> ℝ -> ℝ
f ℝ
a ℝ
b
        shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3
        shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3
shiftAsNeeded =
            if Bool
center
            then ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.translate (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 (-ℝ
heightnℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2))
            else SymbolicObj3 -> SymbolicObj3
forall a. a -> a
id
        isTwistID :: Bool
isTwistID = case Either ℝ (ℝ -> ℝ)
twistArg of
                      Left ℝ
constant -> ℝ
constant ℝ -> ℝ -> Bool
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 ℝ2 -> ℝ2 -> Bool
forall a. Eq a => a -> a -> Bool
== ℝ -> ℝ2
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
0
                      Right ℝ -> ℝ2
_       -> Bool
False
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
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 (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> ℝ -> SymbolicObj3
Prim.extrude SymbolicObj2
obj ℝ
constHeight
            Either ℝ (ℝ -> ℝ -> ℝ)
_ ->
                SymbolicObj3 -> SymbolicObj3
shiftAsNeeded (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r (SymbolicObj3 -> SymbolicObj3) -> SymbolicObj3 -> SymbolicObj3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    Text -> ArgParser ()
example Text
"rotate_extrude() translate(20) circle(10);"
    ℝ
totalRot     :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"angle" ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
360
                    ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"angle to sweep in degrees"
    ℝ
r            :: ℝ    <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"r"   ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0
    Either ℝ2 (ℝ -> ℝ2)
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- Text -> ArgParser (Either ℝ2 (ℝ -> ℝ2))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"translate" ArgParser (Either ℝ2 (ℝ -> ℝ2))
-> Either ℝ2 (ℝ -> ℝ2) -> ArgParser (Either ℝ2 (ℝ -> ℝ2))
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ2 -> Either ℝ2 (ℝ -> ℝ2)
forall a b. a -> Either a b
Left (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0)
    Either ℝ (ℝ -> ℝ)
rotateArg    :: Either ℝ  (ℝ -> ℝ ) <- Text -> ArgParser (Either ℝ (ℝ -> ℝ))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"rotate" ArgParser (Either ℝ (ℝ -> ℝ))
-> Either ℝ (ℝ -> ℝ) -> ArgParser (Either ℝ (ℝ -> ℝ))
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ -> Either ℝ (ℝ -> ℝ)
forall a b. a -> Either a b
Left ℝ
0
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap ( ℝ -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.withRounding ℝ
r
                            (SymbolicObj3 -> SymbolicObj3)
-> (SymbolicObj2 -> SymbolicObj3) -> SymbolicObj2 -> SymbolicObj3
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)
    (((ℝ -> ℝ2) -> ℝ -> ℝ2)
-> Either ℝ2 (ℝ -> ℝ2) -> Either ℝ2 (ℝ -> ℝ2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ℝ -> ℝ2) -> (ℝ -> ℝ) -> ℝ -> ℝ2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
k)) Either ℝ2 (ℝ -> ℝ2)
translateArg)
    (((ℝ -> ℝ) -> ℝ -> ℝ) -> Either ℝ (ℝ -> ℝ) -> Either ℝ (ℝ -> ℝ)
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
_ [OVal]
children -> do
    ℝ
w :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"w"
            ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"width of the shell..."
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => ℝ -> obj -> obj
Prim.shell ℝ
w) (ℝ -> SymbolicObj3 -> SymbolicObj3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 <- Text -> ArgParser ℝ2
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"size"
        ArgParser ℝ2 -> Text -> ArgParser ℝ2
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"size of 2D box to pack objects within"
    ℝ
sep  :: ℝ  <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"sep"
        ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"mandetory space between objects"
    -- The actual work...
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [SymbolicObj3] -> Bool
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 -> [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ SymbolicObj3 -> OVal
OObj3 SymbolicObj3
solution OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: ((SymbolicObj2 -> OVal) -> [SymbolicObj2] -> [OVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicObj2 -> OVal
OObj2 [SymbolicObj2]
obj2s [OVal] -> [OVal] -> [OVal]
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."
                    [OVal] -> StateC [OVal]
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 -> [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ SymbolicObj2 -> OVal
OObj2 SymbolicObj2
solution OVal -> [OVal] -> [OVal]
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."
                    [OVal] -> StateC [OVal]
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
forall a b. (a -> b) -> a -> b
$ \SourcePosition
sourcePosition [OVal]
children -> do
    Text -> ArgParser ()
example Text
"unit(\"inch\") {..}"
    -- arguments
    Text
name :: Text <- Text -> ArgParser Text
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"unit"
        ArgParser Text -> Text -> ArgParser Text
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" = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
25.4
        mmRatio Text
"in"   = Text -> Maybe ℝ
mmRatio Text
"inch"
        mmRatio Text
"foot" = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
304.8
        mmRatio Text
"ft"   = Text -> Maybe ℝ
mmRatio Text
"foot"
        mmRatio Text
"yard" = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
914.4
        mmRatio Text
"yd"   = Text -> Maybe ℝ
mmRatio Text
"yard"
        mmRatio Text
"mm"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
1
        mmRatio Text
"cm"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
10
        mmRatio Text
"dm"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
100
        mmRatio Text
"m"    = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
1000
        mmRatio Text
"km"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
1000000
        mmRatio Text
"µm"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
0.001
        mmRatio Text
"um"   = Text -> Maybe ℝ
mmRatio Text
"µm"
        mmRatio Text
"nm"   = ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just ℝ
0.0000001
        mmRatio Text
_      = Maybe ℝ
forall a. Maybe a
Nothing
    -- The actual work...
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ case Text -> Maybe ℝ
mmRatio Text
name of
        Maybe ℝ
Nothing -> do
            SourcePosition -> Text -> StateC ()
errorC SourcePosition
sourcePosition (Text -> StateC ()) -> Text -> StateC ()
forall a b. (a -> b) -> a -> b
$ Text
"unrecognized unit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
            [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [OVal]
children
        Just ℝ
r  ->
            [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$ (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale (ℝ -> ℝ2
forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
r)) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.scale (ℝ -> ℝ3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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 :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"x"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"x component of a mirror plane tangent vector";
            ℝ
y :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"y"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"y component of a mirror plane tangent vector";
            ℝ
z :: ℝ <- Text -> ArgParser ℝ
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"z"
                ArgParser ℝ -> Text -> ArgParser ℝ
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"z component of a mirror plane tangent vector"
                ArgParser ℝ -> ℝ -> ArgParser ℝ
forall a. OTypeMirror a => ArgParser a -> a -> ArgParser a
`defaultTo` ℝ
0;
            ℝ3 -> ArgParser ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z);
        ArgParser ℝ3 -> ArgParser ℝ3 -> ArgParser ℝ3
forall a. ArgParser a -> ArgParser a -> ArgParser a
<|> do
            Either ℝ (Either ℝ2 ℝ3)
v :: Either ℝ (Either ℝ2 ℝ3) <- Text -> ArgParser (Either ℝ (Either ℝ2 ℝ3))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"v"
                ArgParser (Either ℝ (Either ℝ2 ℝ3))
-> Text -> ArgParser (Either ℝ (Either ℝ2 ℝ3))
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"mirror plane tangent vector"
            ℝ3 -> ArgParser ℝ3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ℝ3 -> ArgParser ℝ3) -> ℝ3 -> ArgParser ℝ3
forall a b. (a -> b) -> a -> b
$ case Either ℝ (Either ℝ2 ℝ3)
v of
                Left          ℝ
x       -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
0 ℝ
0
                Right (Left  (V2 ℝ
x ℝ
y)  ) -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
0
                Right (Right (V3 ℝ
x ℝ
y ℝ
z)) -> ℝ -> ℝ -> ℝ -> ℝ3
forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (ℝ2 -> SymbolicObj2 -> SymbolicObj2
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.mirror (ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y)) (ℝ3 -> SymbolicObj3 -> SymbolicObj3
forall obj (f :: * -> *) a. Object obj f a => f a -> obj -> obj
Prim.mirror (ℝ -> ℝ -> ℝ -> ℝ3
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" ((SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
 -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])))
-> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
-> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal]))
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);"
    V4 (V4 ℝ)
m <-
        do
            Either (M34 ℝ) (V4 (V4 ℝ))
m :: Either (M34 ℝ) (M44 ℝ) <- Text -> ArgParser (Either (M34 ℝ) (V4 (V4 ℝ)))
forall desiredType.
OTypeMirror desiredType =>
Text -> ArgParser desiredType
argument Text
"m"
                ArgParser (Either (M34 ℝ) (V4 (V4 ℝ)))
-> Text -> ArgParser (Either (M34 ℝ) (V4 (V4 ℝ)))
forall a. ArgParser a -> Text -> ArgParser a
`doc` Text
"3x4 or 4x4 matrix representing affine transformation";
            V4 (V4 ℝ) -> ArgParser (V4 (V4 ℝ))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (V4 (V4 ℝ) -> ArgParser (V4 (V4 ℝ)))
-> V4 (V4 ℝ) -> ArgParser (V4 (V4 ℝ))
forall a b. (a -> b) -> a -> b
$ case Either (M34 ℝ) (V4 (V4 ℝ))
m of
              Left (V3 V4 ℝ
a V4 ℝ
b V4 ℝ
c) -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
a V4 ℝ
b V4 ℝ
c (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
1)
              Right V4 (V4 ℝ)
m44 -> V4 (V4 ℝ)
m44
    StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OVal] -> StateC [OVal]) -> [OVal] -> StateC [OVal]
forall a b. (a -> b) -> a -> b
$
        -- m44 -> m33
        (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap (M33 ℝ -> SymbolicObj2 -> SymbolicObj2
Prim.transform (V4 (V4 ℝ)
m V4 (V4 ℝ) -> Getting (M33 ℝ) (V4 (V4 ℝ)) (M33 ℝ) -> M33 ℝ
forall s a. s -> Getting a s a -> a
^. Getting (M33 ℝ) (V4 (V4 ℝ)) (M33 ℝ)
forall (t :: * -> *) (v :: * -> *) a.
(Representable t, R3 t, R3 v) =>
Lens' (t (v a)) (M33 a)
Linear._m33)) (V4 (V4 ℝ) -> SymbolicObj3 -> SymbolicObj3
Prim.transform3 V4 (V4 ℝ)
m) [OVal]
children

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

(<|>) :: ArgParser a -> ArgParser a -> ArgParser a
<|> :: ArgParser a -> ArgParser a -> ArgParser 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 = StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
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 = StateC [OVal] -> ArgParser (StateC [OVal])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateC [OVal] -> ArgParser (StateC [OVal]))
-> StateC [OVal] -> ArgParser (StateC [OVal])
forall a b. (a -> b) -> a -> b
$ [OVal] -> StateC [OVal]
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) OVal -> [OVal] -> [OVal]
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) OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj2)
-> (SymbolicObj3 -> SymbolicObj3) -> [OVal] -> [OVal]
objMap SymbolicObj2 -> SymbolicObj2
obj2mod SymbolicObj3 -> SymbolicObj3
obj3mod [OVal]
xs
    OVal
a          -> OVal
a                    OVal -> [OVal] -> [OVal]
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) OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: [OVal]
others
    ([SymbolicObj2]
obj2s,    [], [OVal]
others) -> SymbolicObj2 -> OVal
OObj2 ([SymbolicObj2] -> SymbolicObj2
obj2reduce [SymbolicObj2]
obj2s)                            OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: [OVal]
others
    ([SymbolicObj2]
obj2s, [SymbolicObj3]
obj3s, [OVal]
others) -> SymbolicObj2 -> OVal
OObj2 ([SymbolicObj2] -> SymbolicObj2
obj2reduce [SymbolicObj2]
obj2s) OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: SymbolicObj3 -> OVal
OObj3 ([SymbolicObj3] -> SymbolicObj3
obj3reduce [SymbolicObj3]
obj3s) OVal -> [OVal] -> [OVal]
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) OVal -> [OVal] -> [OVal]
forall a. a -> [a] -> [a]
: (SymbolicObj2 -> SymbolicObj3) -> [OVal] -> [OVal]
obj2UpMap SymbolicObj2 -> SymbolicObj3
obj2upmod [OVal]
xs
    OVal
a          -> OVal
a                      OVal -> [OVal] -> [OVal]
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 ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 (-ℝ
hℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2) (ℝ
hℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2)
    else ℝ -> ℝ -> ℝ2
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
h