implicit-0.4.0.0: programs/extopenscad.hs

{- ORMOLU_DISABLE -}
-- 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

-- An interpreter to run extended OpenScad code. outputs STL, OBJ, SVG, SCAD, PNG, DXF, or GCODE.

-- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-}

-- Let's be explicit about what we're getting from where :)

import Prelude (Maybe(Just, Nothing), IO, Bool(True, False), FilePath, String, (<>), ($), readFile, fst, putStrLn, show, (>>=), return, unlines, filter, not, null, (||), (&&), (.), print)

-- Our Extended OpenScad interpreter
import Graphics.Implicit (union, runOpenscad)

import Graphics.Implicit.Definitions (ℝ)

-- Use default values when a Maybe is Nothing.
import Data.Maybe (fromMaybe, maybe)

-- 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 (Message(Message), MessageType(TextOut), ScadOpts(ScadOpts))

import Control.Applicative ((<$>), (<*>), many)

import Options.Applicative (fullDesc, header, auto, info, helper, help, str, argument, long, short, option, metavar, execParser, Parser, optional, strOption, switch, footer)

-- For handling input/output files.
import System.FilePath (splitExtension)

-- For handling handles to output files.
import System.IO (Handle, hPutStr, stdout, stderr, openFile, IOMode(WriteMode))

import Data.Text.Lazy (Text, unpack)
import Graphics.Implicit.Primitives (Object(getBox))
import Graphics.Implicit.Export (export2, export3)
import Graphics.Implicit.Export.OutputFormat (OutputFormat, guessOutputFormat, formatExtension, def2D, def3D)
import Graphics.Implicit.Export.Resolution (estimateResolution)

-- | Our command line options.
data ExtOpenScadOpts = ExtOpenScadOpts
    { outputFile :: Maybe FilePath
    , outputFormat :: Maybe OutputFormat
    , resolution :: Maybe ℝ
    , messageOutputFile :: Maybe FilePath
    , quiet :: Bool
    , openScadCompatibility :: Bool
    , openScadEcho :: Bool
    , rawEcho :: Bool
    , noImport :: Bool
    , rawDefines :: [String]
    , inputFile :: FilePath
    }

-- | The parser for our command line arguments.
extOpenScadOpts :: Parser ExtOpenScadOpts
extOpenScadOpts = ExtOpenScadOpts
    <$> optional (
      strOption
        (  short 'o'
        <> long "output"
        <> metavar "OUTFILE"
        <> 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 "Mesh granularity (smaller values generate more precise renderings of objects)"
        )
      )
    <*> optional (
        strOption
          (  short 'e'
             <> long "echo-output"
             <> metavar "ECHOOUTFILE"
             <> help "Output file name for text generated by the extended OpenSCAD code"
          )
        )
    <*> switch
        (  short 'q'
           <> long "quiet"
           <> help "Supress normal program output, only outputting messages resulting from the parsing or execution of extended OpenSCAD code"
        )
    <*> switch
        (  short 'O'
           <> long "fopenscad-compat"
           <> help "Favour compatibility with OpenSCAD semantics, where they are incompatible with ExtOpenScad semantics"
        )
    <*> switch
        (  long "fopenscad-echo"
           <> help "Use OpenSCAD's style when displaying text output from the extended OpenSCAD code"
        )
    <*> switch
        (  long "fraw-echo"
           <> help "Do not use any prefix when displaying text output from the extended OpenSCAD code"
        )
    <*> switch
        (  long "fno-import"
           <> help "Do not honor \"use\" and \"include\" statements, and instead generate a warning"
        )
    <*> many (
      strOption
        (  short 'D'
           <> help "define variable KEY equal to variable VALUE when running extended OpenSCAD code"
        )
      )
    <*> argument str
        (  metavar "FILE"
        <> help "Input extended OpenSCAD file"
        )

-- | 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)

textOutOpenScad :: Message -> Text
textOutOpenScad  (Message _ _ msg) = "ECHO: " <> msg

textOutBare :: Message -> Text
textOutBare (Message _ _ msg) = msg

