diff --git a/CHANGELOG.md b/CHANGELOG.md index 2a564f4e..cff2345d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ * Added `polyhedron()` support [#497](https://github.com/Haskell-Things/ImplicitCAD/pull/497) * Added `import()` support [#505](https://github.com/Haskell-Things/ImplicitCAD/pull/505) * Improved syntax for module calling: now allows module calls in place of expressions []() + * Added `bbox()` and `render()` support for showing the bounding box of some geometry, and feeding said geometry from a variable or expression to the rendering engine. []() * Haskell interface changes * `extrude` arguments are now swapped, instead of `extrude obj height` we now have `extrude height obj` [#473](https://github.com/Haskell-Things/ImplicitCAD/issues/473) diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs index b1654b15..b96f046b 100644 --- a/Graphics/Implicit/ExtOpenScad/Default.hs +++ b/Graphics/Implicit/ExtOpenScad/Default.hs @@ -9,22 +9,27 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} +-- Allow us to use type signatures in patterns. +{-# LANGUAGE ScopedTypeVariables #-} + module Graphics.Implicit.ExtOpenScad.Default (defaultObjects) where -- be explicit about where we pull things in from. import Prelude (Bool(True, False), Maybe(Just, Nothing), ($), (<>), (<$>), fmap, pi, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, abs, signum, fromInteger, (.), floor, ceiling, round, exp, log, sqrt, max, min, atan2, (**), flip, (<), (>), (<=), (>=), (==), (/=), (&&), (||), not, show, foldl, (*), (/), mod, (+), zipWith, (-), otherwise, id, foldMap, fromIntegral, IO, pure, Int, isNaN, negate, RealFloat, Ord) import qualified Prelude as P (length) -import Graphics.Implicit.Definitions (ℝ, ℕ) +import Graphics.Implicit.Definitions (ℝ, ℕ, SymbolicObj2, SymbolicObj3) -import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, OVargsModule, OIO), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts)) +import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser, (<|>), VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, ONModule, OVargsModule, OIO), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts)) import Graphics.Implicit.ExtOpenScad.Util.OVal (toOObj, oTypeStr) -import Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules) +import Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules, argument) import Graphics.Implicit.ExtOpenScad.Util.StateC (scadOptions, modifyVarLookup, addMessage) +import Graphics.Implicit.ObjectUtil (getBox2, getBox3) + import Data.Int (Int64) import Data.Map (Map, fromList, insert) @@ -54,6 +59,7 @@ defaultObjects withCSG = VarLookup $ fromList $ <> defaultFunctionsSpecial <> defaultPolymorphicFunctions <> (if withCSG then primitiveModules else []) + <> objectFunctions <> varArgModules defaultConstants :: [(Symbol, OVal)] @@ -119,6 +125,37 @@ defaultFunctionsSpecial = ) ] +-- | functions which operate on 3D geometry. +objectFunctions :: [(Symbol, OVal)] +objectFunctions = modVal <$> + [ + ("bbox", bounding_box), + ("render", render) + ] + where + modVal (name,func) = (Symbol name, ONModule (Symbol name) func [[(Symbol "object", False)]]) + -- Give us the bounding box around a portion of symbolic 3D geometry. + bounding_box :: SourcePosition -> ArgParser (StateC [OVal]) + bounding_box _ = do + res <- do + object :: SymbolicObj3 <- argument "object" + pure $ toOObj $ getBox3 object + <|> do + object :: SymbolicObj2 <- argument "object" + pure $ toOObj $ getBox2 object + pure $ pure [res] + -- Pass the given object into the rendering pipeline. + render :: SourcePosition -> ArgParser (StateC [OVal]) + render _ = do + res <- do + object :: SymbolicObj3 <- argument "object" + pure $ toOObj object + <|> do + object :: SymbolicObj2 <- argument "object" + pure $ toOObj object + pure $ pure [res] + +-- | Functions which can accept a variable number of arguments. varArgModules :: [(Symbol, OVal)] varArgModules = [ diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index 413c2cca..fbda07ee 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -34,7 +34,8 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch varUnion, runImplicitCadM, CanCompState, - CanCompState' + CanCompState', + (<|>) ) where import Prelude(Eq, Show, Ord, Maybe, Bool(True, False), IO, FilePath, (==), show, ($), (<>), and, zipWith, Int, (<$>)) @@ -308,3 +309,7 @@ data TestInvariant = | ContoursAreClosed | MeshIsWaterTight deriving (Show) + +-- | for composing ArgParsers. +--(<|>) :: ArgParser a -> ArgParser a -> ArgParser a +--(<|>) = mplus diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Module.hs b/Graphics/Implicit/ExtOpenScad/Eval/Module.hs index 9a307de8..be54f6f6 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Module.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Module.hs @@ -17,6 +17,7 @@ module Graphics.Implicit.ExtOpenScad.Eval.Module ( import Prelude(Maybe(Just, Nothing), Bool(False), (.), ($), elem, error, filter, fmap, fst, init, last, length, not, notElem, null, show, snd, pure, zip, (<>), (&&), (==), (/=), String, (<$>)) import Graphics.Implicit.ExtOpenScad.Definitions ( + Expr(), OVal(OUModule, ONModule, ONModuleWithSuite, OVargsModule), SourcePosition, StateC, @@ -36,8 +37,6 @@ import Data.Foldable (for_) import Data.Traversable (for) -import Data.Text.Lazy as DTL (concat, intercalate) - import Data.Text.Lazy (pack, Text) -- | Ensure that argsExpr fits into args. diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index de866c01..56f53252 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -13,7 +13,7 @@ {-# LANGUAGE OverloadedStrings #-} -- Export one set containing all of the primitive modules. -module Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules) where +module Graphics.Implicit.ExtOpenScad.Primitives (primitiveModules, argument) where import Prelude(any, concat, elem, error, fromIntegral, foldr, head, length, mapM, (.), (+), Either(Left, Right), Bool(True, False), Maybe(Just, Nothing), ($), pure, show, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, (/=), (||), not, null, fmap, (<>), otherwise, (<*>), (<$>)) @@ -21,7 +21,7 @@ import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, Symbol import Graphics.Implicit.Export.Util (centroid) -import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser, OVal (OObj2, OObj3, ONModule, ONModuleWithSuite), ScadOpts(importsAllowed), SourcePosition, StateC, Symbol(Symbol)) +import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser, OVal (OObj2, OObj3, ONModule, ONModuleWithSuite), ScadOpts(importsAllowed), SourcePosition, StateC, Symbol(Symbol), (<|>)) import Graphics.Implicit.ExtOpenScad.Util.ArgParser (contoursAreClosed, doc, defaultTo, example, meshIsWaterTight, test, eulerCharacteristic) @@ -38,7 +38,7 @@ import Graphics.Implicit.TriUtil (Tri, Triangle) -- 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, polyhedron, extrude, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, slice, transform, rotate3V, rotate3, transform3, scale, extrudeM, rotateExtrude, shell, mirror, pack3, pack2, torus, ellipsoid, cone) -import Control.Monad (foldM, mplus) +import Control.Monad (foldM) import Data.ByteString (readFile) @@ -869,9 +869,6 @@ multmatrix = moduleWithSuite "multmatrix" $ \_ children -> do --------------- -(<|>) :: ArgParser a -> ArgParser a -> ArgParser a -(<|>) = mplus - moduleWithSuite :: Text -> (SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) -> (Symbol, SourcePosition -> [OVal] -> ArgParser (StateC [OVal])) moduleWithSuite name modArgMapper = (Symbol name, modArgMapper)