Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

extopenscad: Add real command line argument handling #90

Merged
merged 1 commit into from

2 participants

@bgamari

No description provided.

@bgamari bgamari referenced this pull request
Closed

extopenscad --help #41

@colah
Owner

@bgamari : Thank you for writing this. It looks like great code, but there seem to be issues with optparse-applicative under GHC 7.0.4. Since many of our users will be trying to build ImplicitCAD under older GHC versions (many linux distros ship GHC 7.0.4), I'm concerned about this. The issue seems to be rather minor, declaring use of the TypeSynonymInstances extension. Feel like looking into it (ie. contacting the author)?

@bgamari

Sure. I'll ask him about it.

@colah
Owner

Awesome, thanks!!

@colah
Owner

So, you mentioned on IRC that the author had fixed it and would release soon. Can we confirm that soon is within the next week or two? I'm happy to merge this, but if we want to do a release soon we should confirm that the code we are releasing will work for everyone. :)

@bgamari

I believe it happened today. Should be safe to merge.

@colah colah merged commit 253d715 into from
@colah
Owner

Great! Thanks for handling this, @bgamari!

@bgamari bgamari deleted the branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Dec 19, 2012
  1. @bgamari
This page is out of date. Refresh to see the latest.
Showing with 136 additions and 112 deletions.
  1. +135 −112 extopenscad.hs
  2. +1 −0  implicit.cabal