isTextOut :: Message -> Bool
isTextOut (Message TextOut _ _ ) = True
isTextOut _                      = False

objectMessage :: String -> String -> String -> String -> String -> String
objectMessage dimensions infile outfile res box =
  "Rendering " <> dimensions <> " object from " <> infile <> " to " <> outfile <> " with resolution " <> res <> " in box " <> box

-- using the openscad compat group turns on openscad compatibility options. using related extopenscad options turns them off.
-- FIXME: allow processArgs to generate messages.
processArgs :: ExtOpenScadOpts -> ExtOpenScadOpts
processArgs (ExtOpenScadOpts o f r e q compat echo rawecho noimport defines file) =
  ExtOpenScadOpts o f r e q compat echo_flag rawecho noimport defines file
  where
    echo_flag = (compat || echo) && not rawecho

-- | decide what options to send the scad engine based on the post-processed arguments passed to extopenscad.
generateScadOpts :: ExtOpenScadOpts -> ScadOpts
generateScadOpts args = ScadOpts (openScadCompatibility args) (not $ noImport args)

-- | Interpret arguments, and render the object defined in the supplied input file.
run :: ExtOpenScadOpts -> IO ()
run rawargs = do
    let args = processArgs rawargs

    hMessageOutput <- messageOutputHandle args

    if quiet args
      then return ()
      else 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
        scadOpts = generateScadOpts args
        openscadProgram = runOpenscad scadOpts (rawDefines args) content

    if quiet args
      then return ()
      else putStrLn "Processing File."

    s@(_, obj2s, obj3s, messages) <- openscadProgram
    let res = fromMaybe (estimateResolution s) (resolution args)
        basename = fst (splitExtension $ inputFile args)
        -- If we don't know the format -- it will be 2D/3D default (stl)
        posDefExt = fromMaybe "stl" (formatExtension <$> format)

    case (obj2s, obj3s) of
      ([], obj:objs) -> do
        let output = fromMaybe
                     (basename <> "." <> posDefExt)
                     (outputFile args)
            target = if null objs
                     then obj
                     else union (obj:objs)

        if quiet args
          then return ()
          else putStrLn $ objectMessage "3D" (inputFile args) output (show res) $ show $ getBox target

        -- FIXME: construct and use a warning for this.
        if null objs
          then return ()
          else
            hPutStr stderr "WARNING: Multiple objects detected. Adding a Union around them.\n"

        if quiet args
          then return ()
          else print target

        export3 (fromMaybe def3D format) res output target

      (obj:objs, []) -> do
        let output = fromMaybe
                     (basename <> "." <> posDefExt)
                     (outputFile args)
            target = if null objs
                     then obj
                     else union (obj:objs)

        if quiet args
          then return ()
          else putStrLn $ objectMessage "2D" (inputFile args) output (show res) $ show $ getBox target

        -- FIXME: construct and use a warning for this.
        if null objs
          then return ()
          else
            hPutStr stderr "WARNING: Multiple objects detected. Adding a Union around them.\n"

        if quiet args
          then return ()
          else print target

        export2 (fromMaybe def2D format) res output target

      ([], []) ->
        if quiet args
          then return ()
          else putStrLn "No objects to render."
      _        -> hPutStr stderr "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?\n"

    -- Always display our warnings, errors, and other non-textout messages on stderr.
    hPutStr stderr $ unlines $ show <$> filter (not . isTextOut) messages

    let textOutHandler =
          case () of
            _ | openScadEcho args -> unpack . textOutOpenScad
            _ | rawEcho args      -> unpack . textOutBare
            _                     -> show

    hPutStr hMessageOutput $ unlines $ textOutHandler <$> filter isTextOut messages

-- | 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
              <> header "ImplicitCAD: extopenscad - Extended OpenSCAD interpreter."
              <> footer "License: The GNU AGPL version 3 or later <http://gnu.org/licenses/agpl.html> This program is Free Software; you are free to view, change and redistribute it. There is NO WARRANTY, to the extent permitted by law."
              )