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 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 (..))
newtype Font = Font { Font -> Ptr BRepFont
rawFont :: Ptr BRepFont.BRepFont }
fontFromPath :: FilePath -> Double -> IO Font
fontFromPath :: [Char] -> Double -> IO Font
fontFromPath [Char]
fontpath Double
size = do
Ptr BRepFont
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
Bool
fontOk <- Ptr BRepFont -> [Char] -> Double -> IO Bool
BRepFont.initFromPathAndSize Ptr BRepFont
bRepFont [Char]
fontpath Double
size
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
fontOk) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to initialize font from filepath: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
fontpath)
Font -> IO Font
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Font -> IO Font) -> Font -> IO Font
forall a b. (a -> b) -> a -> b
$ Ptr BRepFont -> Font
Font Ptr BRepFont
bRepFont
fontFromSystem :: String -> FontAspect -> Double -> IO Font
fontFromSystem :: [Char] -> FontAspect -> Double -> IO Font
fontFromSystem [Char]
name FontAspect
aspect Double
size = do
Ptr BRepFont
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
Bool
fontOk <- Ptr BRepFont -> [Char] -> FontAspect -> Double -> IO Bool
BRepFont.initFromNameAspectAndSize Ptr BRepFont
bRepFont [Char]
name FontAspect
aspect Double
size
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
fontOk) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to initialize system font with name: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", and aspect" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> FontAspect -> [Char]
forall a. Show a => a -> [Char]
show FontAspect
aspect)
Font -> IO Font
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Font -> IO Font) -> Font -> IO Font
forall a b. (a -> b) -> a -> b
$ Ptr BRepFont -> Font
Font Ptr BRepFont
bRepFont
text :: Font -> String -> Shape.Shape
text :: Font -> [Char] -> Shape
text Font
font [Char]
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
Ptr Ax3
axis <- Acquire (Ptr Ax3)
GP.Ax3.new
Ptr BRepFont
bRepFont <- Ptr BRepFont -> Acquire (Ptr BRepFont)
forall a. a -> Acquire a
toAcquire (Ptr BRepFont -> Acquire (Ptr BRepFont))
-> (Font -> Ptr BRepFont) -> Font -> Acquire (Ptr BRepFont)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr BRepFont
rawFont (Font -> Acquire (Ptr BRepFont)) -> Font -> Acquire (Ptr BRepFont)
forall a b. (a -> b) -> a -> b
$ Font
font
Ptr BRepTextBuilder
builder <- Acquire (Ptr BRepTextBuilder)
BRepTextBuilder.new
Ptr BRepTextBuilder
-> Ptr BRepFont
-> [Char]
-> Ptr Ax3
-> HorizontalTextAlignment
-> VerticalTextAlignment
-> Acquire (Ptr Shape)
BRepTextBuilder.perform Ptr BRepTextBuilder
builder Ptr BRepFont
bRepFont [Char]
content Ptr Ax3
axis HorizontalTextAlignment
HTA.Center VerticalTextAlignment
VTA.Center