    {-# OPTIONS_HADDOCK hide #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.UI.GLUT.Raw.Fonts
    -- Copyright   :  (c) Sven Panne 2018
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- Our own functions to access font identifiers in a portable way.
    --
    -----------------------------------------------------------------------------

    module Graphics.UI.GLUT.Raw.Fonts (
       BitmapFont(..), GLUTbitmapFont, marshalBitmapFont,
       StrokeFont(..), GLUTstrokeFont, marshalStrokeFont
    ) where

    import Control.Monad.IO.Class ( MonadIO(..) )
    import Foreign.C.Types
    import Foreign.Ptr ( Ptr )

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

    -- | The bitmap fonts available in GLUT. The exact bitmap to be used is
    -- defined by the standard X glyph bitmaps for the X font with the given name.

    data BitmapFont
       = Fixed8By13   -- ^ A fixed width font with every character fitting in an 8
                      --   by 13 pixel rectangle.
                      --   (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)
       | Fixed9By15   -- ^ A fixed width font with every character fitting in an 9
                      --   by 15 pixel rectangle.
                      --   (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)
       | TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.
                      --   (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)
       | TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.
                      --   (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)
       | Helvetica10  -- ^ A 10-point proportional spaced Helvetica font.
                      --   (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)
       | Helvetica12  -- ^ A 12-point proportional spaced Helvetica font.
                      --   (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)
       | Helvetica18  -- ^ A 18-point proportional spaced Helvetica font.
                      --   (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)
       deriving ( BitmapFont -> BitmapFont -> Bool
    (BitmapFont -> BitmapFont -> Bool)
    -> (BitmapFont -> BitmapFont -> Bool) -> Eq BitmapFont
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BitmapFont -> BitmapFont -> Bool
    == :: BitmapFont -> BitmapFont -> Bool
    $c/= :: BitmapFont -> BitmapFont -> Bool
    /= :: BitmapFont -> BitmapFont -> Bool
    Eq, Eq BitmapFont
    Eq BitmapFont =>
    (BitmapFont -> BitmapFont -> Ordering)
    -> (BitmapFont -> BitmapFont -> Bool)
    -> (BitmapFont -> BitmapFont -> Bool)
    -> (BitmapFont -> BitmapFont -> Bool)
    -> (BitmapFont -> BitmapFont -> Bool)
    -> (BitmapFont -> BitmapFont -> BitmapFont)
    -> (BitmapFont -> BitmapFont -> BitmapFont)
    -> Ord BitmapFont
    BitmapFont -> BitmapFont -> Bool
    BitmapFont -> BitmapFont -> Ordering
    BitmapFont -> BitmapFont -> BitmapFont
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: BitmapFont -> BitmapFont -> Ordering
    compare :: BitmapFont -> BitmapFont -> Ordering
    $c< :: BitmapFont -> BitmapFont -> Bool
    < :: BitmapFont -> BitmapFont -> Bool
    $c<= :: BitmapFont -> BitmapFont -> Bool
    <= :: BitmapFont -> BitmapFont -> Bool
    $c> :: BitmapFont -> BitmapFont -> Bool
    > :: BitmapFont -> BitmapFont -> Bool
    $c>= :: BitmapFont -> BitmapFont -> Bool
    >= :: BitmapFont -> BitmapFont -> Bool
    $cmax :: BitmapFont -> BitmapFont -> BitmapFont
    max :: BitmapFont -> BitmapFont -> BitmapFont
    $cmin :: BitmapFont -> BitmapFont -> BitmapFont
    min :: BitmapFont -> BitmapFont -> BitmapFont
    Ord, Int -> BitmapFont -> ShowS
    [BitmapFont] -> ShowS
    BitmapFont -> String
    (Int -> BitmapFont -> ShowS)
    -> (BitmapFont -> String)
    -> ([BitmapFont] -> ShowS)
    -> Show BitmapFont
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BitmapFont -> ShowS
    showsPrec :: Int -> BitmapFont -> ShowS
    $cshow :: BitmapFont -> String
    show :: BitmapFont -> String
    $cshowList :: [BitmapFont] -> ShowS
    showList :: [BitmapFont] -> ShowS
    Show )

    -- Alas, fonts in GLUT are not denoted by some integral value, but by opaque
    -- pointers on the C side. Even worse: For WinDoze, they are simply small ints,
    -- casted to void*, for other platforms addresses of global variables are used.
    -- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable
    -- way is using integers on the Haskell side and doing the marshaling via some
    -- small C wrappers around those macros. *sigh*
    type GLUTbitmapFont = Ptr ()

    marshalBitmapFont :: MonadIO m => BitmapFont -> m GLUTbitmapFont
    marshalBitmapFont :: forall (m :: * -> *). MonadIO m => BitmapFont -> m GLUTbitmapFont
    marshalBitmapFont BitmapFont
    x = IO GLUTbitmapFont -> m GLUTbitmapFont
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GLUTbitmapFont -> m GLUTbitmapFont)
    -> IO GLUTbitmapFont -> m GLUTbitmapFont
    forall a b. (a -> b) -> a -> b
    $ case BitmapFont
    x of
       BitmapFont
    Fixed8By13 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    0
       BitmapFont
    Fixed9By15 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    1
       BitmapFont
    TimesRoman10 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    2
       BitmapFont
    TimesRoman24 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    3
       BitmapFont
    Helvetica10 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    4
       BitmapFont
    Helvetica12 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    5
       BitmapFont
    Helvetica18 -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalBitmapFont CInt
    6

    foreign import ccall unsafe "hs_GLUT_marshalBitmapFont"
       hs_GLUT_marshalBitmapFont :: CInt -> IO (Ptr a)

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

    -- | The stroke fonts available in GLUT.
    data StrokeFont
       = Roman     -- ^ A proportionally spaced Roman Simplex font for ASCII
                   --   characters 32 through 127. The maximum top character in the
                   --   font is 119.05 units; the bottom descends 33.33 units.
       | MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as
                   --   'Roman') for ASCII characters 32 through 127. The maximum
                   --   top character in the font is 119.05 units; the bottom
                   --   descends 33.33 units. Each character is 104.76 units wide.
       deriving ( StrokeFont -> StrokeFont -> Bool
    (StrokeFont -> StrokeFont -> Bool)
    -> (StrokeFont -> StrokeFont -> Bool) -> Eq StrokeFont
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StrokeFont -> StrokeFont -> Bool
    == :: StrokeFont -> StrokeFont -> Bool
    $c/= :: StrokeFont -> StrokeFont -> Bool
    /= :: StrokeFont -> StrokeFont -> Bool
    Eq, Eq StrokeFont
    Eq StrokeFont =>
    (StrokeFont -> StrokeFont -> Ordering)
    -> (StrokeFont -> StrokeFont -> Bool)
    -> (StrokeFont -> StrokeFont -> Bool)
    -> (StrokeFont -> StrokeFont -> Bool)
    -> (StrokeFont -> StrokeFont -> Bool)
    -> (StrokeFont -> StrokeFont -> StrokeFont)
    -> (StrokeFont -> StrokeFont -> StrokeFont)
    -> Ord StrokeFont
    StrokeFont -> StrokeFont -> Bool
    StrokeFont -> StrokeFont -> Ordering
    StrokeFont -> StrokeFont -> StrokeFont
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: StrokeFont -> StrokeFont -> Ordering
    compare :: StrokeFont -> StrokeFont -> Ordering
    $c< :: StrokeFont -> StrokeFont -> Bool
    < :: StrokeFont -> StrokeFont -> Bool
    $c<= :: StrokeFont -> StrokeFont -> Bool
    <= :: StrokeFont -> StrokeFont -> Bool
    $c> :: StrokeFont -> StrokeFont -> Bool
    > :: StrokeFont -> StrokeFont -> Bool
    $c>= :: StrokeFont -> StrokeFont -> Bool
    >= :: StrokeFont -> StrokeFont -> Bool
    $cmax :: StrokeFont -> StrokeFont -> StrokeFont
    max :: StrokeFont -> StrokeFont -> StrokeFont
    $cmin :: StrokeFont -> StrokeFont -> StrokeFont
    min :: StrokeFont -> StrokeFont -> StrokeFont
    Ord, Int -> StrokeFont -> ShowS
    [StrokeFont] -> ShowS
    StrokeFont -> String
    (Int -> StrokeFont -> ShowS)
    -> (StrokeFont -> String)
    -> ([StrokeFont] -> ShowS)
    -> Show StrokeFont
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StrokeFont -> ShowS
    showsPrec :: Int -> StrokeFont -> ShowS
    $cshow :: StrokeFont -> String
    show :: StrokeFont -> String
    $cshowList :: [StrokeFont] -> ShowS
    showList :: [StrokeFont] -> ShowS
    Show )

    -- Same remarks as for GLUTbitmapFont
    type GLUTstrokeFont = Ptr ()

    marshalStrokeFont :: MonadIO m => StrokeFont -> m GLUTstrokeFont
    marshalStrokeFont :: forall (m :: * -> *). MonadIO m => StrokeFont -> m GLUTbitmapFont
    marshalStrokeFont StrokeFont
    x = IO GLUTbitmapFont -> m GLUTbitmapFont
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GLUTbitmapFont -> m GLUTbitmapFont)
    -> IO GLUTbitmapFont -> m GLUTbitmapFont
    forall a b. (a -> b) -> a -> b
    $ case StrokeFont
    x of
       StrokeFont
    Roman -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalStrokeFont CInt
    0
       StrokeFont
    MonoRoman -> CInt -> IO GLUTbitmapFont
    forall a. CInt -> IO (Ptr a)
    hs_GLUT_marshalStrokeFont CInt
    1

    foreign import ccall unsafe "hs_GLUT_marshalStrokeFont"
       hs_GLUT_marshalStrokeFont :: CInt -> IO (Ptr a)