    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.UI.GLUT.Fonts
    -- Copyright   :  (c) Sven Panne 2002-2018
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- GLUT supports two types of font rendering: stroke fonts, meaning each
    -- character is rendered as a set of line segments; and bitmap fonts, where each
    -- character is a bitmap generated with
    -- 'Graphics.Rendering.OpenGL.GL.Bitmaps.bitmap'. Stroke fonts have the
    -- advantage that because they are geometry, they can be arbitrarily scale and
    -- rendered. Bitmap fonts are less flexible since they are rendered as bitmaps
    -- but are usually faster than stroke fonts.
    --
    --------------------------------------------------------------------------------

    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
       -- | Render the string in the named font, without using any display lists.
       -- Rendering a nonexistent character has no effect.
       --
       -- If the font is a bitmap font, 'renderString' automatically sets the OpenGL
       -- unpack pixel storage modes it needs appropriately and saves and restores
       -- the previous modes before returning. The generated call to
       -- 'Graphics.Rendering.OpenGL.GL.bitmap' will adjust the current raster
       -- position based on the width of the string.
       -- If the font is a stroke font,
       -- 'Graphics.Rendering.OpenGL.GL.CoordTrans.translate' is used to translate
       -- the current model view matrix to advance the width of the string.

       renderString :: MonadIO m => a -> String -> m ()

       -- | For a bitmap font, return the width in pixels of a string. For a stroke
       -- font, return the width in units. While the width of characters in a font
       -- may vary (though fixed width fonts do not vary), the maximum height
       -- characteristics of a particular font are fixed.

       stringWidth :: MonadIO m => a -> String -> m GLint

       -- | (/freeglut only/) For a bitmap font, return the maximum height of the
       -- characters in the given font measured in pixels. For a stroke font,
       -- return the height in units.

       fontHeight :: MonadIO m => a -> m GLfloat

    instance Font BitmapFont where
       renderString :: BitmapFont -> String -> m ()
    renderString = BitmapFont -> String -> m ()
    forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
    bitmapString
       stringWidth :: BitmapFont -> String -> m GLint
    stringWidth  = BitmapFont -> String -> m GLint
    forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m GLint
    bitmapLength
       fontHeight :: BitmapFont -> m GLfloat
    fontHeight   = BitmapFont -> m GLfloat
    forall (m :: * -> *). MonadIO m => BitmapFont -> m GLfloat
    bitmapHeight

    instance Font StrokeFont where
       renderString :: StrokeFont -> String -> m ()
    renderString = StrokeFont -> String -> m ()
    forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m ()
    strokeString
       stringWidth :: StrokeFont -> String -> m GLint
    stringWidth  = StrokeFont -> String -> m GLint
    forall (m :: * -> *). MonadIO m => StrokeFont -> String -> m GLint
    strokeLength
       fontHeight :: StrokeFont -> m GLfloat
    fontHeight   = StrokeFont -> m GLfloat
    forall (m :: * -> *). MonadIO m => StrokeFont -> m GLfloat
    strokeHeight

    --------------------------------------------------------------------------------

    bitmapString :: MonadIO m => BitmapFont -> String -> m ()
    bitmapString :: BitmapFont -> String -> m ()
    bitmapString f :: BitmapFont
    f s :: String
    s = do
       GLUTbitmapFont
    i <- BitmapFont -> m GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
    marshalBitmapFont BitmapFont
    f
       (Char -> m ()) -> String -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\c :: Char
    c -> Char -> (CInt -> m ()) -> m ()
    forall (m :: * -> *) a. Char -> (CInt -> m a) -> m a
    withChar Char
    c (GLUTbitmapFont -> CInt -> m ()
    forall (m :: * -> *) a. MonadIO m => Ptr a -> CInt -> m ()
    glutBitmapCharacter GLUTbitmapFont
    i)) String
    s

    withChar :: Char -> (CInt -> m a) -> m a
    withChar :: Char -> (CInt -> m a) -> m a
    withChar c :: Char
    c f :: CInt -> m a
    f = CInt -> m a
    f (CInt -> m a) -> (Char -> CInt) -> Char -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    ord (Char -> m a) -> Char -> m a
    forall a b. (a -> b) -> a -> b
    $ Char
    c

    --------------------------------------------------------------------------------

    strokeString :: MonadIO m => StrokeFont -> String -> m ()
    strokeString :: StrokeFont -> String -> m ()
    strokeString f :: StrokeFont
    f s :: String
    s = do
       GLUTbitmapFont
    i <- StrokeFont -> m GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
    marshalStrokeFont StrokeFont
    f
       (Char -> m ()) -> String -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\c :: Char
    c -> Char -> (CInt -> m ()) -> m ()
    forall (m :: * -> *) a. Char -> (CInt -> m a) -> m a
    withChar Char
    c (GLUTbitmapFont -> CInt -> m ()
    forall (m :: * -> *) a. MonadIO m => Ptr a -> CInt -> m ()
    glutStrokeCharacter GLUTbitmapFont
    i)) String
    s

    --------------------------------------------------------------------------------

    bitmapLength :: MonadIO m
                 => BitmapFont -- ^ Bitmap font to use.
                 -> String     -- ^ String to return width of (not confined to 8
                               --   bits).
                 -> m GLint    -- ^ Width in pixels.
    bitmapLength :: BitmapFont -> String -> m GLint
    bitmapLength f :: BitmapFont
    f s :: String
    s = IO GLint -> m GLint
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GLint -> m GLint) -> IO GLint -> m GLint
    forall a b. (a -> b) -> a -> b
    $ do
       GLUTbitmapFont
    i <- BitmapFont -> IO GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
    marshalBitmapFont BitmapFont
    f
       (CInt -> GLint) -> IO CInt -> IO GLint
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CInt -> GLint
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (IO CInt -> IO GLint) -> IO CInt -> IO GLint
    forall a b. (a -> b) -> a -> b
    $ String -> (CString -> IO CInt) -> IO CInt
    forall a. String -> (CString -> IO a) -> IO a
    withCString String
    s (GLUTbitmapFont -> Ptr CUChar -> IO CInt
    forall (m :: * -> *) a. MonadIO m => Ptr a -> Ptr CUChar -> m CInt
    glutBitmapLength GLUTbitmapFont
    i (Ptr CUChar -> IO CInt)
    -> (CString -> Ptr CUChar) -> CString -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CString -> Ptr CUChar
    forall a b. Ptr a -> Ptr b
    castPtr)

    --------------------------------------------------------------------------------

    strokeLength :: MonadIO m
                 => StrokeFont -- ^ Stroke font to use.
                 -> String     -- ^ String to return width of (not confined to 8
                               --   bits).
                 -> m GLint    -- ^ Width in units.
    strokeLength :: StrokeFont -> String -> m GLint
    strokeLength f :: StrokeFont
    f s :: String
    s = IO GLint -> m GLint
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GLint -> m GLint) -> IO GLint -> m GLint
    forall a b. (a -> b) -> a -> b
    $ do
       GLUTbitmapFont
    i <- StrokeFont -> IO GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
    marshalStrokeFont StrokeFont
    f
       (CInt -> GLint) -> IO CInt -> IO GLint
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CInt -> GLint
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (IO CInt -> IO GLint) -> IO CInt -> IO GLint
    forall a b. (a -> b) -> a -> b
    $ String -> (CString -> IO CInt) -> IO CInt
    forall a. String -> (CString -> IO a) -> IO a
    withCString String
    s (GLUTbitmapFont -> Ptr CUChar -> IO CInt
    forall (m :: * -> *) a. MonadIO m => Ptr a -> Ptr CUChar -> m CInt
    glutStrokeLength GLUTbitmapFont
    i (Ptr CUChar -> IO CInt)
    -> (CString -> Ptr CUChar) -> CString -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CString -> Ptr CUChar
    forall a b. Ptr a -> Ptr b
    castPtr)

    --------------------------------------------------------------------------------

    bitmapHeight :: MonadIO m
                 => BitmapFont -- ^ Bitmap font to use.
                 -> m GLfloat  -- ^ Height in pixels.
    bitmapHeight :: BitmapFont -> m GLfloat
    bitmapHeight f :: BitmapFont
    f = IO GLfloat -> m GLfloat
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GLfloat -> m GLfloat) -> IO GLfloat -> m GLfloat
    forall a b. (a -> b) -> a -> b
    $ do
      GLUTbitmapFont
    i <- BitmapFont -> IO GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
    marshalBitmapFont BitmapFont
    f
      CInt -> GLfloat
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> GLfloat) -> IO CInt -> IO GLfloat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` GLUTbitmapFont -> IO CInt
    forall (m :: * -> *) a. MonadIO m => Ptr a -> m CInt
    glutBitmapHeight  GLUTbitmapFont
    i

    --------------------------------------------------------------------------------

    strokeHeight :: MonadIO m
                 => StrokeFont -- ^ Stroke font to use.
                 -> m GLfloat  -- ^ Height in units.
    strokeHeight :: StrokeFont -> m GLfloat
    strokeHeight f :: StrokeFont
    f = GLUTbitmapFont -> m GLfloat
    forall (m :: * -> *) a. MonadIO m => Ptr a -> m GLfloat
    glutStrokeHeight (GLUTbitmapFont -> m GLfloat) -> m GLUTbitmapFont -> m GLfloat
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< StrokeFont -> m GLUTbitmapFont
    forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
    marshalStrokeFont StrokeFont
    f