{-# 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
/= :: BitmapFont -> BitmapFont -> Bool
$c/= :: BitmapFont -> BitmapFont -> Bool
== :: BitmapFont -> BitmapFont -> Bool
$c== :: 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
min :: BitmapFont -> BitmapFont -> BitmapFont
$cmin :: BitmapFont -> BitmapFont -> BitmapFont
max :: BitmapFont -> BitmapFont -> BitmapFont
$cmax :: BitmapFont -> BitmapFont -> BitmapFont
>= :: BitmapFont -> BitmapFont -> Bool
$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
compare :: BitmapFont -> BitmapFont -> Ordering
$ccompare :: BitmapFont -> BitmapFont -> Ordering
$cp1Ord :: Eq 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
showList :: [BitmapFont] -> ShowS
$cshowList :: [BitmapFont] -> ShowS
show :: BitmapFont -> String
$cshow :: BitmapFont -> String
showsPrec :: Int -> BitmapFont -> ShowS
$cshowsPrec :: Int -> 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 :: BitmapFont -> m GLUTbitmapFont
marshalBitmapFont BitmapFont
x = IO GLUTbitmapFont -> m GLUTbitmapFont
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
/= :: StrokeFont -> StrokeFont -> Bool
$c/= :: StrokeFont -> StrokeFont -> Bool
== :: StrokeFont -> StrokeFont -> Bool
$c== :: 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
min :: StrokeFont -> StrokeFont -> StrokeFont
$cmin :: StrokeFont -> StrokeFont -> StrokeFont
max :: StrokeFont -> StrokeFont -> StrokeFont
$cmax :: StrokeFont -> StrokeFont -> StrokeFont
>= :: StrokeFont -> StrokeFont -> Bool
$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
compare :: StrokeFont -> StrokeFont -> Ordering
$ccompare :: StrokeFont -> StrokeFont -> Ordering
$cp1Ord :: Eq 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
showList :: [StrokeFont] -> ShowS
$cshowList :: [StrokeFont] -> ShowS
show :: StrokeFont -> String
$cshow :: StrokeFont -> String
showsPrec :: Int -> StrokeFont -> ShowS
$cshowsPrec :: Int -> StrokeFont -> ShowS
Show )

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

marshalStrokeFont :: MonadIO m => StrokeFont -> m GLUTstrokeFont
marshalStrokeFont :: StrokeFont -> m GLUTbitmapFont
marshalStrokeFont StrokeFont
x = IO GLUTbitmapFont -> m GLUTbitmapFont
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)