View
247 extopenscad.hs
@@ -1,146 +1,169 @@
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns, PatternGuards #-}
-- Let's make it convenient to run our extended openscad format code
-- Let's be explicit about what we're getting from where :)
-import System.Environment (getArgs)
import System.IO (openFile, IOMode (ReadMode), hGetContents, hClose)
import Graphics.Implicit (runOpenscad, writeSVG, writeBinSTL, writeOBJ, writeSCAD3, writeSCAD2, writeGCodeHacklabLaser, writeTHREEJS, writePNG2, writePNG3)
import Graphics.Implicit.ExtOpenScad.Definitions (OVal (ONum))
import Graphics.Implicit.ObjectUtil (getBox2, getBox3)
-import Graphics.Implicit.Definitions (xmlErrorOn, errorMessage)
-import Data.Map as Map hiding (null)
+import Graphics.Implicit.Definitions (xmlErrorOn, errorMessage, SymbolicObj2, SymbolicObj3)
+import qualified Data.Map as Map hiding (null)
import Data.Maybe as Maybe
+import Data.Monoid ((<>))
+import Data.Tuple (swap)
import Text.ParserCombinators.Parsec (errorPos, sourceLine)
import Text.ParserCombinators.Parsec.Error
import Data.IORef (writeIORef)
-import Data.VectorSpace
-
--- | strip a .scad or .escad file to its basename.
-strip :: String -> String
-strip filename = case reverse filename of
- 'd':'a':'c':'s':'.':xs -> reverse xs
- 'd':'a':'c':'s':'e':'.':xs -> reverse xs
- _ -> filename
-
--- | Get the file type ending of a file
--- eg. "foo.stl" -> "stl"
-fileType filename = reverse $ beforeFirstPeriod $ reverse filename
+import Data.AffineSpace
+import Options.Applicative
+import System.FilePath
+
+data ExtOpenScadOpts = ExtOpenScadOpts
+ { outputFile :: Maybe FilePath
+ , outputFormat :: Maybe OutputFormat
+ , resolution :: Maybe Float
+ , xmlError :: Bool
+ , inputFile :: FilePath
+ }
+
+data OutputFormat
+ = SVG
+ | SCAD
+ | PNG
+ | GCode
+ | STL
+ | OBJ
+ deriving (Show, Eq, Ord)
+
+formatExtensions :: [(String, OutputFormat)]
+formatExtensions =
+ [ ("svg", SVG)
+ , ("scad", SCAD)
+ , ("png", PNG)
+ , ("ngc", GCode)
+ , ("stl", STL)
+ , ("obj", OBJ)
+ ]
+
+readOutputFormat :: String -> Maybe OutputFormat
+readOutputFormat ext = lookup ext formatExtensions
+
+guessOutputFormat :: FilePath -> OutputFormat
+guessOutputFormat fileName =
+ maybe (error $ "Unrecognized output format: "<>ext) id
+ $ readOutputFormat $ tail ext
where
- beforeFirstPeriod [] = []
- beforeFirstPeriod ('.':xs) = []
- beforeFirstPeriod ( x:xs) = x : beforeFirstPeriod xs
+ (_,ext) = splitExtension fileName
+
+extOpenScadOpts :: Parser ExtOpenScadOpts
+extOpenScadOpts =
+ ExtOpenScadOpts
+ <$> nullOption
+ ( short 'o'
+ <> long "output"
+ <> value Nothing
+ <> metavar "FILE"
+ <> reader (Just . str)
+ <> help "Output file name"
+ )
+ <*> nullOption
+ ( short 'f'
+ <> long "format"
+ <> value Nothing
+ <> metavar "FILE"
+ <> help "Output format"
+ <> reader (Just . readOutputFormat)
+ )
+ <*> option
+ ( short 'r'
+ <> long "resolution"
+ <> value Nothing
+ <> metavar "RES"
+ <> help "Approximation quality"
+ )
+ <*> switch
+ ( long "xml-error"
+ & help "Report XML errors"
+ )
+ <*> argument str ( metavar "FILE" )
getRes (Map.lookup "$res" -> Just (ONum res), _, _) = res
-getRes (varlookup, _, obj:_) =
- let
+getRes (varlookup, _, obj:_) =
+ let
((x1,y1,z1),(x2,y2,z2)) = getBox3 obj
(x,y,z) = (x2-x1, y2-y1, z2-z1)
in case Maybe.fromMaybe (ONum 1) $ Map.lookup "$quality" varlookup of
ONum qual | qual > 0 -> min (minimum [x,y,z]/2) ((x*y*z/qual)**(1/3) / 22)
- _ -> min (minimum [x,y,z]/2) ((x*y*z )**(1/3) / 22)
+ _ -> min (minimum [x,y,z]/2) ((x*y*z )**(1/3) / 22)
-getRes (varlookup, obj:_, _) =
- let
+getRes (varlookup, obj:_, _) =
+ let
(p1,p2) = getBox2 obj
- (x,y) = p2 ^-^ p1
+ (x,y) = p2 .-. p1
in case Maybe.fromMaybe (ONum 1) $ Map.lookup "$quality" varlookup of
ONum qual | qual > 0 -> min (min x y/2) ((x*y/qual)**0.5 / 30)
- _ -> min (min x y/2) ((x*y )**0.5 / 30)
+ _ -> min (min x y/2) ((x*y )**0.5 / 30)
getRes _ = 1
--- | Give an openscad object to run and the basename of
--- the target to write to... write an object!
-executeAndExport :: String -> String -> IO ()
-executeAndExport content targetname = case runOpenscad content of
- Left err ->
- let
- line = sourceLine . errorPos $ err
- msgs = errorMessages err
- in errorMessage line $ showErrorMessages
- "or" "unknown parse error" "expecting" "unexpected" "end of input"
- (errorMessages err)
- Right openscadProgram -> do
- s@(vars, obj2s, obj3s) <- openscadProgram
- let
- res = getRes s
- case s of
- (_, [], []) -> putStrLn "Nothing to render"
- (_, x:xs, []) -> do
- putStrLn $ "Rendering 2D object to " ++ targetname ++ ".svg"
- putStrLn $ show x
- writeSVG res (targetname ++ ".svg") x
- (_, _, x:xs) -> do
- putStrLn $ "Rendering 3D object to " ++ targetname++ ".stl"
- putStrLn $ show x
- writeBinSTL res (targetname ++ ".stl") x
-
--- | Give an openscad object to run and the basename of
--- the target to write to... write an object!
-executeAndExportSpecifiedTargetType :: String -> String -> String -> IO ()
-executeAndExportSpecifiedTargetType content targetname formatname = case runOpenscad content of
- Left err -> putStrLn $ show $ err
- Right openscadProgram -> do
- s@(vars, obj2s, obj3s) <- openscadProgram
- let
- res = getRes s
- case (obj2s, obj3s) of
- (obj : objs, _) -> do
- putStrLn $ "Rendering 2D object to " ++ targetname
- putStrLn $ "With resolution " ++ show res
- putStrLn $ "In box " ++ show (getBox2 obj)
- putStrLn $ show obj
- case formatname of
- "svg" -> writeSVG res targetname obj
- "scad"-> writeSCAD2 res targetname obj
- "png" -> writePNG2 res targetname obj
- "ngc" -> writeGCodeHacklabLaser res targetname obj
- _ -> putStrLn $ "Unrecognized 2D format: " ++ formatname
- (_, obj : objs) -> do
- putStrLn $ "Rendering 3D object to " ++ targetname
- putStrLn $ "With resolution " ++ show res
- putStrLn $ "In box " ++ show (getBox3 obj)
- putStrLn $ show obj
- case formatname of
- "stl" -> writeBinSTL res targetname obj
- "scad"-> writeSCAD3 res targetname obj
- "obj" -> writeOBJ res targetname obj
- "png" -> writePNG3 res targetname obj
- _ -> putStrLn $ "Unrecognized 3D format: " ++ formatname
- _ ->
- putStrLn "Nothing to render."
-
+export3 :: OutputFormat -> Float -> FilePath -> SymbolicObj3 -> IO ()
+export3 fmt res output obj =
+ case fmt of
+ STL -> writeBinSTL res output obj
+ SCAD -> writeSCAD3 res output obj
+ OBJ -> writeOBJ res output obj
+ PNG -> writePNG3 res output obj
+ _ -> putStrLn $ "Unrecognized 3D format: "<>show fmt
+
+export2 :: OutputFormat -> Float -> FilePath -> SymbolicObj2 -> IO ()
+export2 fmt res output obj =
+ case fmt of
+ SVG -> writeSVG res output obj
+ SCAD -> writeSCAD2 res output obj
+ PNG -> writePNG2 res output obj
+ GCode -> writeGCodeHacklabLaser res output obj
+ _ -> putStrLn $ "Unrecognized 2D format: "<>show fmt
main :: IO()
main = do
- args <- getArgs
- if Prelude.null args || args == ["--help"] || args == ["-help"]
- then putStrLn $
- "syntax: extopenscad inputfile.escad [outputfile.format]\n"
- ++ "eg. extopenscad input.escad out.stl"
- else do
- let
- args' = if head args == "-xml-error" then tail args else args
- writeIORef xmlErrorOn (head args == "-xml-error")
- case length args' of
- 1 -> do
- f <- openFile (args' !! 0) ReadMode
- content <- hGetContents f
- executeAndExport content (strip $ args' !! 0)
- hClose f
- 2 -> do
- f <- openFile (args' !! 0) ReadMode
- content <- hGetContents f
- executeAndExportSpecifiedTargetType
- content (args' !! 1) (fileType $ args' !! 1)
- hClose f
- _ -> putStrLn $
- "syntax: extopenscad inputfile.escad [outputfile.format]\n"
- ++ "eg. extopenscad input.escad out.stl"
-
+ args <- execParser
+ $ info (helper <*> extOpenScadOpts)
+ ( fullDesc
+ <> progDesc "Extended OpenSCAD"
+ <> header "extopenscad - Extended OpenSCAD"
+ )
+ writeIORef xmlErrorOn (xmlError args)
+ content <- readFile (inputFile args)
+ let format =
+ case () of
+ _ | Just fmt <- outputFormat args -> fmt
+ _ | Just file <- outputFile args -> guessOutputFormat file
+ case runOpenscad content of
+ Left err -> putStrLn $ show $ err
+ Right openscadProgram -> do
+ s@(vars, obj2s, obj3s) <- openscadProgram
+ let res = maybe (getRes s) id (resolution args)
+ let output =
+ let Just defExtension = lookup format (map swap formatExtensions)
+ in maybe (fst (splitExtension $ inputFile args)<>"."<>defExtension) id
+ $ outputFile args
+ case (obj2s, obj3s) of
+ ([], [obj]) -> do
+ 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
+ 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"
View
1  implicit.cabal
@@ -20,6 +20,7 @@ Library
base >= 3 && < 5,
filepath,
directory,
+ optparse-applicative,
parsec,
unordered-containers,
parallel,
Something went wrong with that request. Please try again.