module Waterfall.IO
( WaterfallIOException (..)
, WaterfallIOExceptionCause (..)
, writeSolid
, writeSTL
, writeAsciiSTL
, writeSTEP
, writeGLTF
, writeGLB
, writeOBJ
, readSolid
, readSTL
, readSTEP
, readGLTF
, readGLB
, readOBJ
) where
import Waterfall.Internal.Solid (Solid(..))
import qualified Waterfall.Internal.Remesh as Remesh
import qualified OpenCascade.BRepMesh.IncrementalMesh as BRepMesh.IncrementalMesh
import qualified OpenCascade.StlAPI.Writer as StlWriter
import qualified OpenCascade.StlAPI.Reader as StlReader
import qualified OpenCascade.STEPControl.Writer as StepWriter
import qualified OpenCascade.STEPControl.StepModelType as StepModelType
import qualified OpenCascade.STEPControl.Reader as STEPReader
import qualified OpenCascade.XSControl.Reader as XSControl.Reader
import qualified OpenCascade.IFSelect.ReturnStatus as IFSelect.ReturnStatus
import qualified OpenCascade.TDocStd.Document as TDocStd.Document
import qualified OpenCascade.Message.Types as Message
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.RWGltf.CafReader as RWGltf.CafReader
import qualified OpenCascade.RWObj.CafWriter as RWObj.CafWriter
import qualified OpenCascade.RWObj.CafReader as RWObj.CafReader
import qualified OpenCascade.RWMesh.Types as RWMesh
import qualified OpenCascade.RWMesh.CafReader as RWMesh.CafReader
import qualified OpenCascade.TDocStd.Types as TDocStd
import qualified OpenCascade.TColStd.Types as TColStd
import qualified OpenCascade.XCAFDoc.DocumentTool as XCafDoc.DocumentTool
import qualified OpenCascade.XCAFDoc.ShapeTool as XCafDoc.ShapeTool
import qualified OpenCascade.TopoDS.Types as TopoDS
import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape
import OpenCascade.Handle (Handle)
import OpenCascade.Inheritance (upcast)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (unless, when)
import Waterfall.Internal.Finalizers (toAcquire, fromAcquire)
import Data.Acquire ( Acquire, withAcquire )
import Foreign.Ptr (Ptr)
import Data.Char (toLower)
import System.FilePath (takeExtension)
import Control.Exception (Exception, throwIO)
data WaterfallIOException =
WaterfallIOException
{ WaterfallIOException -> WaterfallIOExceptionCause
ioExceptionCause :: WaterfallIOExceptionCause
, WaterfallIOException -> FilePath
ioExceptionFilePath :: FilePath
}
deriving Int -> WaterfallIOException -> ShowS
[WaterfallIOException] -> ShowS
WaterfallIOException -> FilePath
(Int -> WaterfallIOException -> ShowS)
-> (WaterfallIOException -> FilePath)
-> ([WaterfallIOException] -> ShowS)
-> Show WaterfallIOException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaterfallIOException -> ShowS
showsPrec :: Int -> WaterfallIOException -> ShowS
$cshow :: WaterfallIOException -> FilePath
show :: WaterfallIOException -> FilePath
$cshowList :: [WaterfallIOException] -> ShowS
showList :: [WaterfallIOException] -> ShowS
Show
instance Exception WaterfallIOException
data WaterfallIOExceptionCause =
FileError
| BadGeometryError
| UnrecognizedFormatError
deriving (Int -> WaterfallIOExceptionCause -> ShowS
[WaterfallIOExceptionCause] -> ShowS
WaterfallIOExceptionCause -> FilePath
(Int -> WaterfallIOExceptionCause -> ShowS)
-> (WaterfallIOExceptionCause -> FilePath)
-> ([WaterfallIOExceptionCause] -> ShowS)
-> Show WaterfallIOExceptionCause
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaterfallIOExceptionCause -> ShowS
showsPrec :: Int -> WaterfallIOExceptionCause -> ShowS
$cshow :: WaterfallIOExceptionCause -> FilePath
show :: WaterfallIOExceptionCause -> FilePath
$cshowList :: [WaterfallIOExceptionCause] -> ShowS
showList :: [WaterfallIOExceptionCause] -> ShowS
Show, WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
(WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool)
-> (WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool)
-> Eq WaterfallIOExceptionCause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
== :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
$c/= :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
/= :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
Eq)
extensionToFormats :: String -> Maybe (Double -> FilePath -> Solid -> IO(), FilePath -> IO Solid)
extensionToFormats :: FilePath
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
s =
let ext :: FilePath
ext = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
s
in case FilePath
ext of
FilePath
".stl" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeSTL, FilePath -> IO Solid
readSTL)
FilePath
".step" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just ((FilePath -> Solid -> IO ())
-> Double -> FilePath -> Solid -> IO ()
forall a b. a -> b -> a
const FilePath -> Solid -> IO ()
writeSTEP, FilePath -> IO Solid
readSTEP)
FilePath
".gltf" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeGLTF, FilePath -> IO Solid
readGLTF)
FilePath
".glb" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeGLB, FilePath -> IO Solid
readGLB)
FilePath
".obj" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeOBJ, FilePath -> IO Solid
readOBJ)
FilePath
_ -> Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. Maybe a
Nothing
writeSolid :: Double -> FilePath -> Solid -> IO ()
writeSolid :: Double -> FilePath -> Solid -> IO ()
writeSolid Double
res FilePath
filepath =
case FilePath
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
filepath of
Just (Double -> FilePath -> Solid -> IO ()
writer, FilePath -> IO Solid
_) -> Double -> FilePath -> Solid -> IO ()
writer Double
res FilePath
filepath
Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
Nothing -> IO () -> Solid -> IO ()
forall a b. a -> b -> a
const (IO () -> Solid -> IO ()) -> IO () -> Solid -> IO ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
UnrecognizedFormatError FilePath
filepath)
writeSTLAsciiOrBinary :: Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary :: Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
asciiMode Double
linDeflection FilePath
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
asciiMode
Bool
res <- Ptr Writer -> Ptr Shape -> FilePath -> IO Bool
StlWriter.write Ptr Writer
writer Ptr Shape
s FilePath
filepath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
filepath))
() -> Acquire ()
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL = Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
False
writeAsciiSTL :: Double -> FilePath -> Solid -> IO ()
writeAsciiSTL :: Double -> FilePath -> Solid -> IO ()
writeAsciiSTL = Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
True
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP FilePath
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
resTransfer <- 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
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReturnStatus
resTransfer ReturnStatus -> ReturnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnStatus
IFSelect.ReturnStatus.Done) (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
BadGeometryError FilePath
filepath)
ReturnStatus
resWrite <- 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 -> FilePath -> IO ReturnStatus
StepWriter.write Ptr Writer
writer FilePath
filepath
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReturnStatus
resWrite ReturnStatus -> ReturnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnStatus
IFSelect.ReturnStatus.Done) (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
filepath)
cafWriter :: (FilePath -> Ptr (Handle TDocStd.Document) -> Ptr TColStd.IndexedDataMapOfStringString -> Ptr Message.ProgressRange -> Acquire ()) -> Double -> FilePath -> Solid-> IO ()
cafWriter :: (FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write Double
linDeflection FilePath
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 <- FilePath -> Acquire (Ptr (Handle Document))
TDocStd.Document.fromStorageFormat FilePath
""
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
FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write FilePath
filepath Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress
writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
binary =
let write :: FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write FilePath
filepath Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress = do
Ptr CafWriter
writer <- FilePath -> Bool -> Acquire (Ptr CafWriter)
RWGltf.CafWriter.new FilePath
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
in (FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write
writeGLTF :: Double -> FilePath -> Solid -> IO ()
writeGLTF :: Double -> FilePath -> Solid -> IO ()
writeGLTF = Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
False
writeGLB :: Double -> FilePath -> Solid -> IO ()
writeGLB :: Double -> FilePath -> Solid -> IO ()
writeGLB = Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
True
writeOBJ :: Double -> FilePath -> Solid -> IO ()
writeOBJ :: Double -> FilePath -> Solid -> IO ()
writeOBJ =
let write :: FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write FilePath
filepath Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress = do
Ptr CafWriter
writer <- FilePath -> Acquire (Ptr CafWriter)
RWObj.CafWriter.new FilePath
filepath
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 ()
RWObj.CafWriter.perform Ptr CafWriter
writer Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress
in (FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write
readSolid :: FilePath -> IO Solid
readSolid :: FilePath -> IO Solid
readSolid FilePath
filepath =
case FilePath
-> Maybe
(Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
filepath of
Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
Nothing -> WaterfallIOException -> IO Solid
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
UnrecognizedFormatError FilePath
filepath)
Just (Double -> FilePath -> Solid -> IO ()
_, FilePath -> IO Solid
reader) -> FilePath -> IO Solid
reader FilePath
filepath
remeshOrThrow :: FilePath -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)
remeshOrThrow :: FilePath -> Ptr Shape -> Acquire (Ptr Shape)
remeshOrThrow FilePath
filepath Ptr Shape
shape = do
Maybe (Ptr Shape)
remeshed <- Ptr Shape -> Acquire (Maybe (Ptr Shape))
Remesh.remesh Ptr Shape
shape
case Maybe (Ptr Shape)
remeshed of
Just Ptr Shape
solid -> Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Shape
solid
Maybe (Ptr Shape)
Nothing -> IO (Ptr Shape) -> Acquire (Ptr Shape)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shape) -> Acquire (Ptr Shape))
-> (WaterfallIOException -> IO (Ptr Shape))
-> WaterfallIOException
-> Acquire (Ptr Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO (Ptr Shape)
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire (Ptr Shape))
-> WaterfallIOException -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
BadGeometryError FilePath
filepath
readSTL :: FilePath -> IO Solid
readSTL :: FilePath -> IO Solid
readSTL FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
shape <- Acquire (Ptr Shape)
TopoDS.Shape.new
Ptr Reader
reader <- Acquire (Ptr Reader)
StlReader.new
Bool
res <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Reader -> Ptr Shape -> FilePath -> IO Bool
StlReader.read Ptr Reader
reader Ptr Shape
shape FilePath
filepath
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (Acquire () -> Acquire ()) -> Acquire () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
filepath
FilePath -> Ptr Shape -> Acquire (Ptr Shape)
remeshOrThrow FilePath
filepath Ptr Shape
shape
readSTEP :: FilePath -> IO Solid
readSTEP :: FilePath -> IO Solid
readSTEP FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr Reader
reader <- Acquire (Ptr Reader)
STEPReader.new
ReturnStatus
status <- 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 Reader -> FilePath -> IO ReturnStatus
XSControl.Reader.readFile (Ptr Reader -> Ptr Reader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Reader
reader) FilePath
filepath
Bool
_ <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Reader -> IO Bool
XSControl.Reader.transferRoots (Ptr Reader -> Ptr Reader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Reader
reader)
Ptr Shape
shape <- Ptr Reader -> Acquire (Ptr Shape)
XSControl.Reader.oneShape (Ptr Reader -> Ptr Reader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Reader
reader)
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReturnStatus
status ReturnStatus -> ReturnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnStatus
IFSelect.ReturnStatus.Done) (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
filepath)
Bool
shapeIsNull <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr Shape -> IO Bool
TopoDS.Shape.isNull Ptr Shape
shape
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shapeIsNull (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
BadGeometryError FilePath
filepath)
Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Shape
shape
cafReader :: Acquire (Ptr RWMesh.CafReader) -> FilePath -> IO Solid
cafReader :: Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader Acquire (Ptr CafReader)
mkReader FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr CafReader
reader <- Acquire (Ptr CafReader)
mkReader
Ptr (Handle Document)
doc <- FilePath -> Acquire (Ptr (Handle Document))
TDocStd.Document.fromStorageFormat FilePath
""
Ptr ProgressRange
progress <- Acquire (Ptr ProgressRange)
Message.ProgressRange.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
$ Ptr CafReader -> Ptr (Handle Document) -> IO ()
RWMesh.CafReader.setDocument Ptr CafReader
reader Ptr (Handle Document)
doc
Bool
res <- IO Bool -> Acquire Bool
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Acquire Bool) -> IO Bool -> Acquire Bool
forall a b. (a -> b) -> a -> b
$ Ptr CafReader -> FilePath -> Ptr ProgressRange -> IO Bool
RWMesh.CafReader.perform Ptr CafReader
reader FilePath
filepath Ptr ProgressRange
progress
Bool -> Acquire () -> Acquire ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (WaterfallIOException -> IO ())
-> WaterfallIOException
-> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> Acquire ())
-> WaterfallIOException -> Acquire ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
filepath)
FilePath -> Ptr Shape -> Acquire (Ptr Shape)
remeshOrThrow FilePath
filepath (Ptr Shape -> Acquire (Ptr Shape))
-> Acquire (Ptr Shape) -> Acquire (Ptr Shape)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CafReader -> Acquire (Ptr Shape)
RWMesh.CafReader.singleShape Ptr CafReader
reader
readGLTF :: FilePath -> IO Solid
readGLTF :: FilePath -> IO Solid
readGLTF = Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader (Acquire (Ptr CafReader) -> FilePath -> IO Solid)
-> Acquire (Ptr CafReader) -> FilePath -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr CafReader
reader <- Acquire (Ptr CafReader)
RWGltf.CafReader.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
$ Ptr CafReader -> Bool -> IO ()
RWGltf.CafReader.setDoublePrecision Ptr CafReader
reader Bool
True
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 CafReader -> Double -> IO ()
RWMesh.CafReader.setFileLengthUnit (Ptr CafReader -> Ptr CafReader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr CafReader
reader) Double
1
Ptr CafReader -> Acquire (Ptr CafReader)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CafReader -> Ptr CafReader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr CafReader
reader)
readGLB :: FilePath -> IO Solid
readGLB :: FilePath -> IO Solid
readGLB = FilePath -> IO Solid
readGLTF
readOBJ :: FilePath -> IO Solid
readOBJ :: FilePath -> IO Solid
readOBJ = Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader (Acquire (Ptr CafReader) -> FilePath -> IO Solid)
-> Acquire (Ptr CafReader) -> FilePath -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr CafReader
reader <- Acquire (Ptr CafReader)
RWObj.CafReader.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
$ Ptr CafReader -> Bool -> IO ()
RWObj.CafReader.setSinglePrecision Ptr CafReader
reader Bool
False
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 CafReader -> Double -> IO ()
RWMesh.CafReader.setFileLengthUnit (Ptr CafReader -> Ptr CafReader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr CafReader
reader) Double
1
Ptr CafReader -> Acquire (Ptr CafReader)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CafReader -> Ptr CafReader
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr CafReader
reader)