implicit-0.1.0: programs/extopenscad.hs
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
-- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com)
-- Released under the GNU GPL, see LICENSE
-- FIXME: add support for AMF.
-- An interpreter to run extended OpenScad code, outputing STL, OBJ, SVG, SCAD, PNG, or GCODE.
-- Enable additional syntax to make our code more readable.
{-# LANGUAGE ViewPatterns , PatternGuards #-}
-- Let's be explicit about what we're getting from where :)
-- Our Extended OpenScad interpreter, and functions to write out files in designated formats.
import Graphics.Implicit (runOpenscad, writeSVG, writeBinSTL, writeOBJ, writeSCAD2, writeSCAD3, writeGCodeHacklabLaser, writePNG2, writePNG3)
-- 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)
-- Definitions of the datatypes used for 2D objects, 3D objects, and for defining the resolution to raytrace at.
import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3, ℝ)
-- Use default values when a Maybe is Nothing.
import Data.Maybe (fromMaybe)
-- For making the format guesser case insensitive when looking at file extensions.
import Data.Char (toLower)
-- To flip around formatExtensions. Used when looking up an extension based on a format.
import Data.Tuple (swap)
-- Functions and types for dealing with the types used by runOpenscad.
-- Note that Map is different than the maps used by the prelude functions.
import qualified Data.Map.Strict as Map (Map, lookup)
import Graphics.Implicit.ExtOpenScad.Definitions (OVal (ONum))
-- Operator to subtract two points. Used when defining the resolution of a 2d object.
import Data.AffineSpace ((.-.))
-- NOTE: make sure we don't import (<>) in new versions.
import Options.Applicative (fullDesc, progDesc, header, auto, info, helper, help, str, argument, long, short, option, metavar, execParser, Parser, optional, strOption)
-- For handling input/output files.
import System.FilePath (splitExtension)
-- The following is needed to ensure backwards/forwards compatibility
-- Backwards compatibility with old versions of Data.Monoid:
infixr 6 <>
(<>) :: Monoid a => a -> a -> a
(<>) = mappend
-- A datatype for containing our command line options.
data ExtOpenScadOpts = ExtOpenScadOpts
{ outputFile :: Maybe FilePath
, outputFormat :: Maybe OutputFormat
, resolution :: Maybe ℝ
, inputFile :: FilePath
}
-- A datatype enumerating our output file formats types.
data OutputFormat
= SVG
| SCAD
| PNG
| GCode
| STL
| OBJ
-- | AMF
deriving (Show, Eq, Ord)
-- A list mapping file extensions to output formats.
formatExtensions :: [(String, OutputFormat)]
formatExtensions =
[ ("svg", SVG)
, ("scad", SCAD)
, ("png", PNG)
, ("ngc", GCode)
, ("gcode", GCode)
, ("stl", STL)
, ("obj", OBJ)
-- , ("amf", AMF)
]
-- Lookup an output format for a given output file. Throw an error if one cannot be found.
guessOutputFormat :: FilePath -> OutputFormat
guessOutputFormat fileName =
maybe (error $ "Unrecognized output format: "<>ext) id
$ readOutputFormat $ tail ext
where
(_,ext) = splitExtension fileName
-- The parser for our command line arguments.
extOpenScadOpts :: Parser ExtOpenScadOpts
extOpenScadOpts = ExtOpenScadOpts
<$> optional (
strOption
( short 'o'
<> long "output"
<> metavar "FILE"
<> help "Output file name"
)
)
<*> optional (
option auto
( short 'f'
<> long "format"
<> metavar "FORMAT"
<> help "Output format"
)
)
<*> optional (
option auto
( short 'r'
<> long "resolution"
<> metavar "RES"
<> help "Approximation quality (smaller is better)"
)
)
<*> argument str
( metavar "FILE"
<> help "Input extended OpenSCAD file"
)
-- Try to look up an output format from a supplied extension.
readOutputFormat :: String -> Maybe OutputFormat
readOutputFormat ext = lookup (map toLower ext) formatExtensions
-- A Read instance for our output format. Used by 'auto' in our command line parser.
-- Reads a string, and evaluates to the appropriate OutputFormat.
instance Read OutputFormat where
readsPrec _ myvalue =
tryParse formatExtensions
where tryParse [] = [] -- If there is nothing left to try, fail
tryParse ((attempt, result):xs) =
if (take (length attempt) myvalue) == attempt
then [(result, drop (length attempt) myvalue)]
else tryParse xs
-- Find the resolution to raytrace at.
getRes :: (Map.Map [Char] OVal, [SymbolicObj2], [SymbolicObj3]) -> ℝ
-- First, use a resolution specified by a variable in the input file.
getRes (Map.lookup "$res" -> Just (ONum res), _, _) = res
-- Use a resolution chosen for 3D objects.
-- FIXME: magic numbers.
getRes (varlookup, _, obj:_) =
let
((x1,y1,z1),(x2,y2,z2)) = getBox3 obj
(x,y,z) = (x2-x1, y2-y1, z2-z1)
in case 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)
-- Use a resolution chosen for 2D objects.
-- FIXME: magic numbers.
getRes (varlookup, obj:_, _) =
let
(p1,p2) = getBox2 obj
(x,y) = p2 .-. p1
in case 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)
-- fallthrough value.
getRes _ = 1
-- Output a file containing a 3D object.
export3 :: Maybe OutputFormat -> ℝ -> FilePath -> SymbolicObj3 -> IO ()
export3 posFmt res output obj =
case posFmt of
Just STL -> writeBinSTL res output obj
Just SCAD -> writeSCAD3 res output obj
Just OBJ -> writeOBJ res output obj
Just PNG -> writePNG3 res output obj
Nothing -> writeBinSTL res output obj
Just fmt -> putStrLn $ "Unrecognized 3D format: "<>show fmt
-- Output a file containing a 2D object.
export2 :: Maybe OutputFormat -> ℝ -> FilePath -> SymbolicObj2 -> IO ()
export2 posFmt res output obj =
case posFmt of
Just SVG -> writeSVG res output obj
Just SCAD -> writeSCAD2 res output obj
Just PNG -> writePNG2 res output obj
Just GCode -> writeGCodeHacklabLaser res output obj
Nothing -> writeSVG res output obj
Just fmt -> putStrLn $ "Unrecognized 2D format: "<>show fmt
-- Interpret arguments, and render the object defined in the supplied input file.
run :: ExtOpenScadOpts -> IO()
run args = do
putStrLn $ "Loading File."
content <- readFile (inputFile args)
let format =
case () of
_ | Just fmt <- outputFormat args -> Just $ fmt
_ | Just file <- outputFile args -> Just $ guessOutputFormat file
_ -> Nothing
putStrLn $ "Processing File."
case runOpenscad content of
Left err -> putStrLn $ show $ err
Right openscadProgram -> do
s@(_, obj2s, obj3s) <- openscadProgram
let res = maybe (getRes s) id (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)
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 "Multiple/No objects, what do you want to render?"
-- The entry point. Use the option parser then run the extended OpenScad code.
main :: IO()
main = execParser opts >>= run
where
opts= info (helper <*> extOpenScadOpts)
( fullDesc
<> progDesc "ImplicitCAD: Extended OpenSCAD interpreter."
<> header "extopenscad - Extended OpenSCAD"
)