module Waterfall.IO
( writeSTL
, writeSTEP
) where
import Waterfall.Internal.Solid (Solid(..))
import qualified OpenCascade.BRepMesh.IncrementalMesh as BRepMesh.IncrementalMesh
import qualified OpenCascade.StlAPI.Writer as StlWriter
import qualified OpenCascade.STEPControl.Writer as StepWriter
import qualified OpenCascade.STEPControl.StepModelType as StepModelType
import Control.Monad.IO.Class (liftIO)
import Control.Monad (void, unless)
import System.IO (hPutStrLn, stderr)
import Waterfall.Internal.Finalizers (toAcquire)
import Data.Acquire
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL :: Double -> String -> Solid -> IO ()
writeSTL Double
linDeflection String
filepath (Solid Ptr Shape
ptr) = (Acquire () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
`withAcquire` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Acquire () -> IO ()) -> Acquire () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
s <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
ptr
Ptr IncrementalMesh
mesh <- Ptr Shape -> Double -> Acquire (Ptr IncrementalMesh)
BRepMesh.IncrementalMesh.fromShapeAndLinDeflection Ptr Shape
s Double
linDeflection
IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr IncrementalMesh -> IO ()
BRepMesh.IncrementalMesh.perform Ptr IncrementalMesh
mesh
Ptr Writer
writer <- Acquire (Ptr Writer)
StlWriter.new
IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ do
Ptr Writer -> Bool -> IO ()
StlWriter.setAsciiMode Ptr Writer
writer Bool
False
Bool
res <- Ptr Writer -> Ptr Shape -> String -> IO Bool
StlWriter.write Ptr Writer
writer Ptr Shape
s String
filepath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"failed to write " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filepath))
() -> Acquire ()
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP :: String -> Solid -> IO ()
writeSTEP String
filepath (Solid Ptr Shape
ptr) = (Acquire () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
`withAcquire` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Acquire () -> IO ()) -> Acquire () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
s <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
ptr
Ptr Writer
writer <- Acquire (Ptr Writer)
StepWriter.new
ReturnStatus
_ <- IO ReturnStatus -> Acquire ReturnStatus
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReturnStatus -> Acquire ReturnStatus)
-> IO ReturnStatus -> Acquire ReturnStatus
forall a b. (a -> b) -> a -> b
$ Ptr Writer -> Ptr Shape -> StepModelType -> Bool -> IO ReturnStatus
StepWriter.transfer Ptr Writer
writer Ptr Shape
s StepModelType
StepModelType.Asls Bool
True
Acquire ReturnStatus -> Acquire ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Acquire ReturnStatus -> Acquire ())
-> (IO ReturnStatus -> Acquire ReturnStatus)
-> IO ReturnStatus
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ReturnStatus -> Acquire ReturnStatus
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReturnStatus -> Acquire ()) -> IO ReturnStatus -> Acquire ()
forall a b. (a -> b) -> a -> b
$ Ptr Writer -> String -> IO ReturnStatus
StepWriter.write Ptr Writer
writer String
filepath