module Graphics.UI.GLUT.Fonts (
Font(..), BitmapFont(..), StrokeFont(..),
) where
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.Char ( ord )
import Foreign.C.String ( withCString )
import Foreign.C.Types ( CInt )
import Foreign.Ptr ( castPtr )
import Graphics.Rendering.OpenGL ( GLint, GLfloat )
import Graphics.UI.GLUT.Raw
class Font a where
renderString :: MonadIO m => a -> String -> m ()
stringWidth :: MonadIO m => a -> String -> m GLint
fontHeight :: MonadIO m => a -> m GLfloat
instance Font BitmapFont where
renderString :: forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
renderString = forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
bitmapString
stringWidth :: forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m GLint
stringWidth = forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m GLint
bitmapLength
fontHeight :: forall (m :: * -> *). MonadIO m => BitmapFont -> m GLfloat
fontHeight = forall (m :: * -> *). MonadIO m => BitmapFont -> m GLfloat
bitmapHeight
instance Font StrokeFont where
renderString :: forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m ()
renderString = forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m ()
strokeString
stringWidth :: forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m GLint
stringWidth = forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m GLint
strokeLength
fontHeight :: forall (m :: * -> *). MonadIO m => StrokeFont -> m GLfloat
fontHeight = forall (m :: * -> *). MonadIO m => StrokeFont -> m GLfloat
strokeHeight
bitmapString :: MonadIO m => BitmapFont -> String -> m ()
bitmapString :: forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
bitmapString BitmapFont
f String
s = do
GLUTbitmapFont
i <- forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
marshalBitmapFont BitmapFont
f
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Char
c -> forall (m :: * -> *) a. Char -> (CInt -> m a) -> m a
withChar Char
c (forall (m :: * -> *) a. MonadIO m => Ptr a -> CInt -> m ()
glutBitmapCharacter GLUTbitmapFont
i)) String
s
withChar :: Char -> (CInt -> m a) -> m a
withChar :: forall (m :: * -> *) a. Char -> (CInt -> m a) -> m a
withChar Char
c CInt -> m a
f = CInt -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Char
c
strokeString :: MonadIO m => StrokeFont -> String -> m ()
strokeString :: forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m ()
strokeString StrokeFont
f String
s = do
GLUTbitmapFont
i <- forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
marshalStrokeFont StrokeFont
f
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Char
c -> forall (m :: * -> *) a. Char -> (CInt -> m a) -> m a
withChar Char
c (forall (m :: * -> *) a. MonadIO m => Ptr a -> CInt -> m ()
glutStrokeCharacter GLUTbitmapFont
i)) String
s
bitmapLength :: MonadIO m
=> BitmapFont
-> String
-> m GLint
bitmapLength :: forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m GLint
bitmapLength BitmapFont
f String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
GLUTbitmapFont
i <- forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
marshalBitmapFont BitmapFont
f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
s (forall (m :: * -> *) a. MonadIO m => Ptr a -> Ptr CUChar -> m CInt
glutBitmapLength GLUTbitmapFont
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
strokeLength :: MonadIO m
=> StrokeFont
-> String
-> m GLint
strokeLength :: forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m GLint
strokeLength StrokeFont
f String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
GLUTbitmapFont
i <- forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
marshalStrokeFont StrokeFont
f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
s (forall (m :: * -> *) a. MonadIO m => Ptr a -> Ptr CUChar -> m CInt
glutStrokeLength GLUTbitmapFont
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
bitmapHeight :: MonadIO m
=> BitmapFont
-> m GLfloat
bitmapHeight :: forall (m :: * -> *). MonadIO m => BitmapFont -> m GLfloat
bitmapHeight BitmapFont
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
GLUTbitmapFont
i <- forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
marshalBitmapFont BitmapFont
f
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. MonadIO m => Ptr a -> m CInt
glutBitmapHeight GLUTbitmapFont
i
strokeHeight :: MonadIO m
=> StrokeFont
-> m GLfloat
strokeHeight :: forall (m :: * -> *). MonadIO m => StrokeFont -> m GLfloat
strokeHeight StrokeFont
f = forall (m :: * -> *) a. MonadIO m => Ptr a -> m GLfloat
glutStrokeHeight forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
marshalStrokeFont StrokeFont
f