diff --git a/CHANGELOG.md b/CHANGELOG.md index 265723cc..52e97a44 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Version [next](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.4.0.0...master) (202Y-MM-DD) +* ExtOpenScad interface changes + * Added `rands` and `lookup` support [#433](https://github.com/Haskell-Things/ImplicitCAD/pull/433) + +* Other changes + * Migrating StateC and StateE to a ReaderT/WriterT/StateT transformer stack, rather than being just StateT. [#432](https://github.com/Haskell-Things/ImplicitCAD/pull/432) + # Version [0.4.0.0](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.3.0.0...v0.4.0.0) (2022-06-06) * Changelog started. Previous release was `0.3.0.1`. @@ -46,4 +52,3 @@ * Rotate now internally uses quaternions [#314](https://github.com/Haskell-Things/ImplicitCAD/pull/314) * Fixes to triangle generation [#355](https://github.com/Haskell-Things/ImplicitCAD/pull/355) and [#375](https://github.com/Haskell-Things/ImplicitCAD/pull/375) * ExtOpenSCAD vector addition [#408](https://github.com/Haskell-Things/ImplicitCAD/pull/408) - * Migrating StateC and StateE to a ReaderT/WriterT/StateT transformer stack [#432](https://github.com/Haskell-Things/ImplicitCAD/pull/432) \ No newline at end of file diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs index b9c87806..5db1e09e 100644 --- a/Graphics/Implicit/ExtOpenScad/Default.hs +++ b/Graphics/Implicit/ExtOpenScad/Default.hs @@ -8,15 +8,16 @@ -- Allow the use of \case {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} 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) +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) import Graphics.Implicit.Definitions (ℝ, ℕ) -import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, OVargsModule), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts)) +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.Util.OVal (toOObj, oTypeStr) @@ -28,13 +29,17 @@ import Data.Int (Int64) import Data.Map (Map, fromList, insert) -import Data.List (genericIndex, genericLength) +import Data.List (genericIndex, genericLength, find) -import Data.Foldable (for_) +import Data.Foldable (for_, foldr) import qualified Data.Text.Lazy as TL (index) import Data.Text.Lazy (Text, intercalate, unpack, pack, length, singleton) +import Control.Monad (replicateM) +import System.Random (randomRIO) +import Data.Maybe (maybe) +import Data.Tuple (snd) defaultObjects :: Bool -> VarLookup defaultObjects withCSG = VarLookup $ fromList $ @@ -46,9 +51,6 @@ defaultObjects withCSG = VarLookup $ fromList $ <> (if withCSG then primitiveModules else []) <> varArgModules --- FIXME: Missing standard ones(which standard?): --- rand, lookup, - defaultConstants :: [(Symbol, OVal)] defaultConstants = (\(a,b) -> (a, toOObj (b :: ℝ))) <$> [(Symbol "pi", pi), @@ -180,11 +182,61 @@ defaultPolymorphicFunctions = (Symbol "list_gen", toOObj list_gen), (Symbol "<>", concatenate), (Symbol "len", toOObj olength), - (Symbol "str", toOObj (pack.show :: OVal -> Text)) + (Symbol "str", toOObj (pack.show :: OVal -> Text)), + (Symbol "rands", toOObj rands), + (Symbol "lookup", toOObj lookup) ] where -- Some key functions are written as OVals in optimizations attempts + -- Lookup a value from the given table, or linearly interpolate a value from + -- the nearest entries. Lookups for keys that fall outside the bounds of the + -- table will be given the value of the nearest table entry. + -- TODO, a binary tree would be faster for large tables, but I'm not bothering + -- until we have a good reason to do so, i.e. we see a need for it. + lookup :: ℝ -> [(ℝ, ℝ)] -> OVal + lookup key table = + let + -- Find the next lower value, and the next upper value from key + search op op' = foldr + (\t@(k, _) -> maybe + ( if k `op` key + then pure t + else Nothing + ) + $ \t'@(k', _) -> pure $ + if k `op'` k' && k `op` key + then t + else t' + ) + Nothing + table + lower = search (<) (>) + upper = search (>) (<) + -- Interpolate linearly + -- Take the extremes if the key is out of bounds. + -- Undefined for empty tables, as the docs don't say what it should be. + -- https://en.wikibooks.org/wiki/OpenSCAD_User_Manual/Mathematical_Functions#lookup + interpolated = case (lower, upper) of + (Just (lk, lv), Just (uk, uv)) -> + -- calculate the linear slope of the graph + let scale = (uv - lv) / (uk - lk) + -- Use the lower value as the base, and add on the + -- required amount of scaling + in ONum $ lv + ((key - lk) * scale) + (Nothing, Just (_, uv)) -> ONum uv + (Just (_, lv), Nothing) -> ONum lv + (Nothing, Nothing) -> OUndefined + in maybe + interpolated + (ONum . snd) + $ find (\(k, _) -> k == key) table + + rands :: ℝ -> ℝ -> ℝ -> IO OVal + rands minR maxR count = do + l <- replicateM (round count) $ randomRIO (minR, maxR) + pure . OList $ ONum <$> l + prod = OFunc $ \case (OList (y:ys)) -> foldl mult y ys (OList []) -> ONum 1 @@ -259,6 +311,9 @@ defaultPolymorphicFunctions = n :: Int64 n = floor ind in if n < length s then OString (singleton (TL.index s n)) else OError "List accessed out of bounds" + -- For IO actions, get the OVal inside the IO and try to index that, rewrapping the results. + index (OIO o) ind = OIO $ flip index ind <$> o + index a b = errorAsAppropriate "index" a b osplice (OList list) (ONum a) ( ONum b ) = diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index 14c618a8..e4a158ac 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -21,7 +21,7 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch Expr(LitE, Var, ListE, LamE, (:$)), StatementI(StatementI), Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)), - OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3), + OVal(OIO, ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3), TestInvariant(EulerCharacteristic), SourcePosition(SourcePosition), StateC, @@ -195,6 +195,7 @@ data OVal = OUndefined | OList [OVal] | OString Text | OFunc (OVal -> OVal) + | OIO (IO OVal) -- Name, arguments, argument parsers. | OUModule Symbol (Maybe [(Symbol, Bool)]) (VarLookup -> ArgParser (StateC [OVal])) -- Name, implementation, arguments, whether the module accepts/requires a suite. @@ -218,6 +219,7 @@ instance Show OVal where show (OList l) = show l show (OString s) = show s show (OFunc _) = "" + show (OIO _) = "" show (OUModule (Symbol name) arguments _) = "module " <> unpack name <> " (" <> unpack (intercalate ", " (showArg <$> fromMaybe [] arguments)) <> ") {}" where showArg :: (Symbol, Bool) -> Text diff --git a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs index ba3927c8..b1f08ab1 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs @@ -12,14 +12,16 @@ -- Allow us to use string literals for Text {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE FlexibleInstances #-} module Graphics.Implicit.ExtOpenScad.Util.OVal(OTypeMirror, (<||>), fromOObj, toOObj, divideObjs, caseOType, oTypeStr, getErrors) where -import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return) +import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return, IO) import Graphics.Implicit.Definitions(V2, ℝ, ℝ2, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1, C2, Fn), fromℕtoℝ) -import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3)) +import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3, OIO)) import Control.Monad (msum) @@ -44,6 +46,12 @@ class OTypeMirror a where {-# INLINABLE fromOObjList #-} toOObj :: a -> OVal +instance OTypeMirror (IO OVal) where + fromOObj (OIO m) = Just m + fromOObj _ = Nothing + {-# INLINABLE fromOObj #-} + toOObj = OIO + instance OTypeMirror OVal where fromOObj = Just {-# INLINABLE fromOObj #-} @@ -75,6 +83,7 @@ instance (OTypeMirror a) => OTypeMirror [a] where instance OTypeMirror Text where fromOObj (OString str) = Just str fromOObj _ = Nothing + toOObj :: Text -> OVal toOObj a = OString a instance (OTypeMirror a) => OTypeMirror (Maybe a) where @@ -160,6 +169,7 @@ oTypeStr (ONum _ ) = "Number" oTypeStr (OList _ ) = "List" oTypeStr (OString _ ) = "String" oTypeStr (OFunc _ ) = "Function" +oTypeStr (OIO _ ) = "IO" oTypeStr (OUModule _ _ _ ) = "User Defined Module" oTypeStr (ONModule _ _ _ ) = "Built-in Module" oTypeStr (OVargsModule _ _ ) = "VargsModule" diff --git a/implicit.cabal b/implicit.cabal index 92d8f04d..69451d55 100644 --- a/implicit.cabal +++ b/implicit.cabal @@ -92,7 +92,8 @@ Library mtl, linear, show-combinators, - lens + lens, + random Exposed-modules: diff --git a/tests/ExecSpec/Expr.hs b/tests/ExecSpec/Expr.hs index 7a3aece6..3fca2757 100644 --- a/tests/ExecSpec/Expr.hs +++ b/tests/ExecSpec/Expr.hs @@ -6,10 +6,10 @@ module ExecSpec.Expr (exprExec) where -- Be explicit about what we import. -import Prelude (($)) +import Prelude (($), (==), length, Bool (False), (<=), (&&), (<>), show) -- Hspec, for writing specs. -import Test.Hspec (describe, Spec, it) +import Test.Hspec (describe, Spec, it, shouldSatisfy, expectationFailure) -- The type used for variables, in ImplicitCAD. import Graphics.Implicit.Definitions (ℝ) @@ -17,11 +17,14 @@ import Graphics.Implicit.Definitions (ℝ) -- Our utility library, for making these tests easier to read. import ExecSpec.Util ((-->), num, list, vect) +import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr) +import Graphics.Implicit.ExtOpenScad.Definitions (OVal(OIO, OList, ONum, OUndefined)) + -- Default all numbers in this file to being of the type ImplicitCAD uses for values. default (ℝ) exprExec :: Spec -exprExec = +exprExec = do describe "arithmetic" $ do it "performs simple addition" $ "1+1" --> num 2 @@ -41,3 +44,52 @@ exprExec = "2 + [1, 2]" --> vect [3, 4] it "performs number and list/vector multiplication" $ "2 * [3, 4, 5]" --> vect [6, 8, 10] + describe "rands" $ do + it "generates random numbers" $ do + case runExpr "rands(1,2,1)" False of + (OIO m, _) -> do + OList l <- m + shouldSatisfy l $ \l' -> length l' == 1 + _ -> expectationFailure "Not an OIO" + case runExpr "rands(1,2,10)" False of + (OIO m, _) -> do + OList l <- m + shouldSatisfy l $ \l' -> length l' == 10 + _ -> expectationFailure "Not an OIO" + case runExpr "rands(1,2,0)" False of + (OIO m, _) -> do + OList l <- m + shouldSatisfy l $ \l' -> length l' == 0 + _ -> expectationFailure "Not an OIO" + case runExpr "rands(1,1,1)" False of + (OIO m, _) -> do + OList l <- m + shouldSatisfy l $ \l' -> + length l' == 1 && + l' == [num 1] + _ -> expectationFailure "Not an OIO" + case runExpr "rands(1,2,1)[0]" False of + (OIO m, _) -> do + ONum n <- m + shouldSatisfy n $ \n' -> 1 <= n' && n' <= 2 + o -> expectationFailure $ "Not an OIO: " <> show o + case runExpr "rands(1,2,2)[0+1]" False of + (OIO m, _) -> do + ONum n <- m + shouldSatisfy n $ \n' -> 1 <= n' && n' <= 2 + o -> expectationFailure $ "Not an OIO: " <> show o + describe "lookup" $ do + it "Gets a value from a table" $ do + "lookup(1, [[0, 0], [1, 1], [2, 2]])" --> num 1 + it "Interpolates values from a table" $ do + "lookup(1, [[0, 0], [2, 2]])" --> num 1 + "lookup(7, [[0, 0], [5, 50], [10, 100], [11, 0]])" --> num 70 + "lookup(10.5, [[0, 0], [5, 50], [10, 100], [11, 0]])" --> num 50 + it "Gets an upper extreme from a table" $ do + "lookup(10, [[0, 0], [1, 1], [2, 2]])" --> num 2 + it "Gets an lower extreme from a table" $ do + "lookup(0, [[1, 1], [2, 2]])" --> num 1 + it "Gets an nothing from a table" $ do + "lookup(0, [])" --> OUndefined + it "Handles embedded statements" $ do + "lookup(0+1, [[0*2, 0], [1+1, 4/2]])" --> num 1 \ No newline at end of file diff --git a/tests/ExecSpec/Util.hs b/tests/ExecSpec/Util.hs index 12d7cd53..1118d168 100644 --- a/tests/ExecSpec/Util.hs +++ b/tests/ExecSpec/Util.hs @@ -10,16 +10,17 @@ module ExecSpec.Util , num , list , vect + , io ) where -- be explicit about where we get things from. -import Prelude (String, Bool(False), map, (.)) +import Prelude (String, Bool(False), map, (.), IO) -- The datatype of positions in our world. import Graphics.Implicit.Definitions (ℝ) -- Expressions, symbols, and values in the OpenScad language. -import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OList)) +import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OList, OIO)) import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr) @@ -41,3 +42,6 @@ list = OList vect :: [ℝ] -> OVal vect = list . map num + +io :: IO OVal -> OVal +io = OIO \ No newline at end of file