From 8716766ed4d33e6f4253f74aba6a6cabffa3fd6b Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Thu, 27 Jun 2019 23:09:31 +0100 Subject: [PATCH] add message passing back from the extopenscad executor to the application calling it, for errors, and non-model program output. --- Graphics/Implicit/ExtOpenScad.hs | 30 ++++-- Graphics/Implicit/ExtOpenScad/Default.hs | 3 +- Graphics/Implicit/ExtOpenScad/Definitions.hs | 24 +++++ .../Implicit/ExtOpenScad/Eval/Statement.hs | 6 +- Graphics/Implicit/ExtOpenScad/Util/StateC.hs | 39 ++++---- programs/extopenscad.hs | 95 +++++++++++-------- programs/implicitsnap.hs | 88 ++++++++--------- 7 files changed, 170 insertions(+), 115 deletions(-) diff --git a/Graphics/Implicit/ExtOpenScad.hs b/Graphics/Implicit/ExtOpenScad.hs index be14750..1d8a1a5 100644 --- a/Graphics/Implicit/ExtOpenScad.hs +++ b/Graphics/Implicit/ExtOpenScad.hs @@ -8,37 +8,47 @@ -- An executor, which parses openscad code, and executes it. module Graphics.Implicit.ExtOpenScad (runOpenscad) where -import Prelude(String, Either(Left, Right), IO, ($), fmap) +import Prelude(String, Either(Left, Right), IO, ($), fmap, return) import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3) -import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup) + +import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, Message(Message), MessageType(SyntaxError)) + import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram) + import Graphics.Implicit.ExtOpenScad.Parser.Util (sourcePosition) + import Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI) + import Graphics.Implicit.ExtOpenScad.Default (defaultObjects) + import Graphics.Implicit.ExtOpenScad.Util.StateC (CompState(CompState)) + import Graphics.Implicit.ExtOpenScad.Util.OVal (divideObjs) +import Text.Parsec.Error (errorPos, errorMessages, showErrorMessages) -import Text.Parsec.Error (ParseError) import Control.Monad (mapM_) + import Control.Monad.State (runStateT) + import System.Directory (getCurrentDirectory) -- | Small wrapper of our parser to handle parse errors, etc. -runOpenscad :: String -> Either ParseError (IO (VarLookup, [SymbolicObj2], [SymbolicObj3])) +runOpenscad :: String -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]) runOpenscad source = let initial = defaultObjects - rearrange :: (t, CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3]) - rearrange (_, (CompState (varlookup, ovals, _))) = (varlookup, obj2s, obj3s) where + rearrange :: (t, CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]) + rearrange (_, (CompState (varlookup, ovals, _, messages))) = (varlookup, obj2s, obj3s, messages) where (obj2s, obj3s, _ ) = divideObjs ovals + show' err = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err) + mesg e = Message SyntaxError (sourcePosition $ errorPos e) $ show' e in case parseProgram "" source of - Left e -> Left e - Right sts -> Right - $ fmap rearrange + Left e -> return (initial, [], [], [mesg e]) + Right sts -> fmap rearrange $ (\sts' -> do path <- getCurrentDirectory - runStateT sts' $ CompState (initial, [], path) + runStateT sts' $ CompState (initial, [], path, []) ) $ mapM_ runStatementI sts diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs index b6d29c1..4f60382 100644 --- a/Graphics/Implicit/ExtOpenScad/Default.hs +++ b/Graphics/Implicit/ExtOpenScad/Default.hs @@ -13,8 +13,9 @@ module Graphics.Implicit.ExtOpenScad.Default (defaultObjects) where import Prelude (String, Bool(True, False), Maybe(Just, Nothing), ($), (++), map, 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) import Graphics.Implicit.Definitions (ℝ, ℕ) -import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal(OList, ONum, OString, OUndefined, OError, OModule, OFunc), Symbol(Symbol), SourcePosition) +import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal(OList, ONum, OString, OUndefined, OError, OModule, OFunc), Symbol(Symbol), SourcePosition, MessageType(Info, Unimplemented)) import Graphics.Implicit.ExtOpenScad.Util.OVal (toOObj, oTypeStr) +import Graphics.Implicit.ExtOpenScad.Util.StateC (addMessage) import Graphics.Implicit.ExtOpenScad.Primitives (primitives) import Data.Map (fromList) import Data.List (genericIndex, genericLength) diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index 9a50858..e9a3c00 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -12,6 +12,8 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch VarLookup(VarLookup), TestInvariant(EulerCharacteristic), SourcePosition(SourcePosition), + Message(Message), + MessageType(..), lookupVarIn, collector) where @@ -153,6 +155,28 @@ instance Show SourcePosition where show (SourcePosition line col []) = "line " ++ show line ++ ", column " ++ show col show (SourcePosition line col filePath) = "line " ++ show line ++ ", column " ++ show col ++ ", file " ++ filePath +-- | the types of messages the execution engine can send back to the application. +data MessageType = Info + | Debug + | Trace + | Warning + | Error + | SyntaxError + | Advice + | Lint + | Compatibility + | Unimplemented + deriving (Show, Eq) + +-- | An individual message. +data Message = Message MessageType SourcePosition String + deriving (Eq) + +instance Show Message where + show (Message mtype pos text) = show mtype ++ " at " ++ show pos ++ ": " ++ text + + + -- | Apply a symbolic operator to a list of expressions, returning one big expression. -- Accepts a string for the operator, to simplify callers. collector :: String -> [Expr] -> Expr diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs index a9c0212..5528b3a 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs @@ -83,7 +83,7 @@ runStatementI (StatementI sourcePos (NewModule name argTemplate suite)) = do argTemplate' <- forM argTemplate $ \(name', defexpr) -> do defval <- mapMaybeM evalExpr defexpr return (name', defval) - (CompState (VarLookup varlookup, _, path)) <- get + (CompState (VarLookup varlookup, _, path, _)) <- get -- FIXME: \_? really? runStatementI . StatementI sourcePos $ (Name name :=) $ LitE $ OModule $ \_ -> do newNameVals <- forM argTemplate' $ \(name', maybeDef) -> do @@ -114,7 +114,7 @@ runStatementI (StatementI sourcePos (NewModule name argTemplate suite)) = do runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) = do maybeMod <- lookupVar (Symbol name) - (CompState (varlookup, _, path)) <- get + (CompState (varlookup, _, path, _)) <- get childVals <- fmap reverse . liftIO $ runSuiteCapture varlookup path suite argsVal <- forM argsExpr $ \(posName, expr) -> do val <- evalExpr expr @@ -154,7 +154,7 @@ runSuiteCapture :: VarLookup -> FilePath -> [StatementI] -> IO [OVal] runSuiteCapture varlookup path suite = do (res, _) <- runStateT (runSuite suite >> getVals) - (CompState (varlookup, [], path)) + (CompState (varlookup, [], path, [])) return res diff --git a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs index 2496510..7e7b159 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs @@ -9,11 +9,11 @@ {-# LANGUAGE KindSignatures, FlexibleContexts #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} -module Graphics.Implicit.ExtOpenScad.Util.StateC (getVarLookup, modifyVarLookup, lookupVar, pushVals, getVals, putVals, withPathShiftedBy, getPath, getRelPath, errorC, mapMaybeM, StateC, CompState(CompState)) where +module Graphics.Implicit.ExtOpenScad.Util.StateC (addMessage, getVarLookup, modifyVarLookup, lookupVar, pushVals, getVals, putVals, withPathShiftedBy, getPath, getRelPath, errorC, mapMaybeM, StateC, CompState(CompState)) where import Prelude(FilePath, IO, String, Maybe(Just, Nothing), Show, Monad, fmap, (.), ($), (++), return, putStrLn, show) -import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition) +import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition, Message(Message), MessageType(Error)) import Data.Map (lookup) import Control.Monad.State (StateT, get, put, modify, liftIO) @@ -21,16 +21,16 @@ import System.FilePath(()) import Control.Monad.IO.Class (MonadIO) import Data.Kind (Type) --- | This is the state of a computation. It contains a hash of variables, an array of OVals, and a path. -newtype CompState = CompState (VarLookup, [OVal], FilePath) +-- | This is the state of a computation. It contains a hash of variables, an array of OVals, a path, and messages. +newtype CompState = CompState (VarLookup, [OVal], FilePath, [Message]) type StateC = StateT CompState IO getVarLookup :: StateC VarLookup -getVarLookup = fmap (\(CompState (a,_,_)) -> a) get +getVarLookup = fmap (\(CompState (a,_,_,_)) -> a) get modifyVarLookup :: (VarLookup -> VarLookup) -> StateC () -modifyVarLookup = modify . (\f (CompState (a,b,c)) -> CompState (f a, b, c)) +modifyVarLookup = modify . (\f (CompState (a,b,c,d)) -> CompState (f a, b, c, d)) -- | Perform a variable lookup lookupVar :: Symbol -> StateC (Maybe OVal) @@ -39,31 +39,31 @@ lookupVar name = do return $ lookup name varlookup pushVals :: [OVal] -> StateC () -pushVals vals = modify (\(CompState (a,b,c)) -> CompState (a, vals ++ b, c)) +pushVals vals = modify (\(CompState (a,b,c,d)) -> CompState (a, vals ++ b, c, d)) getVals :: StateC [OVal] getVals = do - (CompState (_,b,_)) <- get + (CompState (_,b,_,_)) <- get return b putVals :: [OVal] -> StateC () putVals vals = do - (CompState (a,_,c)) <- get - put $ CompState (a,vals,c) + (CompState (a,_,c,d)) <- get + put $ CompState (a,vals,c,d) withPathShiftedBy :: FilePath -> StateC a -> StateC a withPathShiftedBy pathShift s = do - (CompState (a,b,path)) <- get - put $ CompState (a, b, path pathShift) + (CompState (a,b,path,d)) <- get + put $ CompState (a, b, path pathShift,d) x <- s - (CompState (a',b',_)) <- get - put $ CompState (a', b', path) + (CompState (a',b',_,d')) <- get + put $ CompState (a', b', path, d') return x -- | Return the path stored in the state. getPath :: StateC FilePath getPath = do - (CompState (_,_,c)) <- get + (CompState (_,_,c,_)) <- get return c getRelPath :: FilePath -> StateC FilePath @@ -71,9 +71,16 @@ getRelPath relPath = do path <- getPath return $ path relPath +addMesg :: Message -> StateC () +addMesg = modify . (\message (CompState (a, b, c, messages)) -> (CompState (a, b, c, messages ++ [message]))) + +addMessage :: MessageType -> SourcePosition -> String -> StateC () +addMessage mtype pos text = addMesg $ Message mtype pos text + errorC :: SourcePosition -> String -> StateC() -errorC sourcePos err = +errorC sourcePos err = do liftIO $ putStrLn $ "At " ++ show sourcePos ++ ": " ++ err + addMessage Error sourcePos err {-# INLINABLE errorC #-} mapMaybeM :: forall t (m :: Type -> Type) a. Monad m => (t -> m a) -> Maybe t -> m (Maybe a) diff --git a/programs/extopenscad.hs b/programs/extopenscad.hs index 5facd3e..e4133e0 100644 --- a/programs/extopenscad.hs +++ b/programs/extopenscad.hs @@ -11,7 +11,7 @@ -- Let's be explicit about what we're getting from where :) -import Prelude (Read(readsPrec), Maybe(Just, Nothing), Either(Left, Right), IO, FilePath, Show, Eq, String, (++), ($), (*), (/), (==), (>), (**), (-), readFile, minimum, drop, error, map, fst, min, sqrt, tail, take, length, putStrLn, show, print, (>>=), lookup) +import Prelude (Read(readsPrec), Maybe(Just, Nothing), IO, FilePath, Show, Eq, String, (++), ($), (*), (/), (==), (>), (**), (-), readFile, minimum, drop, error, map, fst, min, sqrt, tail, take, length, putStrLn, show, (>>=), lookup, return, unlines) -- Our Extended OpenScad interpreter, and functions to write out files in designated formats. import Graphics.Implicit (runOpenscad, writeSVG, writeDXF2, writeBinSTL, writeOBJ, writeSCAD2, writeSCAD3, writeGCodeHacklabLaser, writePNG2, writePNG3) @@ -23,7 +23,7 @@ import Graphics.Implicit.ObjectUtil (getBox2, getBox3) import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3, ℝ) -- Use default values when a Maybe is Nothing. -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybe) -- For making the format guesser case insensitive when looking at file extensions. import Data.Char (toLower) @@ -34,7 +34,7 @@ import Data.Tuple (swap) -- Functions and types for dealing with the types used by runOpenscad. -- The definition of the symbol type, so we can access variables, and see the requested resolution. -import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, OVal(ONum), lookupVarIn) +import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, OVal(ONum), lookupVarIn, Message) -- Operator to subtract two points. Used when defining the resolution of a 2d object. import Data.AffineSpace ((.-.)) @@ -49,6 +49,9 @@ import Options.Applicative (fullDesc, progDesc, header, auto, info, helper, help -- For handling input/output files. import System.FilePath (splitExtension) +-- For handling handles to output files. +import System.IO (Handle, hPutStr, stdout, openFile, IOMode(WriteMode)) + -- | The following is needed to ensure backwards/forwards compatibility -- | with old versions of Data.Monoid: infixr 6 <> @@ -61,6 +64,7 @@ data ExtOpenScadOpts = ExtOpenScadOpts , outputFormat :: Maybe OutputFormat , resolution :: Maybe ℝ , inputFile :: FilePath + , messageOutputFile :: Maybe FilePath } -- | A type serving to enumerate our output formats. @@ -98,6 +102,7 @@ guessOutputFormat fileName = (_,ext) = splitExtension fileName -- | The parser for our command line arguments. +-- FIXME: -q for quiet. extOpenScadOpts :: Parser ExtOpenScadOpts extOpenScadOpts = ExtOpenScadOpts <$> optional ( @@ -128,6 +133,14 @@ extOpenScadOpts = ExtOpenScadOpts ( metavar "FILE" <> help "Input extended OpenSCAD file" ) + <*> optional ( + strOption + ( short 'e' + <> long "echo-output" + <> metavar "FILE" + <> help "Output file name for echo statements" + ) + ) -- | Try to look up an output format from a supplied extension. readOutputFormat :: String -> Maybe OutputFormat @@ -147,12 +160,12 @@ instance Read OutputFormat where else tryParse xs -- | Find the resolution to raytrace at. -getRes :: (VarLookup, [SymbolicObj2], [SymbolicObj3]) -> ℝ +getRes :: (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]) -> ℝ -- | First, use a resolution specified by a variable in the input file. -getRes (lookupVarIn "$res" -> Just (ONum res), _, _) = res +getRes (lookupVarIn "$res" -> Just (ONum res), _, _, _) = res -- | Use a resolution chosen for 3D objects. -- FIXME: magic numbers. -getRes (vars, _, obj:_) = +getRes (vars, _, obj:_, _) = let ((x1,y1,z1),(x2,y2,z2)) = getBox3 obj (x,y,z) = (x2-x1, y2-y1, z2-z1) @@ -161,7 +174,7 @@ getRes (vars, _, obj:_) = _ -> min (minimum [x,y,z]/2) ((x*y*z)**(1/3) / 22) -- | Use a resolution chosen for 2D objects. -- FIXME: magic numbers. -getRes (vars, obj:_, _) = +getRes (vars, obj:_, _, _) = let (p1,p2) = getBox2 obj (x,y) = p2 .-. p1 @@ -194,6 +207,10 @@ export2 posFmt res output obj = Nothing -> writeSVG res output obj Just fmt -> putStrLn $ "Unrecognized 2D format: "<>show fmt +-- | Determine where to direct the text output of running the extopenscad program. +messageOutputHandle :: ExtOpenScadOpts -> IO Handle +messageOutputHandle args = maybe (return stdout) (`openFile` WriteMode) (messageOutputFile args) + -- | Interpret arguments, and render the object defined in the supplied input file. run :: ExtOpenScadOpts -> IO () run args = do @@ -206,38 +223,40 @@ run args = do _ | Just fmt <- outputFormat args -> Just fmt _ | Just file <- outputFile args -> Just $ guessOutputFormat file _ -> Nothing - putStrLn "Processing File." + openscadProgram = runOpenscad content - case runOpenscad content of - Left err -> print err - Right openscadProgram -> do - s@(_, obj2s, obj3s) <- openscadProgram - let res = fromMaybe (getRes s) (resolution args) - let basename = fst (splitExtension $ inputFile args) - let posDefExt = case format of - Just f -> Prelude.lookup f (map swap formatExtensions) - Nothing -> Nothing -- We don't know the format -- it will be 2D/3D default - case (obj2s, obj3s) of - ([], [obj]) -> do - let output = fromMaybe - (basename ++ "." ++ fromMaybe "stl" posDefExt) - (outputFile args) - putStrLn $ "Rendering 3D object to " ++ output - putStrLn $ "With resolution " ++ show res - putStrLn $ "In box " ++ show (getBox3 obj) - print obj - export3 format res output obj - ([obj], []) -> do - let output = fromMaybe - (basename ++ "." ++ fromMaybe "svg" posDefExt) - (outputFile args) - putStrLn $ "Rendering 2D object to " ++ output - putStrLn $ "With resolution " ++ show res - putStrLn $ "In box " ++ show (getBox2 obj) - print obj - export2 format res output obj - ([], []) -> putStrLn "No objects to render." - _ -> putStrLn "A mixture of 2D and 3D objects, what do you want to render?" + putStrLn "Processing File." + + hMessageOutput <- messageOutputHandle args + + s@(_, obj2s, obj3s, messages) <- openscadProgram + let res = fromMaybe (getRes s) (resolution args) + basename = fst (splitExtension $ inputFile args) + posDefExt = case format of + Just f -> Prelude.lookup f (map swap formatExtensions) + Nothing -> Nothing -- We don't know the format -- it will be 2D/3D default + hPutStr hMessageOutput $ unlines $ map show messages + case (obj2s, obj3s) of + ([], [obj]) -> do + let output = fromMaybe + (basename ++ "." ++ fromMaybe "stl" posDefExt) + (outputFile args) + putStrLn $ "Rendering 3D object to " ++ output + putStrLn $ "With resolution " ++ show res + putStrLn $ "In box " ++ show (getBox3 obj) + putStrLn $ show obj + export3 format res output obj + ([obj], []) -> do + let output = fromMaybe + (basename ++ "." ++ fromMaybe "svg" posDefExt) + (outputFile args) + putStrLn $ "Rendering 2D object to " ++ output + putStrLn $ "With resolution " ++ show res + putStrLn $ "In box " ++ show (getBox2 obj) + putStrLn $ show obj + export2 format res output obj + ([], []) -> putStrLn "No objects to render." + _ -> putStrLn "A mixture of 2D and 3D objects, what do you want to render?" -- | The entry point. Use the option parser then run the extended OpenScad code. main :: IO () diff --git a/programs/implicitsnap.hs b/programs/implicitsnap.hs index 5c1f547..80aeb12 100644 --- a/programs/implicitsnap.hs +++ b/programs/implicitsnap.hs @@ -15,7 +15,7 @@ -- Let's be explicit about what we're getting from where :) -import Prelude (IO, Maybe(Just, Nothing), String, Bool(True, False), Either(Left, Right), Show, ($), (++), (>), (.), (-), (/), (*), (**), sqrt, min, max, minimum, maximum, show, return) +import Prelude (IO, Maybe(Just, Nothing), String, Bool(True, False), Either(Left, Right), Show, ($), (++), (>), (.), (-), (/), (*), (**), sqrt, min, max, minimum, maximum, show, return, map) import Control.Applicative ((<|>)) @@ -27,7 +27,7 @@ import Snap.Util.GZip (withCompression) import Graphics.Implicit (runOpenscad, extrudeR) -- Variable access functionality, so we can look up a requested resolution. -import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum), VarLookup, lookupVarIn) +import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum), VarLookup, lookupVarIn, Message) -- Functions for finding a box around an object, so we can define the area we need to raytrace inside of. import Graphics.Implicit.ObjectUtil (getBox2, getBox3) @@ -47,6 +47,8 @@ import Data.AffineSpace ((.-.)) -- class DiscreteApprox import Graphics.Implicit.Export.DiscreteAproxable (discreteAprox) +import Data.List (intercalate) + import Data.String (IsString) import Text.ParserCombinators.Parsec (errorPos, sourceLine) @@ -89,12 +91,12 @@ renderHandler = method GET $ withCompression $ do (_, _, _) -> writeBS "must provide source and callback as 1 GET variable each" -- | Find the resolution to raytrace at. -getRes :: (VarLookup, [SymbolicObj2], [SymbolicObj3]) -> ℝ +getRes :: (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]) -> ℝ -- | If a resolution was specified in the input file, just use it. -getRes (lookupVarIn "$res" -> Just (ONum res), _, _) = res +getRes (lookupVarIn "$res" -> Just (ONum res), _, _, _) = res -- | If there was no resolution specified, use a resolution chosen for 3D objects. -- FIXME: magic numbers. -getRes (vars, _, obj:_) = +getRes (vars, _, obj:_, _) = let ((x1,y1,z1),(x2,y2,z2)) = getBox3 obj (x,y,z) = (x2-x1, y2-y1, z2-z1) @@ -103,7 +105,7 @@ getRes (vars, _, obj:_) = _ -> min (minimum [x,y,z]/2) ((x*y*z )**(1/3) / 22) -- | ... Or use a resolution chosen for 2D objects. -- FIXME: magic numbers. -getRes (vars, obj:_, _) = +getRes (vars, obj:_, _, _) = let (p1,p2) = getBox2 obj (x,y) = p2 .-. p1 @@ -115,12 +117,12 @@ getRes _ = 1 -- | get the maximum dimension of the object being rendered. -- FIXME: shouldn't this get the diagonal across the box? -getWidth :: (VarLookup, [SymbolicObj2], [SymbolicObj3]) -> ℝ -getWidth (_, _, obj:_) = maximum [x2-x1, y2-y1, z2-z1] +getWidth :: (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message]) -> ℝ +getWidth (_, _, obj:_, _) = maximum [x2-x1, y2-y1, z2-z1] where ((x1,y1,z1),(x2,y2,z2)) = getBox3 obj -getWidth (_, obj:_, _) = max (x2-x1) (y2-y1) +getWidth (_, obj:_, _, _) = max (x2-x1) (y2-y1) where ((x1,y1),(x2,y2)) = getBox2 obj -getWidth (_, [], []) = 0 +getWidth (_, [], [], _) = 0 -- | Give an openscad object to run and the basename of -- the target to write to... write an object! @@ -137,48 +139,40 @@ executeAndExport content callback maybeFormat = callback ++ "([new Shape()," ++ show msg ++ "," ++ showB is2D ++ "," ++ show w ++ "]);" callbackS :: (Show a1, Show a) => a -> a1 -> String callbackS str msg = callback ++ "([" ++ show str ++ "," ++ show msg ++ ",null,null]);" - in case runOpenscad content of - Left err -> - let - line = sourceLine . errorPos $ err - showErrorMessages' = showErrorMessages - "or" "unknown parse error" "expecting" "unexpected" "end of input" - msgs :: String - msgs = showErrorMessages' $ errorMessages err - in callbackF False False 1 $ (\s-> "error (" ++ show line ++ "):" ++ s) msgs - Right openscadProgram -> unsafePerformIO $ do - (msgs,s) <- capture openscadProgram - let - res = getRes s - w = getWidth s - is2D = case s of - (_, _, _:_) -> False - (_, _:_, _) -> True - _ -> False - highResError = "Unreasonable resolution requested: " - ++ "the server imps revolt! " - ++ "(Install ImplicitCAD locally -- github.com/colah/ImplicitCAD/)" - objOrErr = case s of - (_, _, x:_) -> - if res > 0 - then Right (Nothing, x) - else Left highResError - (_, x:_, _) -> - if res > 0 - then Right (Just x, extrudeR 0 x res) - else Left highResError - _ -> Left $ msgs ++ "Nothing to render." - - return $ case (objOrErr, maybeFormat) of + openscadProgram = runOpenscad content + in + unsafePerformIO $ do + s@(_,_,_,messages) <- openscadProgram + let + res = getRes s + w = getWidth s + is2D = case s of + (_, _, _:_, _) -> False + (_, _:_, _, _) -> True + _ -> False + highResError = "Unreasonable resolution requested: " + ++ "the server imps revolt! " + ++ "(Install ImplicitCAD locally -- github.com/colah/ImplicitCAD/)" + objOrErr = case s of + (_, _, x:_, _) -> + if res > 0 + then Right (Nothing, x) + else Left highResError + (_, x:_, _, _) -> + if res > 0 + then Right (Just x, extrudeR 0 x res) + else Left highResError + _ -> Left $ (intercalate "\n" $ map show messages) ++ "Nothing to render." + return $ case (objOrErr, maybeFormat) of (Left errmsg, _) -> callbackF False False 1 errmsg (Right (_,obj), Nothing) -> - TL.unpack (jsTHREE (discreteAprox res obj)) ++ callbackF True is2D w msgs + TL.unpack (jsTHREE (discreteAprox res obj)) ++ (callbackF True is2D w $ (intercalate "\n" $ map show messages)) (Right (_,obj), Just "STL") -> - callbackS (TL.unpack (stl (discreteAprox res obj))) msgs + callbackS (TL.unpack (stl (discreteAprox res obj))) $ intercalate "\n" $ map show messages (Right (Just obj, _), Just "SVG") -> - callbackS (TL.unpack (svg (discreteAprox res obj))) msgs + callbackS (TL.unpack (svg (discreteAprox res obj))) $ intercalate "\n" $ map show messages (Right (Just obj, _), Just "gcode/hacklab-laser") -> - callbackS (TL.unpack (hacklabLaserGCode (discreteAprox res obj))) msgs + callbackS (TL.unpack (hacklabLaserGCode (discreteAprox res obj))) $ intercalate "\n" $ map show messages (Right (_ , _), _) -> callbackF False False 1 "unexpected case"