module Waterfall.TwoD.Text
( text
, Font
, FontAspect (..)
, fontFromPath
, fontFromSystem
) where
import qualified Waterfall.TwoD.Internal.Shape as Shape
import Waterfall.Internal.Finalizers (toAcquire, fromAcquire, unsafeFromAcquire)
import Waterfall.IO (WaterfallIOException (..), WaterfallIOExceptionCause (FileError))
import qualified OpenCascade.GP.Ax3 as GP.Ax3
import qualified OpenCascade.Font.BRepFont as BRepFont
import qualified OpenCascade.Font.BRepTextBuilder as BRepTextBuilder
import qualified OpenCascade.Graphic3D.VerticalTextAlignment as VTA
import qualified OpenCascade.Graphic3D.HorizontalTextAlignment as HTA
import Foreign.Ptr
import Control.Monad (unless)
import OpenCascade.Font.FontAspect (FontAspect (..))
import Control.Exception (throwIO)
newtype Font = Font { Font -> Ptr BRepFont
rawFont :: Ptr BRepFont.BRepFont }
fontFromPath :: FilePath -> Double -> IO Font
fontFromPath :: FilePath -> Double -> IO Font
fontFromPath FilePath
fontpath Double
size = do
bRepFont <- Acquire (Ptr BRepFont) -> IO (Ptr BRepFont)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr BRepFont) -> IO (Ptr BRepFont))
-> Acquire (Ptr BRepFont) -> IO (Ptr BRepFont)
forall a b. (a -> b) -> a -> b
$ Acquire (Ptr BRepFont)
BRepFont.new
fontOk <- BRepFont.initFromPathAndSize bRepFont fontpath size
unless (fontOk) $ throwIO (WaterfallIOException FileError fontpath)
return $ Font bRepFont
fontFromSystem :: String -> FontAspect -> Double -> IO Font
fontFromSystem :: FilePath -> FontAspect -> Double -> IO Font
fontFromSystem FilePath
name FontAspect
aspect Double
size = do
bRepFont <- Acquire (Ptr BRepFont) -> IO (Ptr BRepFont)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr BRepFont) -> IO (Ptr BRepFont))
-> Acquire (Ptr BRepFont) -> IO (Ptr BRepFont)
forall a b. (a -> b) -> a -> b
$ Acquire (Ptr BRepFont)
BRepFont.new
fontOk <- BRepFont.initFromNameAspectAndSize bRepFont name aspect size
unless (fontOk) $ throwIO $ WaterfallIOException FileError (name <> "::" <> show aspect)
return $ Font bRepFont
text :: Font -> String -> Shape.Shape
text :: Font -> FilePath -> Shape
text Font
font FilePath
content = Ptr Shape -> Shape
Shape.Shape (Ptr Shape -> Shape)
-> (Acquire (Ptr Shape) -> Ptr Shape)
-> Acquire (Ptr Shape)
-> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> Ptr Shape
forall a. Acquire a -> a
unsafeFromAcquire (Acquire (Ptr Shape) -> Shape) -> Acquire (Ptr Shape) -> Shape
forall a b. (a -> b) -> a -> b
$ do
axis <- Acquire (Ptr Ax3)
GP.Ax3.new
bRepFont <- toAcquire . rawFont $ font
builder <- BRepTextBuilder.new
BRepTextBuilder.perform builder bRepFont content axis HTA.Center VTA.Center