module Waterfall.IO
(  writeSTL
, writeSTEP
, writeGLTF
, writeGLB
) 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 qualified OpenCascade.TDocStd.Document as TDocStd.Document
import qualified OpenCascade.Message.ProgressRange as Message.ProgressRange
import qualified OpenCascade.TColStd.IndexedDataMapOfStringString as TColStd.IndexedDataMapOfStringString
import qualified OpenCascade.RWGltf.CafWriter as RWGltf.CafWriter
import qualified OpenCascade.XCAFDoc.DocumentTool as XCafDoc.DocumentTool
import qualified OpenCascade.XCAFDoc.ShapeTool as XCafDoc.ShapeTool
import Control.Monad.IO.Class (liftIO)
import Control.Monad (void, unless)
import System.IO (hPutStrLn, stderr)
import Waterfall.Internal.Finalizers (toAcquire)
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 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 ()

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

writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB :: Bool -> Double -> String -> Solid -> IO ()
writeGLTFOrGLB Bool
binary 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 (Handle Document)
doc <- String -> Acquire (Ptr (Handle Document))
TDocStd.Document.fromStorageFormat String
""
    Ptr Label
mainLabel <- Ptr (Handle Document) -> Acquire (Ptr Label)
TDocStd.Document.main Ptr (Handle Document)
doc
    Ptr (Handle ShapeTool)
shapeTool <- Ptr Label -> Acquire (Ptr (Handle ShapeTool))
XCafDoc.DocumentTool.shapeTool Ptr Label
mainLabel
    Ptr Label
_ <- Ptr (Handle ShapeTool)
-> Ptr Shape -> Bool -> Bool -> Acquire (Ptr Label)
XCafDoc.ShapeTool.addShape Ptr (Handle ShapeTool)
shapeTool Ptr Shape
s Bool
True Bool
True
    Ptr IndexedDataMapOfStringString
meta <- Acquire (Ptr IndexedDataMapOfStringString)
TColStd.IndexedDataMapOfStringString.new
    Ptr ProgressRange
progress <- Acquire (Ptr ProgressRange)
Message.ProgressRange.new
    Ptr CafWriter
writer <- String -> Bool -> Acquire (Ptr CafWriter)
RWGltf.CafWriter.new String
filepath Bool
binary
    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 CafWriter
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> IO ()
RWGltf.CafWriter.perform Ptr CafWriter
writer Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress
    () -> Acquire ()
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Write a `Solid` to a glTF file at a given path
--
-- glTF, or Graphics Library Transmission Format is a JSON based format 
-- used for three-dimensional scenes and models
writeGLTF :: Double -> FilePath -> Solid -> IO ()
writeGLTF :: Double -> String -> Solid -> IO ()
writeGLTF = Bool -> Double -> String -> Solid -> IO ()
writeGLTFOrGLB Bool
False

-- | Write a `Solid` to a glb file at a given path
--
-- glb is the binary variant of the glTF file format
writeGLB :: Double -> FilePath -> Solid -> IO ()
writeGLB :: Double -> String -> Solid -> IO ()
writeGLB = Bool -> Double -> String -> Solid -> IO ()
writeGLTFOrGLB Bool
True