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 }

-- | create a font from a filepath and a font size 
fontFromPath :: FilePath -> Double -> IO Font 
fontFromPath :: FilePath -> Double -> IO Font
fontFromPath FilePath
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 -> FilePath -> Double -> IO Bool
BRepFont.initFromPathAndSize Ptr BRepFont
bRepFont FilePath
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
$ WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError FilePath
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

-- | Create a font from a system font name, aspect, and size
fontFromSystem :: String -> FontAspect -> Double -> IO Font 
fontFromSystem :: FilePath -> FontAspect -> Double -> IO Font
fontFromSystem FilePath
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 -> FilePath -> FontAspect -> Double -> IO Bool
BRepFont.initFromNameAspectAndSize Ptr BRepFont
bRepFont FilePath
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
$ WaterfallIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WaterfallIOException -> IO ()) -> WaterfallIOException -> IO ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
FileError (FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"::" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FontAspect -> FilePath
forall a. Show a => a -> FilePath
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

-- | Render text, using the font from the provided filepath, at a given size.
--
-- The IO of actually loading the font/checking the file exists is defered 
-- until the Shape is actually used
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
    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
-> FilePath
-> Ptr Ax3
-> HorizontalTextAlignment
-> VerticalTextAlignment
-> Acquire (Ptr Shape)
BRepTextBuilder.perform Ptr BRepTextBuilder
builder Ptr BRepFont
bRepFont FilePath
content Ptr Ax3
axis HorizontalTextAlignment
HTA.Center VerticalTextAlignment
VTA.Center