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 Data.Acquire

-- | Write a `Solid` to a (binary) STL file at a given path
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but STL files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL :: Double -> String -> Solid -> IO ()
writeSTL Double
linDeflection String
filepath (Solid Acquire (Ptr Shape)
run) = (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 <- Acquire (Ptr Shape)
run
    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 ()

-- | Write a `Solid` to a STEP file at a given path
--
-- STEP files can be imported by [FreeCAD](https://www.freecad.org/)
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP :: String -> Solid -> IO ()
writeSTEP String
filepath (Solid Acquire (Ptr Shape)
run) = (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 <- Acquire (Ptr Shape)
run
    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